diff --git a/README.md b/README.md index a45fc74..03e8f60 100644 --- a/README.md +++ b/README.md @@ -28,6 +28,9 @@ A high-performance Node.js C++ extension for digital amateur radio protocols, pr | FST4W| ❌ | ✅ | 12 kHz | 120.0s | Variable | | WSPR | ❌ | ✅ | 12 kHz | 110.6s | ~6 Hz | +MSK144 support is exposed as mode `WSJTXMode.MSK144` with 48 kHz encoded +audio, 15-second transmissions, standard 77-bit messages, and MSK144 short +message forms such as ` R-03`. ## Installation ### NPM Installation (Recommended) @@ -247,7 +250,8 @@ enum WSJTXMode { FST4 = 5, Q65 = 6, FST4W = 7, - WSPR = 8 + WSPR = 9, + MSK144 = 10 } ``` diff --git a/native/wsjtx_c_api.cpp b/native/wsjtx_c_api.cpp index 2104189..7dadf86 100644 --- a/native/wsjtx_c_api.cpp +++ b/native/wsjtx_c_api.cpp @@ -32,6 +32,7 @@ static const ModeMetadata MODE_TABLE[] = { /* FST4W */ { 12000, 120.0, 0, 1 }, /* JT65JT9 */ { 11025, 46.8, 0, 1 }, /* WSPR */ { 12000, 110.6, 0, 1 }, + /* MSK144 */ { 48000, 15.0, 1, 1 }, }; static const int MODE_COUNT = sizeof(MODE_TABLE) / sizeof(MODE_TABLE[0]); diff --git a/native/wsjtx_c_api.h b/native/wsjtx_c_api.h index e87b96b..031b0cf 100644 --- a/native/wsjtx_c_api.h +++ b/native/wsjtx_c_api.h @@ -51,7 +51,8 @@ typedef enum { WSJTX_MODE_Q65 = 6, WSJTX_MODE_FST4W = 7, WSJTX_MODE_JT65JT9 = 8, - WSJTX_MODE_WSPR = 9 + WSJTX_MODE_WSPR = 9, + WSJTX_MODE_MSK144 = 10 } wsjtx_mode_t; /* Decoded message (C-compatible version of WsjtxMessage) */ diff --git a/native/wsjtx_wrapper.cpp b/native/wsjtx_wrapper.cpp index f425e0a..25cc5b5 100644 --- a/native/wsjtx_wrapper.cpp +++ b/native/wsjtx_wrapper.cpp @@ -323,7 +323,7 @@ namespace wsjtx_nodejs // ---- Helpers ---- void WSJTXLibWrapper::ValidateMode(Napi::Env env, int mode) { - if (mode < 0 || mode > WSJTX_MODE_WSPR) + if (mode < 0 || mode > WSJTX_MODE_MSK144) throw std::invalid_argument("Invalid mode value"); } @@ -342,7 +342,8 @@ namespace wsjtx_nodejs throw std::invalid_argument("Message must not be empty"); } - const size_t maxLength = (mode == WSJTX_MODE_FT8 || mode == WSJTX_MODE_FT4) ? 37 : 22; + const size_t maxLength = (mode == WSJTX_MODE_FT8 || mode == WSJTX_MODE_FT4 || + mode == WSJTX_MODE_MSK144) ? 37 : 22; if (message.length() > maxLength) { throw std::invalid_argument("Message must be 1-" + std::to_string(maxLength) + " characters long"); } @@ -441,7 +442,8 @@ namespace wsjtx_nodejs void EncodeWorker::Execute() { - // FT8 at 48kHz for 12.64s = ~607,000 samples; 1M buffer is plenty + // FT8 at 48kHz for 12.64s is ~607k samples; MSK144-15 is 720k. + // 1M samples leaves room for all currently supported encoders. static const int MAX_SAMPLES = 1024 * 1024; audioData_.resize(MAX_SAMPLES); int numSamples = 0; diff --git a/src/index.ts b/src/index.ts index 739d835..5d7c6e9 100644 --- a/src/index.ts +++ b/src/index.ts @@ -81,6 +81,9 @@ const FREQ_MAX = 30_000_000; const THREADS_MIN = 1; const THREADS_MAX = 16; const MESSAGE_MAX_LEN = 37; +const MSK144_DEFAULT_LOW_FREQ = 300; +const MSK144_DEFAULT_HIGH_FREQ = 2700; +const MSK144_DEFAULT_TOLERANCE = 100; export class WSJTXLib { private readonly native: NativeWSJTXLib; @@ -103,9 +106,9 @@ export class WSJTXLib { frequency: options.frequency, txFrequency: options.txFrequency ?? options.frequency, threads: options.threads ?? this.config.maxThreads, - lowFreq: options.lowFreq ?? this.config.defaultLowFreq, - highFreq: options.highFreq ?? this.config.defaultHighFreq, - tolerance: options.tolerance ?? this.config.defaultTolerance, + lowFreq: options.lowFreq ?? this.defaultLowFreq(mode), + highFreq: options.highFreq ?? this.defaultHighFreq(mode), + tolerance: options.tolerance ?? this.defaultTolerance(mode), myCall: options.myCall ?? '', myGrid: options.myGrid ?? '', dxCall: options.dxCall ?? '', @@ -239,6 +242,18 @@ export class WSJTXLib { throw new WSJTXError('audioData must be a non-empty Float32Array or Int16Array', 'INVALID'); } } + + private defaultLowFreq(mode: WSJTXMode): number { + return mode === WSJTXMode.MSK144 ? MSK144_DEFAULT_LOW_FREQ : this.config.defaultLowFreq; + } + + private defaultHighFreq(mode: WSJTXMode): number { + return mode === WSJTXMode.MSK144 ? MSK144_DEFAULT_HIGH_FREQ : this.config.defaultHighFreq; + } + + private defaultTolerance(mode: WSJTXMode): number { + return mode === WSJTXMode.MSK144 ? MSK144_DEFAULT_TOLERANCE : this.config.defaultTolerance; + } } export { WSJTXMode, WSJTXError }; diff --git a/src/types.ts b/src/types.ts index 8946080..c256704 100644 --- a/src/types.ts +++ b/src/types.ts @@ -13,6 +13,7 @@ export enum WSJTXMode { FST4W = 7, JT65JT9 = 8, WSPR = 9, + MSK144 = 10, } export type AudioData = Float32Array | Int16Array; @@ -46,6 +47,10 @@ export interface WSJTXMessage { * - apDecode: enables FT8/FT4 AP decode passes. Defaults to true. * - decodeDepth: WSJT-X decoder depth. Defaults to 1. * - qsoProgress: WSJT-X QSO progress stage. Defaults to 0. + * + * MSK144 uses 1500 Hz as the nominal audio center frequency. Its decoder is + * typically used with a 300-2700 Hz passband and wider tolerance (100-200 Hz) + * than FT8/FT4; when omitted, the wrapper applies 300 / 2700 / 100 defaults. */ export interface DecodeOptions { frequency: number; diff --git a/test/wsjtx.basic.test.ts b/test/wsjtx.basic.test.ts index 7912f71..07f5789 100644 --- a/test/wsjtx.basic.test.ts +++ b/test/wsjtx.basic.test.ts @@ -39,11 +39,19 @@ describe('WSJTX library — smoke', () => { assert.strictEqual(WSJTXMode.FT4, 1); assert.strictEqual(WSJTXMode.JT65JT9, 8); assert.strictEqual(WSJTXMode.WSPR, 9); + assert.strictEqual(WSJTXMode.MSK144, 10); }); - it('returns capabilities for all 10 modes', () => { + it('returns capabilities for all 11 modes', () => { const caps = lib.getAllModeCapabilities(); - assert.strictEqual(caps.length, 10); + assert.strictEqual(caps.length, 11); + }); + + it('reports MSK144 supports both encode and decode', () => { + assert.ok(lib.isEncodingSupported(WSJTXMode.MSK144)); + assert.ok(lib.isDecodingSupported(WSJTXMode.MSK144)); + assert.strictEqual(lib.getSampleRate(WSJTXMode.MSK144), 48000); + assert.strictEqual(lib.getTransmissionDuration(WSJTXMode.MSK144), 15.0); }); it('rejects invalid mode in decode', async () => { diff --git a/test/wsjtx.test.ts b/test/wsjtx.test.ts index 8f300b6..b171a26 100644 --- a/test/wsjtx.test.ts +++ b/test/wsjtx.test.ts @@ -113,9 +113,22 @@ describe('WSJTX library — regression', () => { assert.ok(lib.isDecodingSupported(WSJTXMode.WSPR)); }); - it('mode capabilities array covers all 10 modes', () => { + it('MSK144 sample rate is 48 kHz', () => { + assert.strictEqual(lib.getSampleRate(WSJTXMode.MSK144), 48000); + }); + + it('MSK144 transmission duration is 15.0 s', () => { + assert.strictEqual(lib.getTransmissionDuration(WSJTXMode.MSK144), 15.0); + }); + + it('MSK144 supports both encoding and decoding', () => { + assert.ok(lib.isEncodingSupported(WSJTXMode.MSK144)); + assert.ok(lib.isDecodingSupported(WSJTXMode.MSK144)); + }); + + it('mode capabilities array covers all 11 modes', () => { const caps = lib.getAllModeCapabilities(); - assert.strictEqual(caps.length, 10); + assert.strictEqual(caps.length, 11); assert.ok(caps.every((c) => c.sampleRate > 0 && c.duration > 0)); }); @@ -124,6 +137,7 @@ describe('WSJTX library — regression', () => { assert.strictEqual(WSJTXMode.FT4, 1); assert.strictEqual(WSJTXMode.JT65JT9, 8); assert.strictEqual(WSJTXMode.WSPR, 9); + assert.strictEqual(WSJTXMode.MSK144, 10); }); }); @@ -184,6 +198,21 @@ describe('WSJTX library — regression', () => { assert.ok(result.audioData.length > 0); }); + it('MSK144 encodes standard messages', async () => { + const result = await lib.encode(WSJTXMode.MSK144, 'K1ABC W9XYZ EN37', 1500); + assert.strictEqual(result.messageSent.trim(), 'K1ABC W9XYZ EN37'); + assert.ok(result.audioData instanceof Float32Array); + assert.ok( + result.audioData.length >= 700_000 && result.audioData.length <= 730_000, + `unexpected sample count: ${result.audioData.length}`, + ); + }); + + it('MSK144 encodes short messages', async () => { + const result = await lib.encode(WSJTXMode.MSK144, ' R-03', 1500); + assert.strictEqual(result.messageSent.trim(), ' R-03'); + assert.ok(result.audioData.length >= 700_000 && result.audioData.length <= 730_000); + }); it('rejects FT8 messages longer than 37 characters', async () => { await assert.rejects( () => lib.encode(WSJTXMode.FT8, 'A'.repeat(38), 1500), @@ -323,6 +352,17 @@ describe('WSJTX library — regression', () => { assert.strictEqual(r.success, true); }); + it('MSK144 silence decode succeeds with empty messages', async () => { + const silence = new Float32Array(ENCODE_SAMPLE_RATE * 15); + const r = await lib.decode(WSJTXMode.MSK144, silence, { + frequency: 1500, + threads: 1, + tolerance: 100, + decodeDepth: 1, + }); + assert.strictEqual(r.success, true); + assert.deepStrictEqual(r.messages, []); + }); it('decode with very narrow scan window still succeeds (does not crash)', async () => { const r = await lib.decode(WSJTXMode.FT8, silence, { frequency: 1500, diff --git a/wsjtx_lib b/wsjtx_lib deleted file mode 160000 index 623ed86..0000000 --- a/wsjtx_lib +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 623ed86cee17be6ba09be151cd4e13c90cd2993d diff --git a/wsjtx_lib/.gitattributes b/wsjtx_lib/.gitattributes new file mode 100644 index 0000000..1ff0c42 --- /dev/null +++ b/wsjtx_lib/.gitattributes @@ -0,0 +1,63 @@ +############################################################################### +# Set default behavior to automatically normalize line endings. +############################################################################### +* text=auto + +############################################################################### +# Set default behavior for command prompt diff. +# +# This is need for earlier builds of msysgit that does not have it on by +# default for csharp files. +# Note: This is only used by command line +############################################################################### +#*.cs diff=csharp + +############################################################################### +# Set the merge driver for project and solution files +# +# Merging from the command prompt will add diff markers to the files if there +# are conflicts (Merging from VS is not affected by the settings below, in VS +# the diff markers are never inserted). Diff markers may cause the following +# file extensions to fail to load in VS. An alternative would be to treat +# these files as binary and thus will always conflict and require user +# intervention with every merge. To do so, just uncomment the entries below +############################################################################### +#*.sln merge=binary +#*.csproj merge=binary +#*.vbproj merge=binary +#*.vcxproj merge=binary +#*.vcproj merge=binary +#*.dbproj merge=binary +#*.fsproj merge=binary +#*.lsproj merge=binary +#*.wixproj merge=binary +#*.modelproj merge=binary +#*.sqlproj merge=binary +#*.wwaproj merge=binary + +############################################################################### +# behavior for image files +# +# image files are treated as binary by default. +############################################################################### +#*.jpg binary +#*.png binary +#*.gif binary + +############################################################################### +# diff behavior for common document formats +# +# Convert binary document formats to text before diffing them. This feature +# is only available from the command line. Turn it on by uncommenting the +# entries below. +############################################################################### +#*.doc diff=astextplain +#*.DOC diff=astextplain +#*.docx diff=astextplain +#*.DOCX diff=astextplain +#*.dot diff=astextplain +#*.DOT diff=astextplain +#*.pdf diff=astextplain +#*.PDF diff=astextplain +#*.rtf diff=astextplain +#*.RTF diff=astextplain diff --git a/wsjtx_lib/.gitignore b/wsjtx_lib/.gitignore new file mode 100644 index 0000000..03699e5 --- /dev/null +++ b/wsjtx_lib/.gitignore @@ -0,0 +1,366 @@ +## Ignore Visual Studio temporary files, build results, and +## files generated by popular Visual Studio add-ons. +## +## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore + +# User-specific files +*.rsuser +*.suo +*.user +*.userosscache +*.sln.docstates + +# User-specific files (MonoDevelop/Xamarin Studio) +*.userprefs + +# Mono auto generated files +mono_crash.* + +# Build results +[Dd]ebug/ +[Dd]ebugPublic/ +[Rr]elease/ +[Rr]eleases/ +x64/ +x86/ +[Ww][Ii][Nn]32/ +[Aa][Rr][Mm]/ +[Aa][Rr][Mm]64/ +bld/ +[Bb]in/ +[Oo]bj/ +[Oo]ut/ +[Ll]og/ +[Ll]ogs/ + +# Visual Studio 2015/2017 cache/options directory +.vs/ +.visualgdb/ +# Uncomment if you have tasks that create the project's static files in wwwroot +#wwwroot/ + +# Visual Studio 2017 auto generated files +Generated\ Files/ + +# MSTest test Results +[Tt]est[Rr]esult*/ +[Bb]uild[Ll]og.* + +# NUnit +*.VisualState.xml +TestResult.xml +nunit-*.xml + +# Build Results of an ATL Project +[Dd]ebugPS/ +[Rr]eleasePS/ +dlldata.c + +# Benchmark Results +BenchmarkDotNet.Artifacts/ + +# .NET Core +project.lock.json +project.fragment.lock.json +artifacts/ + +# ASP.NET Scaffolding +ScaffoldingReadMe.txt + +# StyleCop +StyleCopReport.xml + +# Files built by Visual Studio +*_i.c +*_p.c +*_h.h +*.ilk +*.meta +*.obj +*.iobj +*.pch +*.pdb +*.ipdb +*.pgc +*.pgd +*.rsp +*.sbr +*.tlb +*.tli +*.tlh +*.tmp +*.tmp_proj +*_wpftmp.csproj +*.log +*.vspscc +*.vssscc +.builds +*.pidb +*.svclog +*.scc +*.old + +# Chutzpah Test files +_Chutzpah* + +# Visual C++ cache files +ipch/ +*.aps +*.ncb +*.opendb +*.opensdf +*.sdf +*.cachefile +*.VC.db +*.VC.VC.opendb + +# Visual Studio profiler +*.psess +*.vsp +*.vspx +*.sap + +# Visual Studio Trace Files +*.e2e + +# TFS 2012 Local Workspace +$tf/ + +# Guidance Automation Toolkit +*.gpState + +# ReSharper is a .NET coding add-in +_ReSharper*/ +*.[Rr]e[Ss]harper +*.DotSettings.user + +# TeamCity is a build add-in +_TeamCity* + +# DotCover is a Code Coverage Tool +*.dotCover + +# AxoCover is a Code Coverage Tool +.axoCover/* +!.axoCover/settings.json + +# Coverlet is a free, cross platform Code Coverage Tool +coverage*.json +coverage*.xml +coverage*.info + +# Visual Studio code coverage results +*.coverage +*.coveragexml + +# NCrunch +_NCrunch_* +.*crunch*.local.xml +nCrunchTemp_* + +# MightyMoose +*.mm.* +AutoTest.Net/ + +# Web workbench (sass) +.sass-cache/ + +# Installshield output folder +[Ee]xpress/ + +# DocProject is a documentation generator add-in +DocProject/buildhelp/ +DocProject/Help/*.HxT +DocProject/Help/*.HxC +DocProject/Help/*.hhc +DocProject/Help/*.hhk +DocProject/Help/*.hhp +DocProject/Help/Html2 +DocProject/Help/html + +# Click-Once directory +publish/ + +# Publish Web Output +*.[Pp]ublish.xml +*.azurePubxml +# Note: Comment the next line if you want to checkin your web deploy settings, +# but database connection strings (with potential passwords) will be unencrypted +*.pubxml +*.publishproj + +# Microsoft Azure Web App publish settings. Comment the next line if you want to +# checkin your Azure Web App publish settings, but sensitive information contained +# in these scripts will be unencrypted +PublishScripts/ + +# NuGet Packages +*.nupkg +# NuGet Symbol Packages +*.snupkg +# The packages folder can be ignored because of Package Restore +**/[Pp]ackages/* +# except build/, which is used as an MSBuild target. +!**/[Pp]ackages/build/ +# Uncomment if necessary however generally it will be regenerated when needed +#!**/[Pp]ackages/repositories.config +# NuGet v3's project.json files produces more ignorable files +*.nuget.props +*.nuget.targets + +# Microsoft Azure Build Output +csx/ +*.build.csdef + +# Microsoft Azure Emulator +ecf/ +rcf/ + +# Windows Store app package directories and files +AppPackages/ +BundleArtifacts/ +Package.StoreAssociation.xml +_pkginfo.txt +*.appx +*.appxbundle +*.appxupload + +# Visual Studio cache files +# files ending in .cache can be ignored +*.[Cc]ache +# but keep track of directories ending in .cache +!?*.[Cc]ache/ + +# Others +ClientBin/ +~$* +*~ +*.dbmdl +*.dbproj.schemaview +*.jfm +*.pfx +*.publishsettings +orleans.codegen.cs + +# Including strong name files can present a security risk +# (https://github.com/github/gitignore/pull/2483#issue-259490424) +#*.snk + +# Since there are multiple workflows, uncomment next line to ignore bower_components +# (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) +#bower_components/ + +# RIA/Silverlight projects +Generated_Code/ + +# Backup & report files from converting an old project file +# to a newer Visual Studio version. Backup files are not needed, +# because we have git ;-) +_UpgradeReport_Files/ +Backup*/ +UpgradeLog*.XML +UpgradeLog*.htm +ServiceFabricBackup/ +*.rptproj.bak + +# SQL Server files +*.mdf +*.ldf +*.ndf + +# Business Intelligence projects +*.rdl.data +*.bim.layout +*.bim_*.settings +*.rptproj.rsuser +*- [Bb]ackup.rdl +*- [Bb]ackup ([0-9]).rdl +*- [Bb]ackup ([0-9][0-9]).rdl + +# Microsoft Fakes +FakesAssemblies/ + +# GhostDoc plugin setting file +*.GhostDoc.xml + +# Node.js Tools for Visual Studio +.ntvs_analysis.dat +node_modules/ + +# Visual Studio 6 build log +*.plg + +# Visual Studio 6 workspace options file +*.opt + +# Visual Studio 6 auto-generated workspace file (contains which files were open etc.) +*.vbw + +# Visual Studio LightSwitch build output +**/*.HTMLClient/GeneratedArtifacts +**/*.DesktopClient/GeneratedArtifacts +**/*.DesktopClient/ModelManifest.xml +**/*.Server/GeneratedArtifacts +**/*.Server/ModelManifest.xml +_Pvt_Extensions + +# Paket dependency manager +.paket/paket.exe +paket-files/ + +# FAKE - F# Make +.fake/ + +# CodeRush personal settings +.cr/personal + +# Python Tools for Visual Studio (PTVS) +__pycache__/ +*.pyc + +# Cake - Uncomment if you are using it +# tools/** +# !tools/packages.config + +# Tabs Studio +*.tss + +# Telerik's JustMock configuration file +*.jmconfig + +# BizTalk build output +*.btp.cs +*.btm.cs +*.odx.cs +*.xsd.cs + +# OpenCover UI analysis results +OpenCover/ + +# Azure Stream Analytics local run output +ASALocalRun/ + +# MSBuild Binary and Structured Log +*.binlog + +# NVidia Nsight GPU debugger configuration file +*.nvuser + +# MFractors (Xamarin productivity tool) working folder +.mfractor/ + +# Local History for Visual Studio +.localhistory/ + +# BeatPulse healthcheck temp database +healthchecksdb + +# Backup folder for Package Reference Convert tool in Visual Studio 2017 +MigrationBackup/ + +# Ionide (cross platform F# VS Code tools) working folder +.ionide/ + +# Fody - auto-generated XML schema +FodyWeavers.xsdbuild/ +build/ diff --git a/wsjtx_lib/CMakeLists.txt b/wsjtx_lib/CMakeLists.txt new file mode 100644 index 0000000..c543c46 --- /dev/null +++ b/wsjtx_lib/CMakeLists.txt @@ -0,0 +1,288 @@ +#Generated by VisualGDB project wizard. +#Note: VisualGDB will automatically update this file when you add new sources to the project. + +cmake_minimum_required(VERSION 3.14) +project(wsjtx_lib) +enable_language(Fortran) +set (CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O3 ${General_FFLAGS}") +set (CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fbounds-check ${General_FFLAGS}") +set_source_files_properties (lib/decoder.f90 PROPERTIES COMPILE_FLAGS "-Wno-unused-dummy-argument") +set (CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g -fbacktrace -fbounds-check -fno-f2c -ffpe-summary=invalid,zero,overflow,underflow ${General_FFLAGS}") +add_definitions (-DCMAKE_BUILD -DBIGSYM=1) +set (wsjt_FSRCS + # put module sources first in the hope that they get rebuilt before use + lib/types.f90 + lib/C_interface_module.f90 + lib/shmem.f90 + lib/crc.f90 + lib/fftw3mod.f90 + lib/hashing.f90 + lib/iso_c_utilities.f90 + lib/jt4.f90 + lib/jt4_decode.f90 + lib/jt65_decode.f90 + lib/jt65_mod.f90 + lib/ft8_decode.f90 + lib/ft4_decode.f90 + lib/fst4_decode.f90 + lib/jt9_decode.f90 + lib/options.f90 + lib/packjt.f90 + lib/77bit/packjt77.f90 + lib/qra/q65/q65.f90 + lib/q65_decode.f90 + lib/readwav.f90 + lib/timer_C_wrapper.f90 + lib/timer_impl.f90 + lib/timer_module.f90 + lib/wavhdr.f90 + lib/qra/q65/q65_encoding_modules.f90 + + # remaining non-module sources + lib/addit.f90 + lib/afc65b.f90 + lib/afc9.f90 + lib/ana64.f90 + lib/ana932.f90 + lib/analytic.f90 + lib/astro.f90 + lib/astrosub.f90 + lib/astro0.f90 + lib/avecho.f90 + lib/averms.f90 + lib/azdist.f90 + lib/ft8/baseline.f90 + lib/ft8/ft8_a7.f90 + lib/ft8/ft8_a8d.f90 + lib/ft8/ft8q3.f90 + lib/qra/q65/q65_set_list2.f90 + lib/ft4/ft4_baseline.f90 + lib/blanker.f90 + lib/bpdecode40.f90 + lib/bpdecode128_90.f90 + lib/ft8/bpdecode174_91.f90 + lib/baddata.f90 + lib/calibrate.f90 + lib/ccf2.f90 + lib/ccf65.f90 + lib/ft8/chkcrc13a.f90 + lib/ft8/chkcrc14a.f90 + lib/chkcall.f90 + lib/chkhist.f90 + lib/chkmsg.f90 + lib/chkss2.f90 + lib/ft4/clockit.f90 + lib/ft8/compress.f90 + lib/coord.f90 + lib/db.f90 + lib/decode4.f90 + lib/decode65a.f90 + lib/decode65b.f90 + lib/decode9w.f90 + lib/ft8/decode174_91.f90 + lib/decoder.f90 + lib/deep4.f90 + lib/deg2grid.f90 + lib/degrade_snr.f90 + lib/demod64a.f90 + lib/determ.f90 + lib/downsam9.f90 + lib/encode232.f90 + lib/encode4.f90 + lib/encode_msk40.f90 + lib/encode_128_90.f90 + lib/ft8/encode174_91.f90 + lib/ft8/encode174_91_nocrc.f90 + lib/entail.f90 + lib/ephem.f90 + lib/extract.f90 + lib/extract4.f90 + lib/extractmessage77.f90 + lib/fano232.f90 + lib/fast9.f90 + lib/fast_decode.f90 + lib/fchisq.f90 + lib/fchisq0.f90 + lib/fchisq65.f90 + lib/fil3.f90 + lib/fil3c.f90 + lib/fil4.f90 + lib/fil6521.f90 + lib/filbig.f90 + lib/ft8/filt8.f90 + lib/fitcal.f90 + lib/flat1.f90 + lib/flat1a.f90 + lib/flat1b.f90 + lib/flat2.f90 + lib/flat4.f90 + lib/flat65.f90 + lib/fmtmsg.f90 + lib/foldspec9f.f90 + lib/four2a.f90 + lib/ft8/foxfilt.f90 + lib/ft8/foxgen.f90 + lib/ft8/foxgen_wrap.f90 + lib/freqcal.f90 + lib/ft8/ft8apset.f90 + lib/ft8/ft8b.f90 + lib/ft8/ft8code.f90 + lib/ft8/ft8_downsample.f90 + lib/ft8/ft8sim.f90 + lib/gen4.f90 + lib/gen65.f90 + lib/gen9.f90 + lib/genwave.f90 + lib/ft8/genft8.f90 + lib/qra/q65/genq65.f90 + lib/genmsk_128_90.f90 + lib/genmsk40.f90 + lib/ft4/ft4code.f90 + lib/ft4/genft4.f90 + lib/ft4/gen_ft4wave.f90 + lib/ft8/gen_ft8wave.f90 + lib/ft8/genft8refsig.f90 + lib/genwspr.f90 + lib/geodist.f90 + lib/ft8/get_crc14.f90 + lib/getlags.f90 + lib/getmet4.f90 + lib/ft8/get_spectrum_baseline.f90 + lib/ft2/gfsk_pulse.f90 + lib/graycode.f90 + lib/graycode65.f90 + lib/grayline.f90 + lib/grid2deg.f90 + lib/ft8/h1.f90 + lib/hash.f90 + lib/hint65.f90 + lib/hspec.f90 + lib/indexx.f90 + lib/init_random_seed.f90 + lib/interleave4.f90 + lib/interleave63.f90 + lib/interleave9.f90 + lib/inter_wspr.f90 + lib/jplsubs.f + lib/jt9fano.f90 + lib/jtmsg.f90 + lib/libration.f90 + lib/lorentzian.f90 + lib/fst4/lorentzian_fading.f90 + lib/lpf1.f90 + lib/map65_mmdec.f90 + lib/mixlpf.f90 + lib/makepings.f90 + lib/moondopjpl.f90 + lib/morse.f90 + lib/move.f90 + lib/msk40decodeframe.f90 + lib/msk144decodeframe.f90 + lib/msk40spd.f90 + lib/msk144spd.f90 + lib/msk40sync.f90 + lib/msk144sync.f90 + lib/msk40_freq_search.f90 + lib/msk144_freq_search.f90 + lib/mskrtd.f90 + lib/msk144signalquality.f90 + lib/msk144sim.f90 + lib/mskrtd.f90 + lib/nuttal_window.f90 + lib/ft4/ft4sim.f90 + lib/ft4/ft4sim_mult.f90 + lib/ft4/ft4_downsample.f90 + lib/77bit/my_hash.f90 + lib/wsprd/osdwspr.f90 + lib/ft8/osd174_91.f90 + lib/osd128_90.f90 + lib/pctile.f90 + lib/peakdt9.f90 + lib/peakup.f90 + lib/plotsave.f90 + lib/platanh.f90 + lib/pltanh.f90 + lib/polyfit.f90 + lib/prog_args.f90 + lib/ps4.f90 + lib/qra/q65/q65_ap.f90 + lib/qra/q65/q65_loops.f90 + lib/qra/q65/q65_set_list.f90 + lib/refspectrum.f90 + lib/savec2.f90 + lib/sec0.f90 + lib/sec_midn.f90 + lib/setup65.f90 + lib/sh65.f90 + lib/sh65snr.f90 + lib/slasubs.f + lib/sleep_msec.f90 + lib/slope.f90 + lib/smo.f90 + lib/smo121.f90 + lib/softsym.f90 + lib/softsym9f.f90 + lib/softsym9w.f90 + lib/shell.f90 + lib/spec64.f90 + lib/spec9f.f90 + lib/stdmsg.f90 + lib/subtract65.f90 + lib/ft8/subtractft8.f90 + lib/ft4/subtractft4.f90 + lib/sun.f90 + lib/symspec.f90 + lib/symspec2.f90 + lib/symspec65.f90 + lib/sync4.f90 + lib/sync65.f90 + lib/ft4/getcandidates4.f90 + lib/ft4/get_ft4_bitmetrics.f90 + lib/ft8/sync8.f90 + lib/ft8/sync8d.f90 + lib/ft4/sync4d.f90 + lib/sync9.f90 + lib/sync9f.f90 + lib/sync9w.f90 + lib/timf2.f90 + lib/tweak1.f90 + lib/twkfreq.f90 + lib/ft8/twkfreq1.f90 + lib/twkfreq65.f90 + lib/update_recent_calls.f90 + lib/update_msk40_hasharray.f90 + lib/ft8/watterson.f90 + lib/wav11.f90 + lib/wav12.f90 + lib/xcor.f90 + lib/xcor4.f90 + lib/wqdecode.f90 + lib/wqencode.f90 + lib/wspr_downsample.f90 + lib/zplot9.f90 + lib/fst4/decode240_101.f90 + lib/fst4/decode240_74.f90 + lib/fst4/encode240_101.f90 + lib/fst4/encode240_74.f90 + lib/fst4/fst4sim.f90 + lib/fst4/gen_fst4wave.f90 + lib/fst4/genfst4.f90 + lib/fst4/get_fst4_bitmetrics.f90 + lib/fst4/get_fst4_bitmetrics2.f90 + lib/fst4/ldpcsim240_101.f90 + lib/fst4/ldpcsim240_74.f90 + lib/fst4/osd240_101.f90 + lib/fst4/osd240_74.f90 + lib/fst4/fastosd240_74.f90 + lib/fst4/get_crc24.f90 + lib/fst4/fst4_baseline.f90 + ) + + +include_directories(wsprd) +add_library(wsjtx_lib wsjtx_lib.cpp wsjtx_lib.h "${wsjt_FSRCS}" wsjtx_decode.cpp wsjtx_decode.h commons.h DataBuffer.h lib/usleep.c lib/qra/q65/q65.c lib/qra/q65/fadengauss.c lib/qra/q65/fadenlorentz.c lib/qra/q65/normrnd.c lib/qra/q65/npfwht.c lib/qra/q65/pdmath.c lib/qra/q65/q65_subs.c lib/qra/q65/qra15_65_64_irr_e23.c lib/qra/q65/qracodes.c lib/crc10.cpp lib/crc13.cpp lib/crc14.cpp lib/igray.c lib/ftrsd/ftrsd2.c lib/ftrsd/ftrsdap.c lib/ftrsd/sfrsd3.c lib/char.h lib/decode_rs.c lib/encode_rs.c lib/init_rs.c lib/wrapkarn.c fortran_interface.h constants.h wsjtx_encode.h wsjtx_encode.cpp wsprd/fano.cpp wsprd/nhash.cpp wsprd/tab.cpp wsprd/wsprd.cpp wsprd/wsprd_utils.cpp wsprd/wsprsim_utils.cpp wsprd/fano.h wsprd/metric_tables.h wsprd/nhash.h wsprd/wsprd.h wsprd/wsprd_utils.h wsprd/wsprsim_utils.h) +target_link_libraries(wsjtx_lib "${LIBRARIES_FROM_REFERENCES}") +set_property(TARGET wsjtx_lib PROPERTY CXX_STANDARD 17) +target_compile_options(wsjtx_lib PRIVATE -DFFTW_ENABLE_FLOAT) +install(TARGETS wsjtx_lib DESTINATION lib) +install(FILES wsjtx_lib.h DESTINATION include) \ No newline at end of file diff --git a/wsjtx_lib/COPYING b/wsjtx_lib/COPYING new file mode 100644 index 0000000..b74cdd1 --- /dev/null +++ b/wsjtx_lib/COPYING @@ -0,0 +1,151 @@ +GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 + +Copyright (C) 2007 Free Software Foundation, Inc. + +Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. + +Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. + +The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. + +To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. + +For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. + +Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. + +For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. + +Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. + +Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. + +The precise terms and conditions for copying, distribution and modification follow. + +TERMS AND CONDITIONS 0. Definitions. “This License” refers to version 3 of the GNU General Public License. + +“Copyright” also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. + +“The Program” refers to any copyrightable work licensed under this License. Each licensee is addressed as “you”. “Licensees” and “recipients” may be individuals or organizations. + +To “modify” a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a “modified version” of the earlier work or a work “based on” the earlier work. + +A “covered work” means either the unmodified Program or a work based on the Program. + +To “propagate” a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. + +To “convey” a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. + +An interactive user interface displays “Appropriate Legal Notices” to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. + +1. Source Code. The “source code” for a work means the preferred form of the work for making modifications to it. “Object code” means any non-source form of a work. + +A “Standard Interface” means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. + +The “System Libraries” of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A “Major Component”, in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. + +The “Corresponding Source” for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. + +The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. + +The Corresponding Source for a work in source code form is that same work. + +2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. + +You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. + +Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. + +3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. + +When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. + +4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. + +You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. + +5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: + +a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to “keep intact all notices”. c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an “aggregate” if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. + +6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: + +a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. + +A “User Product” is either (1) a “consumer product”, which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, “normally used” refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. + +“Installation Information” for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. + +If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). + +The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. + +Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. + +7. Additional Terms. “Additional permissions” are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. + +When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. + +Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: + +a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered “further restrictions” within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. + +If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. + +Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. + +8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). + +However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. + +Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. + +Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. + +9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. + +10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. + +An “entity transaction” is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. + +You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. + +11. Patents. A “contributor” is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's “contributor version”. + +A contributor's “essential patent claims” are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, “control” includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. + +Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. + +In the following three paragraphs, a “patent license” is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To “grant” such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. + +If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. “Knowingly relying” means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. + +If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. + +A patent license is “discriminatory” if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. + +Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. + +12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. + +13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. + +14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License “or any later version” applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. + +If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. + +Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. + +15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM “AS IS” WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. + +END OF TERMS AND CONDITIONS + +--------------------------- diff --git a/wsjtx_lib/DataBuffer.h b/wsjtx_lib/DataBuffer.h new file mode 100644 index 0000000..2c74d2e --- /dev/null +++ b/wsjtx_lib/DataBuffer.h @@ -0,0 +1,177 @@ +#pragma once +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/** Buffer to move sample data between threads. */ +template +class DataBuffer +{ + public: + /** Constructor. initialize members */ + DataBuffer(std::string name = "") + : m_qlen(0), m_end_marked(false) + { + } + + /** Add samples to the queue. */ + void push(std::vector &&samples) + { + if (!samples.empty()) + { + std::unique_lock lock(m_mutex); + m_qlen += samples.size(); + m_queue.push(move(samples)); + lock.unlock(); + m_cond.notify_all(); + } + } + + /** Mark the end of the data stream. */ + void push_end() + { + std::unique_lock lock(m_mutex); + m_end_marked = true; + lock.unlock(); + m_cond.notify_all(); + } + + void clear() + { + std::unique_lock lock(m_mutex); + std::vector ret; + while (!m_queue.empty()) + { + m_qlen -= m_queue.front().size(); + swap(ret, m_queue.front()); + m_queue.pop(); + ret.clear(); + } + m_end_marked = false; + lock.unlock(); + m_cond.notify_all(); + } + + /** Return number of samples in queue. */ + size_t queued_samples() + { + std::unique_lock lock(m_mutex); + return m_qlen; + } + + /** + * If the queue is non-empty, remove a block from the queue and + * return the samples. If the end marker has been reached, return + * an empty std::vector. If the queue is empty, wait until more data is pushed + * or until the end marker is pushed. + */ + std::vector pull() + { + std::vector ret; + std::unique_lock lock(m_mutex); + while (m_queue.empty() && !m_end_marked) + { + m_cond.wait(lock); // conditional wait unlocks the mutex! + } + if (!m_queue.empty()) + { + m_qlen -= m_queue.front().size(); + swap(ret, m_queue.front()); + m_queue.pop(); + lock.unlock(); + m_cond.notify_all(); + } + return ret; + } + + /** Return true if the end has been reached at the Pull side. */ + bool pull_end_reached() + { + std::unique_lock lock(m_mutex); + return m_qlen == 0 && m_end_marked; + } + + /** Wait until the buffer contains minfill samples or an end marker. */ + void wait_buffer_fill(size_t minfill) + { + std::unique_lock lock(m_mutex); + while (m_qlen < minfill && !m_end_marked) + m_cond.wait(lock); + } + + /** Wait until the queue is reaching bottom or an end marker. */ + void wait_queue_empty(size_t maxfill) + { + std::unique_lock lock(m_mutex); + while (m_queue.size() > maxfill && !m_end_marked) + m_cond.wait(lock); + } + + void restart_queue() + { + std::unique_lock lock(m_mutex); + m_end_marked = false; + } + + int size() + { + return m_queue.size(); + } + + size_t get_qlen() + { + return m_qlen; + } + + private: + size_t m_qlen; + bool m_end_marked; + std::queue> m_queue; + std::mutex m_mutex; + std::condition_variable m_cond; +}; + +template +class DataQueue +{ + public: + /** Add samples to the queue. */ + void push(Element samples) + { + std::unique_lock lock(m_mutex); + m_queue.push(samples); + } + + bool pull(Element &sample) + { + std::unique_lock lock(m_mutex); + if (!m_queue.empty()) + { + sample = m_queue.front(); + m_queue.pop(); + return true; + } + return false; + } + + size_t size() + { + std::unique_lock lock(m_mutex); + return m_queue.size(); + } + + private: + std::queue m_queue; + std::mutex m_mutex; +}; + diff --git a/wsjtx_lib/README.md b/wsjtx_lib/README.md new file mode 100644 index 0000000..2879953 --- /dev/null +++ b/wsjtx_lib/README.md @@ -0,0 +1,51 @@ +# WSJTX JT4, jt65, jt9, FT4, FT8, C++ library +The fortran code is owned by Joe Taylor, K1JT.
+Copyright (C) 2001 - 2021 by Joe Taylor, K1JT.
+Copyright (C) 2023 PA0PHH c++ part
+ +The wsjtx code and wspr code is used from wsjtx project and rtlsdr-wsprd under GNU Licence
+https://wsjt.sourceforge.io/wsjtx.html
+https://github.com/Guenael/rtlsdr-wsprd
+ +This library is an attempt to package wsjtx fortran code into a c++ callable library +It is intended for implementation in SDR tranceivers running in linux (raspberry pi) +The library can be build, on linux, by downloading and building the cmake file. + +## Install and compile with cmake +To use the library dowload git repo, there is an dependency to cmake, gfortran, and fftw3 +``` +sudo apt install cmake g++ +sudo apt install gfortran +sudo apt install libfftw3-3 +sudo apt install libfftw3-dev +sudo apt install libboost-all-dev +``` + +## Compile with cmake (assuming all libraries are available) +``` +git clone the repo +cd wsjtx_lib +mkdir build +cd build +cmake .. +make +sudo make install +``` +To use the library +``` +#include + +add to the linker -l"wsjtx_lib" -l"pthread" -l"fftw3f" -l"fftw3f_threads" -l"gfortran" +``` +Create wsjtx_lib class and use the methods
+Sample wav files are part of the original wsjtx download
+ +ToDo: +- Expose ... FST4 and other protocols + +Done: +- FT8 decoder +- FT4 decoder +- FT8 Encoder +- FT4 Encoder +- WSPR decoder \ No newline at end of file diff --git a/wsjtx_lib/commons.h b/wsjtx_lib/commons.h new file mode 100644 index 0000000..a813231 --- /dev/null +++ b/wsjtx_lib/commons.h @@ -0,0 +1,102 @@ +#ifndef COMMONS_H +#define COMMONS_H + +#define NSMAX 6827 +#define NTMAX 30*60 +#define RX_SAMPLE_RATE 12000 + +#ifdef __cplusplus +#include +#else +#include +#endif + + /* + * This structure is shared with Fortran code, it MUST be kept in + * sync with lib/jt9com.f90 + */ + typedef struct params + { + int nutc; //UTC as integer, HHMM + bool ndiskdat; //true ==> data read from *.wav file + int ntrperiod; //TR period (seconds) + int nQSOProgress; //QSO state machine state + int nfqso; //User-selected QSO freq (kHz) + int nftx; //TX audio offset where replies might be expected + bool newdat; //true ==> new data, must do long FFT + int npts8; //npts for c0() array + int nfa; //Low decode limit (Hz) + int nfSplit; //JT65 | JT9 split frequency + int nfb; //High decode limit (Hz) + int ntol; //+/- decoding range around fQSO (Hz) + int kin; + int nzhsym; + int nsubmode; + bool nagain; + int ndepth; + bool lft8apon; + bool lapcqonly; + bool ljt65apon; + int napwid; + int ntxmode; + int nmode; + int minw; + bool nclearave; + int minSync; + float emedelay; + float dttol; + int nlist; + int listutc[10]; + int n2pass; + int nranera; + int naggressive; + bool nrobust; + int nexp_decode; + int max_drift; + char datetime[20]; + char mycall[12]; + char mygrid[6]; + char hiscall[12]; + char hisgrid[6]; + } params_t; + +typedef struct dec_data { + int ipc[3]; + float ss[184*NSMAX]; + float savg[NSMAX]; + float sred[5760]; + short int d2[NTMAX*RX_SAMPLE_RATE]; + params_t params; +} dec_data_t; + +#ifdef __cplusplus +extern "C" { +#endif + +extern struct { + float syellow[NSMAX]; + float ref[3457]; + float filter[3457]; +} spectra_; + +extern struct { + int nclearave; + int nsum; + float blue[4096]; + float red[4096]; +} echocom_; + +extern struct { + float wave[(160+2)*134400*4]; /* (nsym+2)*nsps scaled up to 48kHz */ + int nslots; + int nfreq; + int i3bit[5]; + char cmsg[5][40]; + char mycall[12]; +} foxcom_; + +#ifdef __cplusplus +} +#endif + +#endif // COMMONS_H diff --git a/wsjtx_lib/constants.h b/wsjtx_lib/constants.h new file mode 100644 index 0000000..492a847 --- /dev/null +++ b/wsjtx_lib/constants.h @@ -0,0 +1,86 @@ +#ifndef _INCLUDE_CONSTANTS_H_ +#define _INCLUDE_CONSTANTS_H_ + +#include + +typedef enum +{ + PROTO_FT4, + PROTO_FT8 +} ftx_protocol_t; + +#define FT8_SYMBOL_PERIOD (0.160f) ///< FT8 symbol duration, defines tone deviation in Hz and symbol rate +#define FT8_SLOT_TIME (15.0f) ///< FT8 slot period +#define FT8_SAMPLERATE (12000) + +#define FT4_SYMBOL_PERIOD (0.048f) ///< FT4 symbol duration, defines tone deviation in Hz and symbol rate +#define FT4_SLOT_TIME (7.5f) ///< FT4 slot period +#define FT4_SAMPLERATE (12000) + +#define FT8_SYMBOL_BT 2.0f ///< symbol smoothing filter bandwidth factor (BT) +#define FT4_SYMBOL_BT 1.0f ///< symbol smoothing filter bandwidth factor (BT) + +// Define FT8 symbol counts +// FT8 message structure: +// S D1 S D2 S +// S - sync block (7 symbols of Costas pattern) +// D1 - first data block (29 symbols each encoding 3 bits) +#define FT8_ND (58) ///< Data symbols +#define FT8_NN (79) ///< Total channel symbols (FT8_NS + FT8_ND) +#define FT8_LENGTH_SYNC (7) ///< Length of each sync group +#define FT8_NUM_SYNC (3) ///< Number of sync groups +#define FT8_SYNC_OFFSET (36) ///< Offset between sync groups + +// Define FT4 symbol counts +// FT4 message structure: +// R Sa D1 Sb D2 Sc D3 Sd R +// R - ramping symbol (no payload information conveyed) +// Sx - one of four _different_ sync blocks (4 symbols of Costas pattern) +// Dy - data block (29 symbols each encoding 2 bits) +#define FT4_ND (87) ///< Data symbols +#define FT4_NR (2) ///< Ramp symbols (beginning + end) +#define FT4_NN (105) ///< Total channel symbols (FT4_NS + FT4_ND + FT4_NR) +#define FT4_LENGTH_SYNC (4) ///< Length of each sync group +#define FT4_NUM_SYNC (4) ///< Number of sync groups +#define FT4_SYNC_OFFSET (33) ///< Offset between sync groups + +// Define LDPC parameters +#define FTX_LDPC_N (174) ///< Number of bits in the encoded message (payload with LDPC checksum bits) +#define FTX_LDPC_K (91) ///< Number of payload bits (including CRC) +#define FTX_LDPC_M (83) ///< Number of LDPC checksum bits (FTX_LDPC_N - FTX_LDPC_K) +#define FTX_LDPC_N_BYTES ((FTX_LDPC_N + 7) / 8) ///< Number of whole bytes needed to store 174 bits (full message) +#define FTX_LDPC_K_BYTES ((FTX_LDPC_K + 7) / 8) ///< Number of whole bytes needed to store 91 bits (payload + CRC only) + +// Define CRC parameters +#define FT8_CRC_POLYNOMIAL ((uint16_t)0x2757u) ///< CRC-14 polynomial without the leading (MSB) 1 +#define FT8_CRC_WIDTH (14) + +/// Costas 7x7 tone pattern for synchronization +extern const uint8_t kFT8_Costas_pattern[7]; +extern const uint8_t kFT4_Costas_pattern[4][4]; + +/// Gray code map to encode 8 symbols (tones) +extern const uint8_t kFT8_Gray_map[8]; +extern const uint8_t kFT4_Gray_map[4]; + +extern const uint8_t kFT4_XOR_sequence[10]; + +/// Parity generator matrix for (174,91) LDPC code, stored in bitpacked format (MSB first) +extern const uint8_t kFTX_LDPC_generator[FTX_LDPC_M][FTX_LDPC_K_BYTES]; + +/// LDPC(174,91) parity check matrix, containing 83 rows, +/// each row describes one parity check, +/// each number is an index into the codeword (1-origin). +/// The codeword bits mentioned in each row must xor to zero. +/// From WSJT-X's ldpc_174_91_c_reordered_parity.f90. +extern const uint8_t kFTX_LDPC_Nm[FTX_LDPC_M][7]; + +/// Mn from WSJT-X's bpdecode174.f90. Each row corresponds to a codeword bit. +/// The numbers indicate which three parity checks (rows in Nm) refer to the codeword bit. +/// The numbers use 1 as the origin (first entry). +extern const uint8_t kFTX_LDPC_Mn[FTX_LDPC_N][3]; + +/// Number of rows (columns in C/C++) in the array Nm. +extern const uint8_t kFTX_LDPC_Num_rows[FTX_LDPC_M]; + +#endif // _INCLUDE_CONSTANTS_H_ diff --git a/wsjtx_lib/example/date.h b/wsjtx_lib/example/date.h new file mode 100644 index 0000000..6960e8c --- /dev/null +++ b/wsjtx_lib/example/date.h @@ -0,0 +1,8234 @@ +#ifndef DATE_H +#define DATE_H + +// The MIT License (MIT) +// +// Copyright (c) 2015, 2016, 2017 Howard Hinnant +// Copyright (c) 2016 Adrian Colomitchi +// Copyright (c) 2017 Florian Dang +// Copyright (c) 2017 Paul Thompson +// Copyright (c) 2018, 2019 Tomasz Kamiński +// Copyright (c) 2019 Jiangang Zhuang +// +// Permission is hereby granted, free of charge, to any person obtaining a copy +// of this software and associated documentation files (the "Software"), to deal +// in the Software without restriction, including without limitation the rights +// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +// copies of the Software, and to permit persons to whom the Software is +// furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in all +// copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +// SOFTWARE. +// +// Our apologies. When the previous paragraph was written, lowercase had not yet +// been invented (that would involve another several millennia of evolution). +// We did not mean to shout. + +#ifndef HAS_STRING_VIEW +# if __cplusplus >= 201703 || (defined(_MSVC_LANG) && _MSVC_LANG >= 201703L) +# define HAS_STRING_VIEW 1 +# else +# define HAS_STRING_VIEW 0 +# endif +#endif // HAS_STRING_VIEW + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#if HAS_STRING_VIEW +# include +#endif +#include +#include + +#ifdef __GNUC__ +# pragma GCC diagnostic push +# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 7) +# pragma GCC diagnostic ignored "-Wpedantic" +# endif +# if __GNUC__ < 5 + // GCC 4.9 Bug 61489 Wrong warning with -Wmissing-field-initializers +# pragma GCC diagnostic ignored "-Wmissing-field-initializers" +# endif +#endif + +#ifdef _MSC_VER +# pragma warning(push) +// warning C4127: conditional expression is constant +# pragma warning(disable : 4127) +#endif + +namespace date +{ + +//---------------+ +// Configuration | +//---------------+ + +#ifndef ONLY_C_LOCALE +# define ONLY_C_LOCALE 0 +#endif + +#if defined(_MSC_VER) && (!defined(__clang__) || (_MSC_VER < 1910)) +// MSVC +# ifndef _SILENCE_CXX17_UNCAUGHT_EXCEPTION_DEPRECATION_WARNING +# define _SILENCE_CXX17_UNCAUGHT_EXCEPTION_DEPRECATION_WARNING +# endif +# if _MSC_VER < 1910 +// before VS2017 +# define CONSTDATA const +# define CONSTCD11 +# define CONSTCD14 +# define NOEXCEPT _NOEXCEPT +# else +// VS2017 and later +# define CONSTDATA constexpr const +# define CONSTCD11 constexpr +# define CONSTCD14 constexpr +# define NOEXCEPT noexcept +# endif + +#elif defined(__SUNPRO_CC) && __SUNPRO_CC <= 0x5150 +// Oracle Developer Studio 12.6 and earlier +# define CONSTDATA constexpr const +# define CONSTCD11 constexpr +# define CONSTCD14 +# define NOEXCEPT noexcept + +#elif __cplusplus >= 201402 +// C++14 +# define CONSTDATA constexpr const +# define CONSTCD11 constexpr +# define CONSTCD14 constexpr +# define NOEXCEPT noexcept +#else +// C++11 +# define CONSTDATA constexpr const +# define CONSTCD11 constexpr +# define CONSTCD14 +# define NOEXCEPT noexcept +#endif + +#ifndef HAS_UNCAUGHT_EXCEPTIONS +# if __cplusplus >= 201703 || (defined(_MSVC_LANG) && _MSVC_LANG >= 201703L) +# define HAS_UNCAUGHT_EXCEPTIONS 1 +# else +# define HAS_UNCAUGHT_EXCEPTIONS 0 +# endif +#endif // HAS_UNCAUGHT_EXCEPTIONS + +#ifndef HAS_VOID_T +# if __cplusplus >= 201703 || (defined(_MSVC_LANG) && _MSVC_LANG >= 201703L) +# define HAS_VOID_T 1 +# else +# define HAS_VOID_T 0 +# endif +#endif // HAS_VOID_T + +// Protect from Oracle sun macro +#ifdef sun +# undef sun +#endif + +// Work around for a NVCC compiler bug which causes it to fail +// to compile std::ratio_{multiply,divide} when used directly +// in the std::chrono::duration template instantiations below +namespace detail { +template +using ratio_multiply = decltype(std::ratio_multiply{}); + +template +using ratio_divide = decltype(std::ratio_divide{}); +} // namespace detail + +//-----------+ +// Interface | +//-----------+ + +// durations + +using days = std::chrono::duration + , std::chrono::hours::period>>; + +using weeks = std::chrono::duration + , days::period>>; + +using years = std::chrono::duration + , days::period>>; + +using months = std::chrono::duration + >>; + +// time_point + +template + using sys_time = std::chrono::time_point; + +using sys_days = sys_time; +using sys_seconds = sys_time; + +struct local_t {}; + +template + using local_time = std::chrono::time_point; + +using local_seconds = local_time; +using local_days = local_time; + +// types + +struct last_spec +{ + explicit last_spec() = default; +}; + +class day; +class month; +class year; + +class weekday; +class weekday_indexed; +class weekday_last; + +class month_day; +class month_day_last; +class month_weekday; +class month_weekday_last; + +class year_month; + +class year_month_day; +class year_month_day_last; +class year_month_weekday; +class year_month_weekday_last; + +// date composition operators + +CONSTCD11 year_month operator/(const year& y, const month& m) NOEXCEPT; +CONSTCD11 year_month operator/(const year& y, int m) NOEXCEPT; + +CONSTCD11 month_day operator/(const day& d, const month& m) NOEXCEPT; +CONSTCD11 month_day operator/(const day& d, int m) NOEXCEPT; +CONSTCD11 month_day operator/(const month& m, const day& d) NOEXCEPT; +CONSTCD11 month_day operator/(const month& m, int d) NOEXCEPT; +CONSTCD11 month_day operator/(int m, const day& d) NOEXCEPT; + +CONSTCD11 month_day_last operator/(const month& m, last_spec) NOEXCEPT; +CONSTCD11 month_day_last operator/(int m, last_spec) NOEXCEPT; +CONSTCD11 month_day_last operator/(last_spec, const month& m) NOEXCEPT; +CONSTCD11 month_day_last operator/(last_spec, int m) NOEXCEPT; + +CONSTCD11 month_weekday operator/(const month& m, const weekday_indexed& wdi) NOEXCEPT; +CONSTCD11 month_weekday operator/(int m, const weekday_indexed& wdi) NOEXCEPT; +CONSTCD11 month_weekday operator/(const weekday_indexed& wdi, const month& m) NOEXCEPT; +CONSTCD11 month_weekday operator/(const weekday_indexed& wdi, int m) NOEXCEPT; + +CONSTCD11 month_weekday_last operator/(const month& m, const weekday_last& wdl) NOEXCEPT; +CONSTCD11 month_weekday_last operator/(int m, const weekday_last& wdl) NOEXCEPT; +CONSTCD11 month_weekday_last operator/(const weekday_last& wdl, const month& m) NOEXCEPT; +CONSTCD11 month_weekday_last operator/(const weekday_last& wdl, int m) NOEXCEPT; + +CONSTCD11 year_month_day operator/(const year_month& ym, const day& d) NOEXCEPT; +CONSTCD11 year_month_day operator/(const year_month& ym, int d) NOEXCEPT; +CONSTCD11 year_month_day operator/(const year& y, const month_day& md) NOEXCEPT; +CONSTCD11 year_month_day operator/(int y, const month_day& md) NOEXCEPT; +CONSTCD11 year_month_day operator/(const month_day& md, const year& y) NOEXCEPT; +CONSTCD11 year_month_day operator/(const month_day& md, int y) NOEXCEPT; + +CONSTCD11 + year_month_day_last operator/(const year_month& ym, last_spec) NOEXCEPT; +CONSTCD11 + year_month_day_last operator/(const year& y, const month_day_last& mdl) NOEXCEPT; +CONSTCD11 + year_month_day_last operator/(int y, const month_day_last& mdl) NOEXCEPT; +CONSTCD11 + year_month_day_last operator/(const month_day_last& mdl, const year& y) NOEXCEPT; +CONSTCD11 + year_month_day_last operator/(const month_day_last& mdl, int y) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator/(const year_month& ym, const weekday_indexed& wdi) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator/(const year& y, const month_weekday& mwd) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator/(int y, const month_weekday& mwd) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator/(const month_weekday& mwd, const year& y) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator/(const month_weekday& mwd, int y) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator/(const year_month& ym, const weekday_last& wdl) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator/(const year& y, const month_weekday_last& mwdl) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator/(int y, const month_weekday_last& mwdl) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator/(const month_weekday_last& mwdl, const year& y) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator/(const month_weekday_last& mwdl, int y) NOEXCEPT; + +// Detailed interface + +// day + +class day +{ + unsigned char d_; + +public: + day() = default; + explicit CONSTCD11 day(unsigned d) NOEXCEPT; + + CONSTCD14 day& operator++() NOEXCEPT; + CONSTCD14 day operator++(int) NOEXCEPT; + CONSTCD14 day& operator--() NOEXCEPT; + CONSTCD14 day operator--(int) NOEXCEPT; + + CONSTCD14 day& operator+=(const days& d) NOEXCEPT; + CONSTCD14 day& operator-=(const days& d) NOEXCEPT; + + CONSTCD11 explicit operator unsigned() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const day& x, const day& y) NOEXCEPT; +CONSTCD11 bool operator!=(const day& x, const day& y) NOEXCEPT; +CONSTCD11 bool operator< (const day& x, const day& y) NOEXCEPT; +CONSTCD11 bool operator> (const day& x, const day& y) NOEXCEPT; +CONSTCD11 bool operator<=(const day& x, const day& y) NOEXCEPT; +CONSTCD11 bool operator>=(const day& x, const day& y) NOEXCEPT; + +CONSTCD11 day operator+(const day& x, const days& y) NOEXCEPT; +CONSTCD11 day operator+(const days& x, const day& y) NOEXCEPT; +CONSTCD11 day operator-(const day& x, const days& y) NOEXCEPT; +CONSTCD11 days operator-(const day& x, const day& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const day& d); + +// month + +class month +{ + unsigned char m_; + +public: + month() = default; + explicit CONSTCD11 month(unsigned m) NOEXCEPT; + + CONSTCD14 month& operator++() NOEXCEPT; + CONSTCD14 month operator++(int) NOEXCEPT; + CONSTCD14 month& operator--() NOEXCEPT; + CONSTCD14 month operator--(int) NOEXCEPT; + + CONSTCD14 month& operator+=(const months& m) NOEXCEPT; + CONSTCD14 month& operator-=(const months& m) NOEXCEPT; + + CONSTCD11 explicit operator unsigned() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const month& x, const month& y) NOEXCEPT; +CONSTCD11 bool operator!=(const month& x, const month& y) NOEXCEPT; +CONSTCD11 bool operator< (const month& x, const month& y) NOEXCEPT; +CONSTCD11 bool operator> (const month& x, const month& y) NOEXCEPT; +CONSTCD11 bool operator<=(const month& x, const month& y) NOEXCEPT; +CONSTCD11 bool operator>=(const month& x, const month& y) NOEXCEPT; + +CONSTCD14 month operator+(const month& x, const months& y) NOEXCEPT; +CONSTCD14 month operator+(const months& x, const month& y) NOEXCEPT; +CONSTCD14 month operator-(const month& x, const months& y) NOEXCEPT; +CONSTCD14 months operator-(const month& x, const month& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const month& m); + +// year + +class year +{ + short y_; + +public: + year() = default; + explicit CONSTCD11 year(int y) NOEXCEPT; + + CONSTCD14 year& operator++() NOEXCEPT; + CONSTCD14 year operator++(int) NOEXCEPT; + CONSTCD14 year& operator--() NOEXCEPT; + CONSTCD14 year operator--(int) NOEXCEPT; + + CONSTCD14 year& operator+=(const years& y) NOEXCEPT; + CONSTCD14 year& operator-=(const years& y) NOEXCEPT; + + CONSTCD11 year operator-() const NOEXCEPT; + CONSTCD11 year operator+() const NOEXCEPT; + + CONSTCD11 bool is_leap() const NOEXCEPT; + + CONSTCD11 explicit operator int() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; + + static CONSTCD11 year min() NOEXCEPT { return year{-32767}; } + static CONSTCD11 year max() NOEXCEPT { return year{32767}; } +}; + +CONSTCD11 bool operator==(const year& x, const year& y) NOEXCEPT; +CONSTCD11 bool operator!=(const year& x, const year& y) NOEXCEPT; +CONSTCD11 bool operator< (const year& x, const year& y) NOEXCEPT; +CONSTCD11 bool operator> (const year& x, const year& y) NOEXCEPT; +CONSTCD11 bool operator<=(const year& x, const year& y) NOEXCEPT; +CONSTCD11 bool operator>=(const year& x, const year& y) NOEXCEPT; + +CONSTCD11 year operator+(const year& x, const years& y) NOEXCEPT; +CONSTCD11 year operator+(const years& x, const year& y) NOEXCEPT; +CONSTCD11 year operator-(const year& x, const years& y) NOEXCEPT; +CONSTCD11 years operator-(const year& x, const year& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const year& y); + +// weekday + +class weekday +{ + unsigned char wd_; +public: + weekday() = default; + explicit CONSTCD11 weekday(unsigned wd) NOEXCEPT; + CONSTCD14 weekday(const sys_days& dp) NOEXCEPT; + CONSTCD14 explicit weekday(const local_days& dp) NOEXCEPT; + + CONSTCD14 weekday& operator++() NOEXCEPT; + CONSTCD14 weekday operator++(int) NOEXCEPT; + CONSTCD14 weekday& operator--() NOEXCEPT; + CONSTCD14 weekday operator--(int) NOEXCEPT; + + CONSTCD14 weekday& operator+=(const days& d) NOEXCEPT; + CONSTCD14 weekday& operator-=(const days& d) NOEXCEPT; + + CONSTCD11 bool ok() const NOEXCEPT; + + CONSTCD11 unsigned c_encoding() const NOEXCEPT; + CONSTCD11 unsigned iso_encoding() const NOEXCEPT; + + CONSTCD11 weekday_indexed operator[](unsigned index) const NOEXCEPT; + CONSTCD11 weekday_last operator[](last_spec) const NOEXCEPT; + +private: + static CONSTCD14 unsigned char weekday_from_days(int z) NOEXCEPT; + + friend CONSTCD11 bool operator==(const weekday& x, const weekday& y) NOEXCEPT; + friend CONSTCD14 days operator-(const weekday& x, const weekday& y) NOEXCEPT; + friend CONSTCD14 weekday operator+(const weekday& x, const days& y) NOEXCEPT; + template + friend std::basic_ostream& + operator<<(std::basic_ostream& os, const weekday& wd); + friend class weekday_indexed; +}; + +CONSTCD11 bool operator==(const weekday& x, const weekday& y) NOEXCEPT; +CONSTCD11 bool operator!=(const weekday& x, const weekday& y) NOEXCEPT; + +CONSTCD14 weekday operator+(const weekday& x, const days& y) NOEXCEPT; +CONSTCD14 weekday operator+(const days& x, const weekday& y) NOEXCEPT; +CONSTCD14 weekday operator-(const weekday& x, const days& y) NOEXCEPT; +CONSTCD14 days operator-(const weekday& x, const weekday& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const weekday& wd); + +// weekday_indexed + +class weekday_indexed +{ + unsigned char wd_ : 4; + unsigned char index_ : 4; + +public: + weekday_indexed() = default; + CONSTCD11 weekday_indexed(const date::weekday& wd, unsigned index) NOEXCEPT; + + CONSTCD11 date::weekday weekday() const NOEXCEPT; + CONSTCD11 unsigned index() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const weekday_indexed& x, const weekday_indexed& y) NOEXCEPT; +CONSTCD11 bool operator!=(const weekday_indexed& x, const weekday_indexed& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const weekday_indexed& wdi); + +// weekday_last + +class weekday_last +{ + date::weekday wd_; + +public: + explicit CONSTCD11 weekday_last(const date::weekday& wd) NOEXCEPT; + + CONSTCD11 date::weekday weekday() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const weekday_last& x, const weekday_last& y) NOEXCEPT; +CONSTCD11 bool operator!=(const weekday_last& x, const weekday_last& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const weekday_last& wdl); + +namespace detail +{ + +struct unspecified_month_disambiguator {}; + +} // namespace detail + +// year_month + +class year_month +{ + date::year y_; + date::month m_; + +public: + year_month() = default; + CONSTCD11 year_month(const date::year& y, const date::month& m) NOEXCEPT; + + CONSTCD11 date::year year() const NOEXCEPT; + CONSTCD11 date::month month() const NOEXCEPT; + + template + CONSTCD14 year_month& operator+=(const months& dm) NOEXCEPT; + template + CONSTCD14 year_month& operator-=(const months& dm) NOEXCEPT; + CONSTCD14 year_month& operator+=(const years& dy) NOEXCEPT; + CONSTCD14 year_month& operator-=(const years& dy) NOEXCEPT; + + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const year_month& x, const year_month& y) NOEXCEPT; +CONSTCD11 bool operator!=(const year_month& x, const year_month& y) NOEXCEPT; +CONSTCD11 bool operator< (const year_month& x, const year_month& y) NOEXCEPT; +CONSTCD11 bool operator> (const year_month& x, const year_month& y) NOEXCEPT; +CONSTCD11 bool operator<=(const year_month& x, const year_month& y) NOEXCEPT; +CONSTCD11 bool operator>=(const year_month& x, const year_month& y) NOEXCEPT; + +template +CONSTCD14 year_month operator+(const year_month& ym, const months& dm) NOEXCEPT; +template +CONSTCD14 year_month operator+(const months& dm, const year_month& ym) NOEXCEPT; +template +CONSTCD14 year_month operator-(const year_month& ym, const months& dm) NOEXCEPT; + +CONSTCD11 months operator-(const year_month& x, const year_month& y) NOEXCEPT; +CONSTCD11 year_month operator+(const year_month& ym, const years& dy) NOEXCEPT; +CONSTCD11 year_month operator+(const years& dy, const year_month& ym) NOEXCEPT; +CONSTCD11 year_month operator-(const year_month& ym, const years& dy) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month& ym); + +// month_day + +class month_day +{ + date::month m_; + date::day d_; + +public: + month_day() = default; + CONSTCD11 month_day(const date::month& m, const date::day& d) NOEXCEPT; + + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::day day() const NOEXCEPT; + + CONSTCD14 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const month_day& x, const month_day& y) NOEXCEPT; +CONSTCD11 bool operator!=(const month_day& x, const month_day& y) NOEXCEPT; +CONSTCD11 bool operator< (const month_day& x, const month_day& y) NOEXCEPT; +CONSTCD11 bool operator> (const month_day& x, const month_day& y) NOEXCEPT; +CONSTCD11 bool operator<=(const month_day& x, const month_day& y) NOEXCEPT; +CONSTCD11 bool operator>=(const month_day& x, const month_day& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_day& md); + +// month_day_last + +class month_day_last +{ + date::month m_; + +public: + CONSTCD11 explicit month_day_last(const date::month& m) NOEXCEPT; + + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const month_day_last& x, const month_day_last& y) NOEXCEPT; +CONSTCD11 bool operator!=(const month_day_last& x, const month_day_last& y) NOEXCEPT; +CONSTCD11 bool operator< (const month_day_last& x, const month_day_last& y) NOEXCEPT; +CONSTCD11 bool operator> (const month_day_last& x, const month_day_last& y) NOEXCEPT; +CONSTCD11 bool operator<=(const month_day_last& x, const month_day_last& y) NOEXCEPT; +CONSTCD11 bool operator>=(const month_day_last& x, const month_day_last& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_day_last& mdl); + +// month_weekday + +class month_weekday +{ + date::month m_; + date::weekday_indexed wdi_; +public: + CONSTCD11 month_weekday(const date::month& m, + const date::weekday_indexed& wdi) NOEXCEPT; + + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::weekday_indexed weekday_indexed() const NOEXCEPT; + + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const month_weekday& x, const month_weekday& y) NOEXCEPT; +CONSTCD11 bool operator!=(const month_weekday& x, const month_weekday& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_weekday& mwd); + +// month_weekday_last + +class month_weekday_last +{ + date::month m_; + date::weekday_last wdl_; + +public: + CONSTCD11 month_weekday_last(const date::month& m, + const date::weekday_last& wd) NOEXCEPT; + + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::weekday_last weekday_last() const NOEXCEPT; + + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 + bool operator==(const month_weekday_last& x, const month_weekday_last& y) NOEXCEPT; +CONSTCD11 + bool operator!=(const month_weekday_last& x, const month_weekday_last& y) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_weekday_last& mwdl); + +// class year_month_day + +class year_month_day +{ + date::year y_; + date::month m_; + date::day d_; + +public: + year_month_day() = default; + CONSTCD11 year_month_day(const date::year& y, const date::month& m, + const date::day& d) NOEXCEPT; + CONSTCD14 year_month_day(const year_month_day_last& ymdl) NOEXCEPT; + + CONSTCD14 year_month_day(sys_days dp) NOEXCEPT; + CONSTCD14 explicit year_month_day(local_days dp) NOEXCEPT; + + template + CONSTCD14 year_month_day& operator+=(const months& m) NOEXCEPT; + template + CONSTCD14 year_month_day& operator-=(const months& m) NOEXCEPT; + CONSTCD14 year_month_day& operator+=(const years& y) NOEXCEPT; + CONSTCD14 year_month_day& operator-=(const years& y) NOEXCEPT; + + CONSTCD11 date::year year() const NOEXCEPT; + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::day day() const NOEXCEPT; + + CONSTCD14 operator sys_days() const NOEXCEPT; + CONSTCD14 explicit operator local_days() const NOEXCEPT; + CONSTCD14 bool ok() const NOEXCEPT; + +private: + static CONSTCD14 year_month_day from_days(days dp) NOEXCEPT; + CONSTCD14 days to_days() const NOEXCEPT; +}; + +CONSTCD11 bool operator==(const year_month_day& x, const year_month_day& y) NOEXCEPT; +CONSTCD11 bool operator!=(const year_month_day& x, const year_month_day& y) NOEXCEPT; +CONSTCD11 bool operator< (const year_month_day& x, const year_month_day& y) NOEXCEPT; +CONSTCD11 bool operator> (const year_month_day& x, const year_month_day& y) NOEXCEPT; +CONSTCD11 bool operator<=(const year_month_day& x, const year_month_day& y) NOEXCEPT; +CONSTCD11 bool operator>=(const year_month_day& x, const year_month_day& y) NOEXCEPT; + +template +CONSTCD14 year_month_day operator+(const year_month_day& ymd, const months& dm) NOEXCEPT; +template +CONSTCD14 year_month_day operator+(const months& dm, const year_month_day& ymd) NOEXCEPT; +template +CONSTCD14 year_month_day operator-(const year_month_day& ymd, const months& dm) NOEXCEPT; +CONSTCD11 year_month_day operator+(const year_month_day& ymd, const years& dy) NOEXCEPT; +CONSTCD11 year_month_day operator+(const years& dy, const year_month_day& ymd) NOEXCEPT; +CONSTCD11 year_month_day operator-(const year_month_day& ymd, const years& dy) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_day& ymd); + +// year_month_day_last + +class year_month_day_last +{ + date::year y_; + date::month_day_last mdl_; + +public: + CONSTCD11 year_month_day_last(const date::year& y, + const date::month_day_last& mdl) NOEXCEPT; + + template + CONSTCD14 year_month_day_last& operator+=(const months& m) NOEXCEPT; + template + CONSTCD14 year_month_day_last& operator-=(const months& m) NOEXCEPT; + CONSTCD14 year_month_day_last& operator+=(const years& y) NOEXCEPT; + CONSTCD14 year_month_day_last& operator-=(const years& y) NOEXCEPT; + + CONSTCD11 date::year year() const NOEXCEPT; + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::month_day_last month_day_last() const NOEXCEPT; + CONSTCD14 date::day day() const NOEXCEPT; + + CONSTCD14 operator sys_days() const NOEXCEPT; + CONSTCD14 explicit operator local_days() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; +}; + +CONSTCD11 + bool operator==(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT; +CONSTCD11 + bool operator!=(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT; +CONSTCD11 + bool operator< (const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT; +CONSTCD11 + bool operator> (const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT; +CONSTCD11 + bool operator<=(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT; +CONSTCD11 + bool operator>=(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT; + +template +CONSTCD14 +year_month_day_last +operator+(const year_month_day_last& ymdl, const months& dm) NOEXCEPT; + +template +CONSTCD14 +year_month_day_last +operator+(const months& dm, const year_month_day_last& ymdl) NOEXCEPT; + +CONSTCD11 +year_month_day_last +operator+(const year_month_day_last& ymdl, const years& dy) NOEXCEPT; + +CONSTCD11 +year_month_day_last +operator+(const years& dy, const year_month_day_last& ymdl) NOEXCEPT; + +template +CONSTCD14 +year_month_day_last +operator-(const year_month_day_last& ymdl, const months& dm) NOEXCEPT; + +CONSTCD11 +year_month_day_last +operator-(const year_month_day_last& ymdl, const years& dy) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_day_last& ymdl); + +// year_month_weekday + +class year_month_weekday +{ + date::year y_; + date::month m_; + date::weekday_indexed wdi_; + +public: + year_month_weekday() = default; + CONSTCD11 year_month_weekday(const date::year& y, const date::month& m, + const date::weekday_indexed& wdi) NOEXCEPT; + CONSTCD14 year_month_weekday(const sys_days& dp) NOEXCEPT; + CONSTCD14 explicit year_month_weekday(const local_days& dp) NOEXCEPT; + + template + CONSTCD14 year_month_weekday& operator+=(const months& m) NOEXCEPT; + template + CONSTCD14 year_month_weekday& operator-=(const months& m) NOEXCEPT; + CONSTCD14 year_month_weekday& operator+=(const years& y) NOEXCEPT; + CONSTCD14 year_month_weekday& operator-=(const years& y) NOEXCEPT; + + CONSTCD11 date::year year() const NOEXCEPT; + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::weekday weekday() const NOEXCEPT; + CONSTCD11 unsigned index() const NOEXCEPT; + CONSTCD11 date::weekday_indexed weekday_indexed() const NOEXCEPT; + + CONSTCD14 operator sys_days() const NOEXCEPT; + CONSTCD14 explicit operator local_days() const NOEXCEPT; + CONSTCD14 bool ok() const NOEXCEPT; + +private: + static CONSTCD14 year_month_weekday from_days(days dp) NOEXCEPT; + CONSTCD14 days to_days() const NOEXCEPT; +}; + +CONSTCD11 + bool operator==(const year_month_weekday& x, const year_month_weekday& y) NOEXCEPT; +CONSTCD11 + bool operator!=(const year_month_weekday& x, const year_month_weekday& y) NOEXCEPT; + +template +CONSTCD14 +year_month_weekday +operator+(const year_month_weekday& ymwd, const months& dm) NOEXCEPT; + +template +CONSTCD14 +year_month_weekday +operator+(const months& dm, const year_month_weekday& ymwd) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator+(const year_month_weekday& ymwd, const years& dy) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator+(const years& dy, const year_month_weekday& ymwd) NOEXCEPT; + +template +CONSTCD14 +year_month_weekday +operator-(const year_month_weekday& ymwd, const months& dm) NOEXCEPT; + +CONSTCD11 +year_month_weekday +operator-(const year_month_weekday& ymwd, const years& dy) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_weekday& ymwdi); + +// year_month_weekday_last + +class year_month_weekday_last +{ + date::year y_; + date::month m_; + date::weekday_last wdl_; + +public: + CONSTCD11 year_month_weekday_last(const date::year& y, const date::month& m, + const date::weekday_last& wdl) NOEXCEPT; + + template + CONSTCD14 year_month_weekday_last& operator+=(const months& m) NOEXCEPT; + template + CONSTCD14 year_month_weekday_last& operator-=(const months& m) NOEXCEPT; + CONSTCD14 year_month_weekday_last& operator+=(const years& y) NOEXCEPT; + CONSTCD14 year_month_weekday_last& operator-=(const years& y) NOEXCEPT; + + CONSTCD11 date::year year() const NOEXCEPT; + CONSTCD11 date::month month() const NOEXCEPT; + CONSTCD11 date::weekday weekday() const NOEXCEPT; + CONSTCD11 date::weekday_last weekday_last() const NOEXCEPT; + + CONSTCD14 operator sys_days() const NOEXCEPT; + CONSTCD14 explicit operator local_days() const NOEXCEPT; + CONSTCD11 bool ok() const NOEXCEPT; + +private: + CONSTCD14 days to_days() const NOEXCEPT; +}; + +CONSTCD11 +bool +operator==(const year_month_weekday_last& x, const year_month_weekday_last& y) NOEXCEPT; + +CONSTCD11 +bool +operator!=(const year_month_weekday_last& x, const year_month_weekday_last& y) NOEXCEPT; + +template +CONSTCD14 +year_month_weekday_last +operator+(const year_month_weekday_last& ymwdl, const months& dm) NOEXCEPT; + +template +CONSTCD14 +year_month_weekday_last +operator+(const months& dm, const year_month_weekday_last& ymwdl) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator+(const year_month_weekday_last& ymwdl, const years& dy) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator+(const years& dy, const year_month_weekday_last& ymwdl) NOEXCEPT; + +template +CONSTCD14 +year_month_weekday_last +operator-(const year_month_weekday_last& ymwdl, const months& dm) NOEXCEPT; + +CONSTCD11 +year_month_weekday_last +operator-(const year_month_weekday_last& ymwdl, const years& dy) NOEXCEPT; + +template +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_weekday_last& ymwdl); + +#if !defined(_MSC_VER) || (_MSC_VER >= 1900) +inline namespace literals +{ + +CONSTCD11 date::day operator "" _d(unsigned long long d) NOEXCEPT; +CONSTCD11 date::year operator "" _y(unsigned long long y) NOEXCEPT; + +} // inline namespace literals +#endif // !defined(_MSC_VER) || (_MSC_VER >= 1900) + +// CONSTDATA date::month January{1}; +// CONSTDATA date::month February{2}; +// CONSTDATA date::month March{3}; +// CONSTDATA date::month April{4}; +// CONSTDATA date::month May{5}; +// CONSTDATA date::month June{6}; +// CONSTDATA date::month July{7}; +// CONSTDATA date::month August{8}; +// CONSTDATA date::month September{9}; +// CONSTDATA date::month October{10}; +// CONSTDATA date::month November{11}; +// CONSTDATA date::month December{12}; +// +// CONSTDATA date::weekday Sunday{0u}; +// CONSTDATA date::weekday Monday{1u}; +// CONSTDATA date::weekday Tuesday{2u}; +// CONSTDATA date::weekday Wednesday{3u}; +// CONSTDATA date::weekday Thursday{4u}; +// CONSTDATA date::weekday Friday{5u}; +// CONSTDATA date::weekday Saturday{6u}; + +#if HAS_VOID_T + +template > +struct is_clock + : std::false_type +{}; + +template +struct is_clock> + : std::true_type +{}; + +template inline constexpr bool is_clock_v = is_clock::value; + +#endif // HAS_VOID_T + +//----------------+ +// Implementation | +//----------------+ + +// utilities +namespace detail { + +template> +class save_istream +{ +protected: + std::basic_ios& is_; + CharT fill_; + std::ios::fmtflags flags_; + std::streamsize precision_; + std::streamsize width_; + std::basic_ostream* tie_; + std::locale loc_; + +public: + ~save_istream() + { + is_.fill(fill_); + is_.flags(flags_); + is_.precision(precision_); + is_.width(width_); + is_.imbue(loc_); + is_.tie(tie_); + } + + save_istream(const save_istream&) = delete; + save_istream& operator=(const save_istream&) = delete; + + explicit save_istream(std::basic_ios& is) + : is_(is) + , fill_(is.fill()) + , flags_(is.flags()) + , precision_(is.precision()) + , width_(is.width(0)) + , tie_(is.tie(nullptr)) + , loc_(is.getloc()) + { + if (tie_ != nullptr) + tie_->flush(); + } +}; + +template> +class save_ostream + : private save_istream +{ +public: + ~save_ostream() + { + if ((this->flags_ & std::ios::unitbuf) && +#if HAS_UNCAUGHT_EXCEPTIONS + std::uncaught_exceptions() == 0 && +#else + !std::uncaught_exception() && +#endif + this->is_.good()) + this->is_.rdbuf()->pubsync(); + } + + save_ostream(const save_ostream&) = delete; + save_ostream& operator=(const save_ostream&) = delete; + + explicit save_ostream(std::basic_ios& os) + : save_istream(os) + { + } +}; + +template +struct choose_trunc_type +{ + static const int digits = std::numeric_limits::digits; + using type = typename std::conditional + < + digits < 32, + std::int32_t, + typename std::conditional + < + digits < 64, + std::int64_t, +#ifdef __SIZEOF_INT128__ + __int128 +#else + std::int64_t +#endif + >::type + >::type; +}; + +template +CONSTCD11 +inline +typename std::enable_if +< + !std::chrono::treat_as_floating_point::value, + T +>::type +trunc(T t) NOEXCEPT +{ + return t; +} + +template +CONSTCD14 +inline +typename std::enable_if +< + std::chrono::treat_as_floating_point::value, + T +>::type +trunc(T t) NOEXCEPT +{ + using std::numeric_limits; + using I = typename choose_trunc_type::type; + CONSTDATA auto digits = numeric_limits::digits; + static_assert(digits < numeric_limits::digits, ""); + CONSTDATA auto max = I{1} << (digits-1); + CONSTDATA auto min = -max; + const auto negative = t < T{0}; + if (min <= t && t <= max && t != 0 && t == t) + { + t = static_cast(static_cast(t)); + if (t == 0 && negative) + t = -t; + } + return t; +} + +template +struct static_gcd +{ + static const std::intmax_t value = static_gcd::value; +}; + +template +struct static_gcd +{ + static const std::intmax_t value = Xp; +}; + +template <> +struct static_gcd<0, 0> +{ + static const std::intmax_t value = 1; +}; + +template +struct no_overflow +{ +private: + static const std::intmax_t gcd_n1_n2 = static_gcd::value; + static const std::intmax_t gcd_d1_d2 = static_gcd::value; + static const std::intmax_t n1 = R1::num / gcd_n1_n2; + static const std::intmax_t d1 = R1::den / gcd_d1_d2; + static const std::intmax_t n2 = R2::num / gcd_n1_n2; + static const std::intmax_t d2 = R2::den / gcd_d1_d2; +#ifdef __cpp_constexpr + static const std::intmax_t max = std::numeric_limits::max(); +#else + static const std::intmax_t max = LLONG_MAX; +#endif + + template + struct mul // overflow == false + { + static const std::intmax_t value = Xp * Yp; + }; + + template + struct mul + { + static const std::intmax_t value = 1; + }; + +public: + static const bool value = (n1 <= max / d2) && (n2 <= max / d1); + typedef std::ratio::value, + mul::value> type; +}; + +} // detail + +// trunc towards zero +template +CONSTCD11 +inline +typename std::enable_if +< + detail::no_overflow::value, + To +>::type +trunc(const std::chrono::duration& d) +{ + return To{detail::trunc(std::chrono::duration_cast(d).count())}; +} + +template +CONSTCD11 +inline +typename std::enable_if +< + !detail::no_overflow::value, + To +>::type +trunc(const std::chrono::duration& d) +{ + using std::chrono::duration_cast; + using std::chrono::duration; + using rep = typename std::common_type::type; + return To{detail::trunc(duration_cast(duration_cast>(d)).count())}; +} + +#ifndef HAS_CHRONO_ROUNDING +# if defined(_MSC_FULL_VER) && (_MSC_FULL_VER >= 190023918 || (_MSC_FULL_VER >= 190000000 && defined (__clang__))) +# define HAS_CHRONO_ROUNDING 1 +# elif defined(__cpp_lib_chrono) && __cplusplus > 201402 && __cpp_lib_chrono >= 201510 +# define HAS_CHRONO_ROUNDING 1 +# elif defined(_LIBCPP_VERSION) && __cplusplus > 201402 && _LIBCPP_VERSION >= 3800 +# define HAS_CHRONO_ROUNDING 1 +# else +# define HAS_CHRONO_ROUNDING 0 +# endif +#endif // HAS_CHRONO_ROUNDING + +#if HAS_CHRONO_ROUNDING == 0 + +// round down +template +CONSTCD14 +inline +typename std::enable_if +< + detail::no_overflow::value, + To +>::type +floor(const std::chrono::duration& d) +{ + auto t = trunc(d); + if (t > d) + return t - To{1}; + return t; +} + +template +CONSTCD14 +inline +typename std::enable_if +< + !detail::no_overflow::value, + To +>::type +floor(const std::chrono::duration& d) +{ + using rep = typename std::common_type::type; + return floor(floor>(d)); +} + +// round to nearest, to even on tie +template +CONSTCD14 +inline +To +round(const std::chrono::duration& d) +{ + auto t0 = floor(d); + auto t1 = t0 + To{1}; + if (t1 == To{0} && t0 < To{0}) + t1 = -t1; + auto diff0 = d - t0; + auto diff1 = t1 - d; + if (diff0 == diff1) + { + if (t0 - trunc(t0/2)*2 == To{0}) + return t0; + return t1; + } + if (diff0 < diff1) + return t0; + return t1; +} + +// round up +template +CONSTCD14 +inline +To +ceil(const std::chrono::duration& d) +{ + auto t = trunc(d); + if (t < d) + return t + To{1}; + return t; +} + +template ::is_signed + >::type> +CONSTCD11 +std::chrono::duration +abs(std::chrono::duration d) +{ + return d >= d.zero() ? d : static_cast(-d); +} + +// round down +template +CONSTCD11 +inline +std::chrono::time_point +floor(const std::chrono::time_point& tp) +{ + using std::chrono::time_point; + return time_point{date::floor(tp.time_since_epoch())}; +} + +// round to nearest, to even on tie +template +CONSTCD11 +inline +std::chrono::time_point +round(const std::chrono::time_point& tp) +{ + using std::chrono::time_point; + return time_point{round(tp.time_since_epoch())}; +} + +// round up +template +CONSTCD11 +inline +std::chrono::time_point +ceil(const std::chrono::time_point& tp) +{ + using std::chrono::time_point; + return time_point{ceil(tp.time_since_epoch())}; +} + +#else // HAS_CHRONO_ROUNDING == 1 + +using std::chrono::floor; +using std::chrono::ceil; +using std::chrono::round; +using std::chrono::abs; + +#endif // HAS_CHRONO_ROUNDING + +namespace detail +{ + +template +CONSTCD14 +inline +typename std::enable_if +< + !std::chrono::treat_as_floating_point::value, + To +>::type +round_i(const std::chrono::duration& d) +{ + return round(d); +} + +template +CONSTCD14 +inline +typename std::enable_if +< + std::chrono::treat_as_floating_point::value, + To +>::type +round_i(const std::chrono::duration& d) +{ + return d; +} + +template +CONSTCD11 +inline +std::chrono::time_point +round_i(const std::chrono::time_point& tp) +{ + using std::chrono::time_point; + return time_point{round_i(tp.time_since_epoch())}; +} + +} // detail + +// trunc towards zero +template +CONSTCD11 +inline +std::chrono::time_point +trunc(const std::chrono::time_point& tp) +{ + using std::chrono::time_point; + return time_point{trunc(tp.time_since_epoch())}; +} + +// day + +CONSTCD11 inline day::day(unsigned d) NOEXCEPT : d_(static_cast(d)) {} +CONSTCD14 inline day& day::operator++() NOEXCEPT {++d_; return *this;} +CONSTCD14 inline day day::operator++(int) NOEXCEPT {auto tmp(*this); ++(*this); return tmp;} +CONSTCD14 inline day& day::operator--() NOEXCEPT {--d_; return *this;} +CONSTCD14 inline day day::operator--(int) NOEXCEPT {auto tmp(*this); --(*this); return tmp;} +CONSTCD14 inline day& day::operator+=(const days& d) NOEXCEPT {*this = *this + d; return *this;} +CONSTCD14 inline day& day::operator-=(const days& d) NOEXCEPT {*this = *this - d; return *this;} +CONSTCD11 inline day::operator unsigned() const NOEXCEPT {return d_;} +CONSTCD11 inline bool day::ok() const NOEXCEPT {return 1 <= d_ && d_ <= 31;} + +CONSTCD11 +inline +bool +operator==(const day& x, const day& y) NOEXCEPT +{ + return static_cast(x) == static_cast(y); +} + +CONSTCD11 +inline +bool +operator!=(const day& x, const day& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const day& x, const day& y) NOEXCEPT +{ + return static_cast(x) < static_cast(y); +} + +CONSTCD11 +inline +bool +operator>(const day& x, const day& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const day& x, const day& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const day& x, const day& y) NOEXCEPT +{ + return !(x < y); +} + +CONSTCD11 +inline +days +operator-(const day& x, const day& y) NOEXCEPT +{ + return days{static_cast(static_cast(x) + - static_cast(y))}; +} + +CONSTCD11 +inline +day +operator+(const day& x, const days& y) NOEXCEPT +{ + return day{static_cast(x) + static_cast(y.count())}; +} + +CONSTCD11 +inline +day +operator+(const days& x, const day& y) NOEXCEPT +{ + return y + x; +} + +CONSTCD11 +inline +day +operator-(const day& x, const days& y) NOEXCEPT +{ + return x + -y; +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const day& d) +{ + detail::save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(2); + os << static_cast(d); + return os; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const day& d) +{ + detail::low_level_fmt(os, d); + if (!d.ok()) + os << " is not a valid day"; + return os; +} + +// month + +CONSTCD11 inline month::month(unsigned m) NOEXCEPT : m_(static_cast(m)) {} +CONSTCD14 inline month& month::operator++() NOEXCEPT {*this += months{1}; return *this;} +CONSTCD14 inline month month::operator++(int) NOEXCEPT {auto tmp(*this); ++(*this); return tmp;} +CONSTCD14 inline month& month::operator--() NOEXCEPT {*this -= months{1}; return *this;} +CONSTCD14 inline month month::operator--(int) NOEXCEPT {auto tmp(*this); --(*this); return tmp;} + +CONSTCD14 +inline +month& +month::operator+=(const months& m) NOEXCEPT +{ + *this = *this + m; + return *this; +} + +CONSTCD14 +inline +month& +month::operator-=(const months& m) NOEXCEPT +{ + *this = *this - m; + return *this; +} + +CONSTCD11 inline month::operator unsigned() const NOEXCEPT {return m_;} +CONSTCD11 inline bool month::ok() const NOEXCEPT {return 1 <= m_ && m_ <= 12;} + +CONSTCD11 +inline +bool +operator==(const month& x, const month& y) NOEXCEPT +{ + return static_cast(x) == static_cast(y); +} + +CONSTCD11 +inline +bool +operator!=(const month& x, const month& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const month& x, const month& y) NOEXCEPT +{ + return static_cast(x) < static_cast(y); +} + +CONSTCD11 +inline +bool +operator>(const month& x, const month& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const month& x, const month& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const month& x, const month& y) NOEXCEPT +{ + return !(x < y); +} + +CONSTCD14 +inline +months +operator-(const month& x, const month& y) NOEXCEPT +{ + auto const d = static_cast(x) - static_cast(y); + return months(d <= 11 ? d : d + 12); +} + +CONSTCD14 +inline +month +operator+(const month& x, const months& y) NOEXCEPT +{ + auto const mu = static_cast(static_cast(x)) + y.count() - 1; + auto const yr = (mu >= 0 ? mu : mu-11) / 12; + return month{static_cast(mu - yr * 12 + 1)}; +} + +CONSTCD14 +inline +month +operator+(const months& x, const month& y) NOEXCEPT +{ + return y + x; +} + +CONSTCD14 +inline +month +operator-(const month& x, const months& y) NOEXCEPT +{ + return x + -y; +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const month& m) +{ + if (m.ok()) + { + CharT fmt[] = {'%', 'b', 0}; + os << format(os.getloc(), fmt, m); + } + else + os << static_cast(m); + return os; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const month& m) +{ + detail::low_level_fmt(os, m); + if (!m.ok()) + os << " is not a valid month"; + return os; +} + +// year + +CONSTCD11 inline year::year(int y) NOEXCEPT : y_(static_cast(y)) {} +CONSTCD14 inline year& year::operator++() NOEXCEPT {++y_; return *this;} +CONSTCD14 inline year year::operator++(int) NOEXCEPT {auto tmp(*this); ++(*this); return tmp;} +CONSTCD14 inline year& year::operator--() NOEXCEPT {--y_; return *this;} +CONSTCD14 inline year year::operator--(int) NOEXCEPT {auto tmp(*this); --(*this); return tmp;} +CONSTCD14 inline year& year::operator+=(const years& y) NOEXCEPT {*this = *this + y; return *this;} +CONSTCD14 inline year& year::operator-=(const years& y) NOEXCEPT {*this = *this - y; return *this;} +CONSTCD11 inline year year::operator-() const NOEXCEPT {return year{-y_};} +CONSTCD11 inline year year::operator+() const NOEXCEPT {return *this;} + +CONSTCD11 +inline +bool +year::is_leap() const NOEXCEPT +{ + return y_ % 4 == 0 && (y_ % 100 != 0 || y_ % 400 == 0); +} + +CONSTCD11 inline year::operator int() const NOEXCEPT {return y_;} + +CONSTCD11 +inline +bool +year::ok() const NOEXCEPT +{ + return y_ != std::numeric_limits::min(); +} + +CONSTCD11 +inline +bool +operator==(const year& x, const year& y) NOEXCEPT +{ + return static_cast(x) == static_cast(y); +} + +CONSTCD11 +inline +bool +operator!=(const year& x, const year& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const year& x, const year& y) NOEXCEPT +{ + return static_cast(x) < static_cast(y); +} + +CONSTCD11 +inline +bool +operator>(const year& x, const year& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const year& x, const year& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const year& x, const year& y) NOEXCEPT +{ + return !(x < y); +} + +CONSTCD11 +inline +years +operator-(const year& x, const year& y) NOEXCEPT +{ + return years{static_cast(x) - static_cast(y)}; +} + +CONSTCD11 +inline +year +operator+(const year& x, const years& y) NOEXCEPT +{ + return year{static_cast(x) + y.count()}; +} + +CONSTCD11 +inline +year +operator+(const years& x, const year& y) NOEXCEPT +{ + return y + x; +} + +CONSTCD11 +inline +year +operator-(const year& x, const years& y) NOEXCEPT +{ + return year{static_cast(x) - y.count()}; +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const year& y) +{ + detail::save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::internal); + os.width(4 + (y < year{0})); + os.imbue(std::locale::classic()); + os << static_cast(y); + return os; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const year& y) +{ + detail::low_level_fmt(os, y); + if (!y.ok()) + os << " is not a valid year"; + return os; +} + +// weekday + +CONSTCD14 +inline +unsigned char +weekday::weekday_from_days(int z) NOEXCEPT +{ + auto u = static_cast(z); + return static_cast(z >= -4 ? (u+4) % 7 : u % 7); +} + +CONSTCD11 +inline +weekday::weekday(unsigned wd) NOEXCEPT + : wd_(static_cast(wd != 7 ? wd : 0)) + {} + +CONSTCD14 +inline +weekday::weekday(const sys_days& dp) NOEXCEPT + : wd_(weekday_from_days(dp.time_since_epoch().count())) + {} + +CONSTCD14 +inline +weekday::weekday(const local_days& dp) NOEXCEPT + : wd_(weekday_from_days(dp.time_since_epoch().count())) + {} + +CONSTCD14 inline weekday& weekday::operator++() NOEXCEPT {*this += days{1}; return *this;} +CONSTCD14 inline weekday weekday::operator++(int) NOEXCEPT {auto tmp(*this); ++(*this); return tmp;} +CONSTCD14 inline weekday& weekday::operator--() NOEXCEPT {*this -= days{1}; return *this;} +CONSTCD14 inline weekday weekday::operator--(int) NOEXCEPT {auto tmp(*this); --(*this); return tmp;} + +CONSTCD14 +inline +weekday& +weekday::operator+=(const days& d) NOEXCEPT +{ + *this = *this + d; + return *this; +} + +CONSTCD14 +inline +weekday& +weekday::operator-=(const days& d) NOEXCEPT +{ + *this = *this - d; + return *this; +} + +CONSTCD11 inline bool weekday::ok() const NOEXCEPT {return wd_ <= 6;} + +CONSTCD11 +inline +unsigned weekday::c_encoding() const NOEXCEPT +{ + return unsigned{wd_}; +} + +CONSTCD11 +inline +unsigned weekday::iso_encoding() const NOEXCEPT +{ + return unsigned{((wd_ == 0u) ? 7u : wd_)}; +} + +CONSTCD11 +inline +bool +operator==(const weekday& x, const weekday& y) NOEXCEPT +{ + return x.wd_ == y.wd_; +} + +CONSTCD11 +inline +bool +operator!=(const weekday& x, const weekday& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD14 +inline +days +operator-(const weekday& x, const weekday& y) NOEXCEPT +{ + auto const wdu = x.wd_ - y.wd_; + auto const wk = (wdu >= 0 ? wdu : wdu-6) / 7; + return days{wdu - wk * 7}; +} + +CONSTCD14 +inline +weekday +operator+(const weekday& x, const days& y) NOEXCEPT +{ + auto const wdu = static_cast(static_cast(x.wd_)) + y.count(); + auto const wk = (wdu >= 0 ? wdu : wdu-6) / 7; + return weekday{static_cast(wdu - wk * 7)}; +} + +CONSTCD14 +inline +weekday +operator+(const days& x, const weekday& y) NOEXCEPT +{ + return y + x; +} + +CONSTCD14 +inline +weekday +operator-(const weekday& x, const days& y) NOEXCEPT +{ + return x + -y; +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const weekday& wd) +{ + if (wd.ok()) + { + CharT fmt[] = {'%', 'a', 0}; + os << format(fmt, wd); + } + else + os << wd.c_encoding(); + return os; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const weekday& wd) +{ + detail::low_level_fmt(os, wd); + if (!wd.ok()) + os << " is not a valid weekday"; + return os; +} + +#if !defined(_MSC_VER) || (_MSC_VER >= 1900) +inline namespace literals +{ + +CONSTCD11 +inline +date::day +operator "" _d(unsigned long long d) NOEXCEPT +{ + return date::day{static_cast(d)}; +} + +CONSTCD11 +inline +date::year +operator "" _y(unsigned long long y) NOEXCEPT +{ + return date::year(static_cast(y)); +} +#endif // !defined(_MSC_VER) || (_MSC_VER >= 1900) + +CONSTDATA date::last_spec last{}; + +CONSTDATA date::month jan{1}; +CONSTDATA date::month feb{2}; +CONSTDATA date::month mar{3}; +CONSTDATA date::month apr{4}; +CONSTDATA date::month may{5}; +CONSTDATA date::month jun{6}; +CONSTDATA date::month jul{7}; +CONSTDATA date::month aug{8}; +CONSTDATA date::month sep{9}; +CONSTDATA date::month oct{10}; +CONSTDATA date::month nov{11}; +CONSTDATA date::month dec{12}; + +CONSTDATA date::weekday sun{0u}; +CONSTDATA date::weekday mon{1u}; +CONSTDATA date::weekday tue{2u}; +CONSTDATA date::weekday wed{3u}; +CONSTDATA date::weekday thu{4u}; +CONSTDATA date::weekday fri{5u}; +CONSTDATA date::weekday sat{6u}; + +#if !defined(_MSC_VER) || (_MSC_VER >= 1900) +} // inline namespace literals +#endif + +CONSTDATA date::month January{1}; +CONSTDATA date::month February{2}; +CONSTDATA date::month March{3}; +CONSTDATA date::month April{4}; +CONSTDATA date::month May{5}; +CONSTDATA date::month June{6}; +CONSTDATA date::month July{7}; +CONSTDATA date::month August{8}; +CONSTDATA date::month September{9}; +CONSTDATA date::month October{10}; +CONSTDATA date::month November{11}; +CONSTDATA date::month December{12}; + +CONSTDATA date::weekday Monday{1}; +CONSTDATA date::weekday Tuesday{2}; +CONSTDATA date::weekday Wednesday{3}; +CONSTDATA date::weekday Thursday{4}; +CONSTDATA date::weekday Friday{5}; +CONSTDATA date::weekday Saturday{6}; +CONSTDATA date::weekday Sunday{7}; + +// weekday_indexed + +CONSTCD11 +inline +weekday +weekday_indexed::weekday() const NOEXCEPT +{ + return date::weekday{static_cast(wd_)}; +} + +CONSTCD11 inline unsigned weekday_indexed::index() const NOEXCEPT {return index_;} + +CONSTCD11 +inline +bool +weekday_indexed::ok() const NOEXCEPT +{ + return weekday().ok() && 1 <= index_ && index_ <= 5; +} + +#ifdef __GNUC__ +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Wconversion" +#endif // __GNUC__ + +CONSTCD11 +inline +weekday_indexed::weekday_indexed(const date::weekday& wd, unsigned index) NOEXCEPT + : wd_(static_cast(static_cast(wd.wd_))) + , index_(static_cast(index)) + {} + +#ifdef __GNUC__ +# pragma GCC diagnostic pop +#endif // __GNUC__ + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const weekday_indexed& wdi) +{ + return low_level_fmt(os, wdi.weekday()) << '[' << wdi.index() << ']'; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const weekday_indexed& wdi) +{ + detail::low_level_fmt(os, wdi); + if (!wdi.ok()) + os << " is not a valid weekday_indexed"; + return os; +} + +CONSTCD11 +inline +weekday_indexed +weekday::operator[](unsigned index) const NOEXCEPT +{ + return {*this, index}; +} + +CONSTCD11 +inline +bool +operator==(const weekday_indexed& x, const weekday_indexed& y) NOEXCEPT +{ + return x.weekday() == y.weekday() && x.index() == y.index(); +} + +CONSTCD11 +inline +bool +operator!=(const weekday_indexed& x, const weekday_indexed& y) NOEXCEPT +{ + return !(x == y); +} + +// weekday_last + +CONSTCD11 inline date::weekday weekday_last::weekday() const NOEXCEPT {return wd_;} +CONSTCD11 inline bool weekday_last::ok() const NOEXCEPT {return wd_.ok();} +CONSTCD11 inline weekday_last::weekday_last(const date::weekday& wd) NOEXCEPT : wd_(wd) {} + +CONSTCD11 +inline +bool +operator==(const weekday_last& x, const weekday_last& y) NOEXCEPT +{ + return x.weekday() == y.weekday(); +} + +CONSTCD11 +inline +bool +operator!=(const weekday_last& x, const weekday_last& y) NOEXCEPT +{ + return !(x == y); +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const weekday_last& wdl) +{ + return low_level_fmt(os, wdl.weekday()) << "[last]"; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const weekday_last& wdl) +{ + detail::low_level_fmt(os, wdl); + if (!wdl.ok()) + os << " is not a valid weekday_last"; + return os; +} + +CONSTCD11 +inline +weekday_last +weekday::operator[](last_spec) const NOEXCEPT +{ + return weekday_last{*this}; +} + +// year_month + +CONSTCD11 +inline +year_month::year_month(const date::year& y, const date::month& m) NOEXCEPT + : y_(y) + , m_(m) + {} + +CONSTCD11 inline year year_month::year() const NOEXCEPT {return y_;} +CONSTCD11 inline month year_month::month() const NOEXCEPT {return m_;} +CONSTCD11 inline bool year_month::ok() const NOEXCEPT {return y_.ok() && m_.ok();} + +template +CONSTCD14 +inline +year_month& +year_month::operator+=(const months& dm) NOEXCEPT +{ + *this = *this + dm; + return *this; +} + +template +CONSTCD14 +inline +year_month& +year_month::operator-=(const months& dm) NOEXCEPT +{ + *this = *this - dm; + return *this; +} + +CONSTCD14 +inline +year_month& +year_month::operator+=(const years& dy) NOEXCEPT +{ + *this = *this + dy; + return *this; +} + +CONSTCD14 +inline +year_month& +year_month::operator-=(const years& dy) NOEXCEPT +{ + *this = *this - dy; + return *this; +} + +CONSTCD11 +inline +bool +operator==(const year_month& x, const year_month& y) NOEXCEPT +{ + return x.year() == y.year() && x.month() == y.month(); +} + +CONSTCD11 +inline +bool +operator!=(const year_month& x, const year_month& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const year_month& x, const year_month& y) NOEXCEPT +{ + return x.year() < y.year() ? true + : (x.year() > y.year() ? false + : (x.month() < y.month())); +} + +CONSTCD11 +inline +bool +operator>(const year_month& x, const year_month& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const year_month& x, const year_month& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const year_month& x, const year_month& y) NOEXCEPT +{ + return !(x < y); +} + +template +CONSTCD14 +inline +year_month +operator+(const year_month& ym, const months& dm) NOEXCEPT +{ + auto dmi = static_cast(static_cast(ym.month())) - 1 + dm.count(); + auto dy = (dmi >= 0 ? dmi : dmi-11) / 12; + dmi = dmi - dy * 12 + 1; + return (ym.year() + years(dy)) / month(static_cast(dmi)); +} + +template +CONSTCD14 +inline +year_month +operator+(const months& dm, const year_month& ym) NOEXCEPT +{ + return ym + dm; +} + +template +CONSTCD14 +inline +year_month +operator-(const year_month& ym, const months& dm) NOEXCEPT +{ + return ym + -dm; +} + +CONSTCD11 +inline +months +operator-(const year_month& x, const year_month& y) NOEXCEPT +{ + return (x.year() - y.year()) + + months(static_cast(x.month()) - static_cast(y.month())); +} + +CONSTCD11 +inline +year_month +operator+(const year_month& ym, const years& dy) NOEXCEPT +{ + return (ym.year() + dy) / ym.month(); +} + +CONSTCD11 +inline +year_month +operator+(const years& dy, const year_month& ym) NOEXCEPT +{ + return ym + dy; +} + +CONSTCD11 +inline +year_month +operator-(const year_month& ym, const years& dy) NOEXCEPT +{ + return ym + -dy; +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const year_month& ym) +{ + low_level_fmt(os, ym.year()) << '/'; + return low_level_fmt(os, ym.month()); +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month& ym) +{ + detail::low_level_fmt(os, ym); + if (!ym.ok()) + os << " is not a valid year_month"; + return os; +} + +// month_day + +CONSTCD11 +inline +month_day::month_day(const date::month& m, const date::day& d) NOEXCEPT + : m_(m) + , d_(d) + {} + +CONSTCD11 inline date::month month_day::month() const NOEXCEPT {return m_;} +CONSTCD11 inline date::day month_day::day() const NOEXCEPT {return d_;} + +CONSTCD14 +inline +bool +month_day::ok() const NOEXCEPT +{ + CONSTDATA date::day d[] = + { + date::day(31), date::day(29), date::day(31), + date::day(30), date::day(31), date::day(30), + date::day(31), date::day(31), date::day(30), + date::day(31), date::day(30), date::day(31) + }; + return m_.ok() && date::day{1} <= d_ && d_ <= d[static_cast(m_)-1]; +} + +CONSTCD11 +inline +bool +operator==(const month_day& x, const month_day& y) NOEXCEPT +{ + return x.month() == y.month() && x.day() == y.day(); +} + +CONSTCD11 +inline +bool +operator!=(const month_day& x, const month_day& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const month_day& x, const month_day& y) NOEXCEPT +{ + return x.month() < y.month() ? true + : (x.month() > y.month() ? false + : (x.day() < y.day())); +} + +CONSTCD11 +inline +bool +operator>(const month_day& x, const month_day& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const month_day& x, const month_day& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const month_day& x, const month_day& y) NOEXCEPT +{ + return !(x < y); +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const month_day& md) +{ + low_level_fmt(os, md.month()) << '/'; + return low_level_fmt(os, md.day()); +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_day& md) +{ + detail::low_level_fmt(os, md); + if (!md.ok()) + os << " is not a valid month_day"; + return os; +} + +// month_day_last + +CONSTCD11 inline month month_day_last::month() const NOEXCEPT {return m_;} +CONSTCD11 inline bool month_day_last::ok() const NOEXCEPT {return m_.ok();} +CONSTCD11 inline month_day_last::month_day_last(const date::month& m) NOEXCEPT : m_(m) {} + +CONSTCD11 +inline +bool +operator==(const month_day_last& x, const month_day_last& y) NOEXCEPT +{ + return x.month() == y.month(); +} + +CONSTCD11 +inline +bool +operator!=(const month_day_last& x, const month_day_last& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const month_day_last& x, const month_day_last& y) NOEXCEPT +{ + return x.month() < y.month(); +} + +CONSTCD11 +inline +bool +operator>(const month_day_last& x, const month_day_last& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const month_day_last& x, const month_day_last& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const month_day_last& x, const month_day_last& y) NOEXCEPT +{ + return !(x < y); +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const month_day_last& mdl) +{ + return low_level_fmt(os, mdl.month()) << "/last"; +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_day_last& mdl) +{ + detail::low_level_fmt(os, mdl); + if (!mdl.ok()) + os << " is not a valid month_day_last"; + return os; +} + +// month_weekday + +CONSTCD11 +inline +month_weekday::month_weekday(const date::month& m, + const date::weekday_indexed& wdi) NOEXCEPT + : m_(m) + , wdi_(wdi) + {} + +CONSTCD11 inline month month_weekday::month() const NOEXCEPT {return m_;} + +CONSTCD11 +inline +weekday_indexed +month_weekday::weekday_indexed() const NOEXCEPT +{ + return wdi_; +} + +CONSTCD11 +inline +bool +month_weekday::ok() const NOEXCEPT +{ + return m_.ok() && wdi_.ok(); +} + +CONSTCD11 +inline +bool +operator==(const month_weekday& x, const month_weekday& y) NOEXCEPT +{ + return x.month() == y.month() && x.weekday_indexed() == y.weekday_indexed(); +} + +CONSTCD11 +inline +bool +operator!=(const month_weekday& x, const month_weekday& y) NOEXCEPT +{ + return !(x == y); +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const month_weekday& mwd) +{ + low_level_fmt(os, mwd.month()) << '/'; + return low_level_fmt(os, mwd.weekday_indexed()); +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_weekday& mwd) +{ + detail::low_level_fmt(os, mwd); + if (!mwd.ok()) + os << " is not a valid month_weekday"; + return os; +} + +// month_weekday_last + +CONSTCD11 +inline +month_weekday_last::month_weekday_last(const date::month& m, + const date::weekday_last& wdl) NOEXCEPT + : m_(m) + , wdl_(wdl) + {} + +CONSTCD11 inline month month_weekday_last::month() const NOEXCEPT {return m_;} + +CONSTCD11 +inline +weekday_last +month_weekday_last::weekday_last() const NOEXCEPT +{ + return wdl_; +} + +CONSTCD11 +inline +bool +month_weekday_last::ok() const NOEXCEPT +{ + return m_.ok() && wdl_.ok(); +} + +CONSTCD11 +inline +bool +operator==(const month_weekday_last& x, const month_weekday_last& y) NOEXCEPT +{ + return x.month() == y.month() && x.weekday_last() == y.weekday_last(); +} + +CONSTCD11 +inline +bool +operator!=(const month_weekday_last& x, const month_weekday_last& y) NOEXCEPT +{ + return !(x == y); +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const month_weekday_last& mwdl) +{ + low_level_fmt(os, mwdl.month()) << '/'; + return low_level_fmt(os, mwdl.weekday_last()); +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const month_weekday_last& mwdl) +{ + detail::low_level_fmt(os, mwdl); + if (!mwdl.ok()) + os << " is not a valid month_weekday_last"; + return os; +} + +// year_month_day_last + +CONSTCD11 +inline +year_month_day_last::year_month_day_last(const date::year& y, + const date::month_day_last& mdl) NOEXCEPT + : y_(y) + , mdl_(mdl) + {} + +template +CONSTCD14 +inline +year_month_day_last& +year_month_day_last::operator+=(const months& m) NOEXCEPT +{ + *this = *this + m; + return *this; +} + +template +CONSTCD14 +inline +year_month_day_last& +year_month_day_last::operator-=(const months& m) NOEXCEPT +{ + *this = *this - m; + return *this; +} + +CONSTCD14 +inline +year_month_day_last& +year_month_day_last::operator+=(const years& y) NOEXCEPT +{ + *this = *this + y; + return *this; +} + +CONSTCD14 +inline +year_month_day_last& +year_month_day_last::operator-=(const years& y) NOEXCEPT +{ + *this = *this - y; + return *this; +} + +CONSTCD11 inline year year_month_day_last::year() const NOEXCEPT {return y_;} +CONSTCD11 inline month year_month_day_last::month() const NOEXCEPT {return mdl_.month();} + +CONSTCD11 +inline +month_day_last +year_month_day_last::month_day_last() const NOEXCEPT +{ + return mdl_; +} + +CONSTCD14 +inline +day +year_month_day_last::day() const NOEXCEPT +{ + CONSTDATA date::day d[] = + { + date::day(31), date::day(28), date::day(31), + date::day(30), date::day(31), date::day(30), + date::day(31), date::day(31), date::day(30), + date::day(31), date::day(30), date::day(31) + }; + return (month() != February || !y_.is_leap()) && mdl_.ok() ? + d[static_cast(month()) - 1] : date::day{29}; +} + +CONSTCD14 +inline +year_month_day_last::operator sys_days() const NOEXCEPT +{ + return sys_days(year()/month()/day()); +} + +CONSTCD14 +inline +year_month_day_last::operator local_days() const NOEXCEPT +{ + return local_days(year()/month()/day()); +} + +CONSTCD11 +inline +bool +year_month_day_last::ok() const NOEXCEPT +{ + return y_.ok() && mdl_.ok(); +} + +CONSTCD11 +inline +bool +operator==(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT +{ + return x.year() == y.year() && x.month_day_last() == y.month_day_last(); +} + +CONSTCD11 +inline +bool +operator!=(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT +{ + return x.year() < y.year() ? true + : (x.year() > y.year() ? false + : (x.month_day_last() < y.month_day_last())); +} + +CONSTCD11 +inline +bool +operator>(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const year_month_day_last& x, const year_month_day_last& y) NOEXCEPT +{ + return !(x < y); +} + +namespace detail +{ + +template +std::basic_ostream& +low_level_fmt(std::basic_ostream& os, const year_month_day_last& ymdl) +{ + low_level_fmt(os, ymdl.year()) << '/'; + return low_level_fmt(os, ymdl.month_day_last()); +} + +} // namespace detail + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_day_last& ymdl) +{ + detail::low_level_fmt(os, ymdl); + if (!ymdl.ok()) + os << " is not a valid year_month_day_last"; + return os; +} + +template +CONSTCD14 +inline +year_month_day_last +operator+(const year_month_day_last& ymdl, const months& dm) NOEXCEPT +{ + return (ymdl.year() / ymdl.month() + dm) / last; +} + +template +CONSTCD14 +inline +year_month_day_last +operator+(const months& dm, const year_month_day_last& ymdl) NOEXCEPT +{ + return ymdl + dm; +} + +template +CONSTCD14 +inline +year_month_day_last +operator-(const year_month_day_last& ymdl, const months& dm) NOEXCEPT +{ + return ymdl + (-dm); +} + +CONSTCD11 +inline +year_month_day_last +operator+(const year_month_day_last& ymdl, const years& dy) NOEXCEPT +{ + return {ymdl.year()+dy, ymdl.month_day_last()}; +} + +CONSTCD11 +inline +year_month_day_last +operator+(const years& dy, const year_month_day_last& ymdl) NOEXCEPT +{ + return ymdl + dy; +} + +CONSTCD11 +inline +year_month_day_last +operator-(const year_month_day_last& ymdl, const years& dy) NOEXCEPT +{ + return ymdl + (-dy); +} + +// year_month_day + +CONSTCD11 +inline +year_month_day::year_month_day(const date::year& y, const date::month& m, + const date::day& d) NOEXCEPT + : y_(y) + , m_(m) + , d_(d) + {} + +CONSTCD14 +inline +year_month_day::year_month_day(const year_month_day_last& ymdl) NOEXCEPT + : y_(ymdl.year()) + , m_(ymdl.month()) + , d_(ymdl.day()) + {} + +CONSTCD14 +inline +year_month_day::year_month_day(sys_days dp) NOEXCEPT + : year_month_day(from_days(dp.time_since_epoch())) + {} + +CONSTCD14 +inline +year_month_day::year_month_day(local_days dp) NOEXCEPT + : year_month_day(from_days(dp.time_since_epoch())) + {} + +CONSTCD11 inline year year_month_day::year() const NOEXCEPT {return y_;} +CONSTCD11 inline month year_month_day::month() const NOEXCEPT {return m_;} +CONSTCD11 inline day year_month_day::day() const NOEXCEPT {return d_;} + +template +CONSTCD14 +inline +year_month_day& +year_month_day::operator+=(const months& m) NOEXCEPT +{ + *this = *this + m; + return *this; +} + +template +CONSTCD14 +inline +year_month_day& +year_month_day::operator-=(const months& m) NOEXCEPT +{ + *this = *this - m; + return *this; +} + +CONSTCD14 +inline +year_month_day& +year_month_day::operator+=(const years& y) NOEXCEPT +{ + *this = *this + y; + return *this; +} + +CONSTCD14 +inline +year_month_day& +year_month_day::operator-=(const years& y) NOEXCEPT +{ + *this = *this - y; + return *this; +} + +CONSTCD14 +inline +days +year_month_day::to_days() const NOEXCEPT +{ + static_assert(std::numeric_limits::digits >= 18, + "This algorithm has not been ported to a 16 bit unsigned integer"); + static_assert(std::numeric_limits::digits >= 20, + "This algorithm has not been ported to a 16 bit signed integer"); + auto const y = static_cast(y_) - (m_ <= February); + auto const m = static_cast(m_); + auto const d = static_cast(d_); + auto const era = (y >= 0 ? y : y-399) / 400; + auto const yoe = static_cast(y - era * 400); // [0, 399] + auto const doy = (153*(m > 2 ? m-3 : m+9) + 2)/5 + d-1; // [0, 365] + auto const doe = yoe * 365 + yoe/4 - yoe/100 + doy; // [0, 146096] + return days{era * 146097 + static_cast(doe) - 719468}; +} + +CONSTCD14 +inline +year_month_day::operator sys_days() const NOEXCEPT +{ + return sys_days{to_days()}; +} + +CONSTCD14 +inline +year_month_day::operator local_days() const NOEXCEPT +{ + return local_days{to_days()}; +} + +CONSTCD14 +inline +bool +year_month_day::ok() const NOEXCEPT +{ + if (!(y_.ok() && m_.ok())) + return false; + return date::day{1} <= d_ && d_ <= (y_ / m_ / last).day(); +} + +CONSTCD11 +inline +bool +operator==(const year_month_day& x, const year_month_day& y) NOEXCEPT +{ + return x.year() == y.year() && x.month() == y.month() && x.day() == y.day(); +} + +CONSTCD11 +inline +bool +operator!=(const year_month_day& x, const year_month_day& y) NOEXCEPT +{ + return !(x == y); +} + +CONSTCD11 +inline +bool +operator<(const year_month_day& x, const year_month_day& y) NOEXCEPT +{ + return x.year() < y.year() ? true + : (x.year() > y.year() ? false + : (x.month() < y.month() ? true + : (x.month() > y.month() ? false + : (x.day() < y.day())))); +} + +CONSTCD11 +inline +bool +operator>(const year_month_day& x, const year_month_day& y) NOEXCEPT +{ + return y < x; +} + +CONSTCD11 +inline +bool +operator<=(const year_month_day& x, const year_month_day& y) NOEXCEPT +{ + return !(y < x); +} + +CONSTCD11 +inline +bool +operator>=(const year_month_day& x, const year_month_day& y) NOEXCEPT +{ + return !(x < y); +} + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_day& ymd) +{ + detail::save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.imbue(std::locale::classic()); + os << static_cast(ymd.year()) << '-'; + os.width(2); + os << static_cast(ymd.month()) << '-'; + os.width(2); + os << static_cast(ymd.day()); + if (!ymd.ok()) + os << " is not a valid year_month_day"; + return os; +} + +CONSTCD14 +inline +year_month_day +year_month_day::from_days(days dp) NOEXCEPT +{ + static_assert(std::numeric_limits::digits >= 18, + "This algorithm has not been ported to a 16 bit unsigned integer"); + static_assert(std::numeric_limits::digits >= 20, + "This algorithm has not been ported to a 16 bit signed integer"); + auto const z = dp.count() + 719468; + auto const era = (z >= 0 ? z : z - 146096) / 146097; + auto const doe = static_cast(z - era * 146097); // [0, 146096] + auto const yoe = (doe - doe/1460 + doe/36524 - doe/146096) / 365; // [0, 399] + auto const y = static_cast(yoe) + era * 400; + auto const doy = doe - (365*yoe + yoe/4 - yoe/100); // [0, 365] + auto const mp = (5*doy + 2)/153; // [0, 11] + auto const d = doy - (153*mp+2)/5 + 1; // [1, 31] + auto const m = mp < 10 ? mp+3 : mp-9; // [1, 12] + return year_month_day{date::year{y + (m <= 2)}, date::month(m), date::day(d)}; +} + +template +CONSTCD14 +inline +year_month_day +operator+(const year_month_day& ymd, const months& dm) NOEXCEPT +{ + return (ymd.year() / ymd.month() + dm) / ymd.day(); +} + +template +CONSTCD14 +inline +year_month_day +operator+(const months& dm, const year_month_day& ymd) NOEXCEPT +{ + return ymd + dm; +} + +template +CONSTCD14 +inline +year_month_day +operator-(const year_month_day& ymd, const months& dm) NOEXCEPT +{ + return ymd + (-dm); +} + +CONSTCD11 +inline +year_month_day +operator+(const year_month_day& ymd, const years& dy) NOEXCEPT +{ + return (ymd.year() + dy) / ymd.month() / ymd.day(); +} + +CONSTCD11 +inline +year_month_day +operator+(const years& dy, const year_month_day& ymd) NOEXCEPT +{ + return ymd + dy; +} + +CONSTCD11 +inline +year_month_day +operator-(const year_month_day& ymd, const years& dy) NOEXCEPT +{ + return ymd + (-dy); +} + +// year_month_weekday + +CONSTCD11 +inline +year_month_weekday::year_month_weekday(const date::year& y, const date::month& m, + const date::weekday_indexed& wdi) + NOEXCEPT + : y_(y) + , m_(m) + , wdi_(wdi) + {} + +CONSTCD14 +inline +year_month_weekday::year_month_weekday(const sys_days& dp) NOEXCEPT + : year_month_weekday(from_days(dp.time_since_epoch())) + {} + +CONSTCD14 +inline +year_month_weekday::year_month_weekday(const local_days& dp) NOEXCEPT + : year_month_weekday(from_days(dp.time_since_epoch())) + {} + +template +CONSTCD14 +inline +year_month_weekday& +year_month_weekday::operator+=(const months& m) NOEXCEPT +{ + *this = *this + m; + return *this; +} + +template +CONSTCD14 +inline +year_month_weekday& +year_month_weekday::operator-=(const months& m) NOEXCEPT +{ + *this = *this - m; + return *this; +} + +CONSTCD14 +inline +year_month_weekday& +year_month_weekday::operator+=(const years& y) NOEXCEPT +{ + *this = *this + y; + return *this; +} + +CONSTCD14 +inline +year_month_weekday& +year_month_weekday::operator-=(const years& y) NOEXCEPT +{ + *this = *this - y; + return *this; +} + +CONSTCD11 inline year year_month_weekday::year() const NOEXCEPT {return y_;} +CONSTCD11 inline month year_month_weekday::month() const NOEXCEPT {return m_;} + +CONSTCD11 +inline +weekday +year_month_weekday::weekday() const NOEXCEPT +{ + return wdi_.weekday(); +} + +CONSTCD11 +inline +unsigned +year_month_weekday::index() const NOEXCEPT +{ + return wdi_.index(); +} + +CONSTCD11 +inline +weekday_indexed +year_month_weekday::weekday_indexed() const NOEXCEPT +{ + return wdi_; +} + +CONSTCD14 +inline +year_month_weekday::operator sys_days() const NOEXCEPT +{ + return sys_days{to_days()}; +} + +CONSTCD14 +inline +year_month_weekday::operator local_days() const NOEXCEPT +{ + return local_days{to_days()}; +} + +CONSTCD14 +inline +bool +year_month_weekday::ok() const NOEXCEPT +{ + if (!y_.ok() || !m_.ok() || !wdi_.weekday().ok() || wdi_.index() < 1) + return false; + if (wdi_.index() <= 4) + return true; + auto d2 = wdi_.weekday() - date::weekday(static_cast(y_/m_/1)) + + days((wdi_.index()-1)*7 + 1); + return static_cast(d2.count()) <= static_cast((y_/m_/last).day()); +} + +CONSTCD14 +inline +year_month_weekday +year_month_weekday::from_days(days d) NOEXCEPT +{ + sys_days dp{d}; + auto const wd = date::weekday(dp); + auto const ymd = year_month_day(dp); + return {ymd.year(), ymd.month(), wd[(static_cast(ymd.day())-1)/7+1]}; +} + +CONSTCD14 +inline +days +year_month_weekday::to_days() const NOEXCEPT +{ + auto d = sys_days(y_/m_/1); + return (d + (wdi_.weekday() - date::weekday(d) + days{(wdi_.index()-1)*7}) + ).time_since_epoch(); +} + +CONSTCD11 +inline +bool +operator==(const year_month_weekday& x, const year_month_weekday& y) NOEXCEPT +{ + return x.year() == y.year() && x.month() == y.month() && + x.weekday_indexed() == y.weekday_indexed(); +} + +CONSTCD11 +inline +bool +operator!=(const year_month_weekday& x, const year_month_weekday& y) NOEXCEPT +{ + return !(x == y); +} + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_weekday& ymwdi) +{ + detail::low_level_fmt(os, ymwdi.year()) << '/'; + detail::low_level_fmt(os, ymwdi.month()) << '/'; + detail::low_level_fmt(os, ymwdi.weekday_indexed()); + if (!ymwdi.ok()) + os << " is not a valid year_month_weekday"; + return os; +} + +template +CONSTCD14 +inline +year_month_weekday +operator+(const year_month_weekday& ymwd, const months& dm) NOEXCEPT +{ + return (ymwd.year() / ymwd.month() + dm) / ymwd.weekday_indexed(); +} + +template +CONSTCD14 +inline +year_month_weekday +operator+(const months& dm, const year_month_weekday& ymwd) NOEXCEPT +{ + return ymwd + dm; +} + +template +CONSTCD14 +inline +year_month_weekday +operator-(const year_month_weekday& ymwd, const months& dm) NOEXCEPT +{ + return ymwd + (-dm); +} + +CONSTCD11 +inline +year_month_weekday +operator+(const year_month_weekday& ymwd, const years& dy) NOEXCEPT +{ + return {ymwd.year()+dy, ymwd.month(), ymwd.weekday_indexed()}; +} + +CONSTCD11 +inline +year_month_weekday +operator+(const years& dy, const year_month_weekday& ymwd) NOEXCEPT +{ + return ymwd + dy; +} + +CONSTCD11 +inline +year_month_weekday +operator-(const year_month_weekday& ymwd, const years& dy) NOEXCEPT +{ + return ymwd + (-dy); +} + +// year_month_weekday_last + +CONSTCD11 +inline +year_month_weekday_last::year_month_weekday_last(const date::year& y, + const date::month& m, + const date::weekday_last& wdl) NOEXCEPT + : y_(y) + , m_(m) + , wdl_(wdl) + {} + +template +CONSTCD14 +inline +year_month_weekday_last& +year_month_weekday_last::operator+=(const months& m) NOEXCEPT +{ + *this = *this + m; + return *this; +} + +template +CONSTCD14 +inline +year_month_weekday_last& +year_month_weekday_last::operator-=(const months& m) NOEXCEPT +{ + *this = *this - m; + return *this; +} + +CONSTCD14 +inline +year_month_weekday_last& +year_month_weekday_last::operator+=(const years& y) NOEXCEPT +{ + *this = *this + y; + return *this; +} + +CONSTCD14 +inline +year_month_weekday_last& +year_month_weekday_last::operator-=(const years& y) NOEXCEPT +{ + *this = *this - y; + return *this; +} + +CONSTCD11 inline year year_month_weekday_last::year() const NOEXCEPT {return y_;} +CONSTCD11 inline month year_month_weekday_last::month() const NOEXCEPT {return m_;} + +CONSTCD11 +inline +weekday +year_month_weekday_last::weekday() const NOEXCEPT +{ + return wdl_.weekday(); +} + +CONSTCD11 +inline +weekday_last +year_month_weekday_last::weekday_last() const NOEXCEPT +{ + return wdl_; +} + +CONSTCD14 +inline +year_month_weekday_last::operator sys_days() const NOEXCEPT +{ + return sys_days{to_days()}; +} + +CONSTCD14 +inline +year_month_weekday_last::operator local_days() const NOEXCEPT +{ + return local_days{to_days()}; +} + +CONSTCD11 +inline +bool +year_month_weekday_last::ok() const NOEXCEPT +{ + return y_.ok() && m_.ok() && wdl_.ok(); +} + +CONSTCD14 +inline +days +year_month_weekday_last::to_days() const NOEXCEPT +{ + auto const d = sys_days(y_/m_/last); + return (d - (date::weekday{d} - wdl_.weekday())).time_since_epoch(); +} + +CONSTCD11 +inline +bool +operator==(const year_month_weekday_last& x, const year_month_weekday_last& y) NOEXCEPT +{ + return x.year() == y.year() && x.month() == y.month() && + x.weekday_last() == y.weekday_last(); +} + +CONSTCD11 +inline +bool +operator!=(const year_month_weekday_last& x, const year_month_weekday_last& y) NOEXCEPT +{ + return !(x == y); +} + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const year_month_weekday_last& ymwdl) +{ + detail::low_level_fmt(os, ymwdl.year()) << '/'; + detail::low_level_fmt(os, ymwdl.month()) << '/'; + detail::low_level_fmt(os, ymwdl.weekday_last()); + if (!ymwdl.ok()) + os << " is not a valid year_month_weekday_last"; + return os; +} + +template +CONSTCD14 +inline +year_month_weekday_last +operator+(const year_month_weekday_last& ymwdl, const months& dm) NOEXCEPT +{ + return (ymwdl.year() / ymwdl.month() + dm) / ymwdl.weekday_last(); +} + +template +CONSTCD14 +inline +year_month_weekday_last +operator+(const months& dm, const year_month_weekday_last& ymwdl) NOEXCEPT +{ + return ymwdl + dm; +} + +template +CONSTCD14 +inline +year_month_weekday_last +operator-(const year_month_weekday_last& ymwdl, const months& dm) NOEXCEPT +{ + return ymwdl + (-dm); +} + +CONSTCD11 +inline +year_month_weekday_last +operator+(const year_month_weekday_last& ymwdl, const years& dy) NOEXCEPT +{ + return {ymwdl.year()+dy, ymwdl.month(), ymwdl.weekday_last()}; +} + +CONSTCD11 +inline +year_month_weekday_last +operator+(const years& dy, const year_month_weekday_last& ymwdl) NOEXCEPT +{ + return ymwdl + dy; +} + +CONSTCD11 +inline +year_month_weekday_last +operator-(const year_month_weekday_last& ymwdl, const years& dy) NOEXCEPT +{ + return ymwdl + (-dy); +} + +// year_month from operator/() + +CONSTCD11 +inline +year_month +operator/(const year& y, const month& m) NOEXCEPT +{ + return {y, m}; +} + +CONSTCD11 +inline +year_month +operator/(const year& y, int m) NOEXCEPT +{ + return y / month(static_cast(m)); +} + +// month_day from operator/() + +CONSTCD11 +inline +month_day +operator/(const month& m, const day& d) NOEXCEPT +{ + return {m, d}; +} + +CONSTCD11 +inline +month_day +operator/(const day& d, const month& m) NOEXCEPT +{ + return m / d; +} + +CONSTCD11 +inline +month_day +operator/(const month& m, int d) NOEXCEPT +{ + return m / day(static_cast(d)); +} + +CONSTCD11 +inline +month_day +operator/(int m, const day& d) NOEXCEPT +{ + return month(static_cast(m)) / d; +} + +CONSTCD11 inline month_day operator/(const day& d, int m) NOEXCEPT {return m / d;} + +// month_day_last from operator/() + +CONSTCD11 +inline +month_day_last +operator/(const month& m, last_spec) NOEXCEPT +{ + return month_day_last{m}; +} + +CONSTCD11 +inline +month_day_last +operator/(last_spec, const month& m) NOEXCEPT +{ + return m/last; +} + +CONSTCD11 +inline +month_day_last +operator/(int m, last_spec) NOEXCEPT +{ + return month(static_cast(m))/last; +} + +CONSTCD11 +inline +month_day_last +operator/(last_spec, int m) NOEXCEPT +{ + return m/last; +} + +// month_weekday from operator/() + +CONSTCD11 +inline +month_weekday +operator/(const month& m, const weekday_indexed& wdi) NOEXCEPT +{ + return {m, wdi}; +} + +CONSTCD11 +inline +month_weekday +operator/(const weekday_indexed& wdi, const month& m) NOEXCEPT +{ + return m / wdi; +} + +CONSTCD11 +inline +month_weekday +operator/(int m, const weekday_indexed& wdi) NOEXCEPT +{ + return month(static_cast(m)) / wdi; +} + +CONSTCD11 +inline +month_weekday +operator/(const weekday_indexed& wdi, int m) NOEXCEPT +{ + return m / wdi; +} + +// month_weekday_last from operator/() + +CONSTCD11 +inline +month_weekday_last +operator/(const month& m, const weekday_last& wdl) NOEXCEPT +{ + return {m, wdl}; +} + +CONSTCD11 +inline +month_weekday_last +operator/(const weekday_last& wdl, const month& m) NOEXCEPT +{ + return m / wdl; +} + +CONSTCD11 +inline +month_weekday_last +operator/(int m, const weekday_last& wdl) NOEXCEPT +{ + return month(static_cast(m)) / wdl; +} + +CONSTCD11 +inline +month_weekday_last +operator/(const weekday_last& wdl, int m) NOEXCEPT +{ + return m / wdl; +} + +// year_month_day from operator/() + +CONSTCD11 +inline +year_month_day +operator/(const year_month& ym, const day& d) NOEXCEPT +{ + return {ym.year(), ym.month(), d}; +} + +CONSTCD11 +inline +year_month_day +operator/(const year_month& ym, int d) NOEXCEPT +{ + return ym / day(static_cast(d)); +} + +CONSTCD11 +inline +year_month_day +operator/(const year& y, const month_day& md) NOEXCEPT +{ + return y / md.month() / md.day(); +} + +CONSTCD11 +inline +year_month_day +operator/(int y, const month_day& md) NOEXCEPT +{ + return year(y) / md; +} + +CONSTCD11 +inline +year_month_day +operator/(const month_day& md, const year& y) NOEXCEPT +{ + return y / md; +} + +CONSTCD11 +inline +year_month_day +operator/(const month_day& md, int y) NOEXCEPT +{ + return year(y) / md; +} + +// year_month_day_last from operator/() + +CONSTCD11 +inline +year_month_day_last +operator/(const year_month& ym, last_spec) NOEXCEPT +{ + return {ym.year(), month_day_last{ym.month()}}; +} + +CONSTCD11 +inline +year_month_day_last +operator/(const year& y, const month_day_last& mdl) NOEXCEPT +{ + return {y, mdl}; +} + +CONSTCD11 +inline +year_month_day_last +operator/(int y, const month_day_last& mdl) NOEXCEPT +{ + return year(y) / mdl; +} + +CONSTCD11 +inline +year_month_day_last +operator/(const month_day_last& mdl, const year& y) NOEXCEPT +{ + return y / mdl; +} + +CONSTCD11 +inline +year_month_day_last +operator/(const month_day_last& mdl, int y) NOEXCEPT +{ + return year(y) / mdl; +} + +// year_month_weekday from operator/() + +CONSTCD11 +inline +year_month_weekday +operator/(const year_month& ym, const weekday_indexed& wdi) NOEXCEPT +{ + return {ym.year(), ym.month(), wdi}; +} + +CONSTCD11 +inline +year_month_weekday +operator/(const year& y, const month_weekday& mwd) NOEXCEPT +{ + return {y, mwd.month(), mwd.weekday_indexed()}; +} + +CONSTCD11 +inline +year_month_weekday +operator/(int y, const month_weekday& mwd) NOEXCEPT +{ + return year(y) / mwd; +} + +CONSTCD11 +inline +year_month_weekday +operator/(const month_weekday& mwd, const year& y) NOEXCEPT +{ + return y / mwd; +} + +CONSTCD11 +inline +year_month_weekday +operator/(const month_weekday& mwd, int y) NOEXCEPT +{ + return year(y) / mwd; +} + +// year_month_weekday_last from operator/() + +CONSTCD11 +inline +year_month_weekday_last +operator/(const year_month& ym, const weekday_last& wdl) NOEXCEPT +{ + return {ym.year(), ym.month(), wdl}; +} + +CONSTCD11 +inline +year_month_weekday_last +operator/(const year& y, const month_weekday_last& mwdl) NOEXCEPT +{ + return {y, mwdl.month(), mwdl.weekday_last()}; +} + +CONSTCD11 +inline +year_month_weekday_last +operator/(int y, const month_weekday_last& mwdl) NOEXCEPT +{ + return year(y) / mwdl; +} + +CONSTCD11 +inline +year_month_weekday_last +operator/(const month_weekday_last& mwdl, const year& y) NOEXCEPT +{ + return y / mwdl; +} + +CONSTCD11 +inline +year_month_weekday_last +operator/(const month_weekday_last& mwdl, int y) NOEXCEPT +{ + return year(y) / mwdl; +} + +template +struct fields; + +template +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, + const fields& fds, const std::string* abbrev = nullptr, + const std::chrono::seconds* offset_sec = nullptr); + +template +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, + fields& fds, std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr); + +// hh_mm_ss + +namespace detail +{ + +struct undocumented {explicit undocumented() = default;}; + +// width::value is the number of fractional decimal digits in 1/n +// width<0>::value and width<1>::value are defined to be 0 +// If 1/n takes more than 18 fractional decimal digits, +// the result is truncated to 19. +// Example: width<2>::value == 1 +// Example: width<3>::value == 19 +// Example: width<4>::value == 2 +// Example: width<10>::value == 1 +// Example: width<1000>::value == 3 +template +struct width +{ + static_assert(d > 0, "width called with zero denominator"); + static CONSTDATA unsigned value = 1 + width::value; +}; + +template +struct width +{ + static CONSTDATA unsigned value = 0; +}; + +template +struct static_pow10 +{ +private: + static CONSTDATA std::uint64_t h = static_pow10::value; +public: + static CONSTDATA std::uint64_t value = h * h * (exp % 2 ? 10 : 1); +}; + +template <> +struct static_pow10<0> +{ + static CONSTDATA std::uint64_t value = 1; +}; + +template +class decimal_format_seconds +{ + using CT = typename std::common_type::type; + using rep = typename CT::rep; + static unsigned CONSTDATA trial_width = + detail::width::value; +public: + static unsigned CONSTDATA width = trial_width < 19 ? trial_width : 6u; + using precision = std::chrono::duration::value>>; + +private: + std::chrono::seconds s_; + precision sub_s_; + +public: + CONSTCD11 decimal_format_seconds() + : s_() + , sub_s_() + {} + + CONSTCD11 explicit decimal_format_seconds(const Duration& d) NOEXCEPT + : s_(std::chrono::duration_cast(d)) + , sub_s_(std::chrono::duration_cast(d - s_)) + {} + + CONSTCD14 std::chrono::seconds& seconds() NOEXCEPT {return s_;} + CONSTCD11 std::chrono::seconds seconds() const NOEXCEPT {return s_;} + CONSTCD11 precision subseconds() const NOEXCEPT {return sub_s_;} + + CONSTCD14 precision to_duration() const NOEXCEPT + { + return s_ + sub_s_; + } + + CONSTCD11 bool in_conventional_range() const NOEXCEPT + { + return sub_s_ < std::chrono::seconds{1} && s_ < std::chrono::minutes{1}; + } + + template + friend + std::basic_ostream& + operator<<(std::basic_ostream& os, const decimal_format_seconds& x) + { + return x.print(os, std::chrono::treat_as_floating_point{}); + } + + template + std::basic_ostream& + print(std::basic_ostream& os, std::true_type) const + { + date::detail::save_ostream _(os); + std::chrono::duration d = s_ + sub_s_; + if (d < std::chrono::seconds{10}) + os << '0'; + os.precision(width+6); + os << std::fixed << d.count(); + return os; + } + + template + std::basic_ostream& + print(std::basic_ostream& os, std::false_type) const + { + date::detail::save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(2); + os << s_.count(); + if (width > 0) + { +#if !ONLY_C_LOCALE + os << std::use_facet>(os.getloc()).decimal_point(); +#else + os << '.'; +#endif + date::detail::save_ostream _s(os); + os.imbue(std::locale::classic()); + os.width(width); + os << sub_s_.count(); + } + return os; + } +}; + +template +inline +CONSTCD11 +typename std::enable_if + < + std::numeric_limits::is_signed, + std::chrono::duration + >::type +abs(std::chrono::duration d) +{ + return d >= d.zero() ? +d : -d; +} + +template +inline +CONSTCD11 +typename std::enable_if + < + !std::numeric_limits::is_signed, + std::chrono::duration + >::type +abs(std::chrono::duration d) +{ + return d; +} + +} // namespace detail + +template +class hh_mm_ss +{ + using dfs = detail::decimal_format_seconds::type>; + + std::chrono::hours h_; + std::chrono::minutes m_; + dfs s_; + bool neg_; + +public: + static unsigned CONSTDATA fractional_width = dfs::width; + using precision = typename dfs::precision; + + CONSTCD11 hh_mm_ss() NOEXCEPT + : hh_mm_ss(Duration::zero()) + {} + + CONSTCD11 explicit hh_mm_ss(Duration d) NOEXCEPT + : h_(std::chrono::duration_cast(detail::abs(d))) + , m_(std::chrono::duration_cast(detail::abs(d)) - h_) + , s_(detail::abs(d) - h_ - m_) + , neg_(d < Duration::zero()) + {} + + CONSTCD11 std::chrono::hours hours() const NOEXCEPT {return h_;} + CONSTCD11 std::chrono::minutes minutes() const NOEXCEPT {return m_;} + CONSTCD11 std::chrono::seconds seconds() const NOEXCEPT {return s_.seconds();} + CONSTCD14 std::chrono::seconds& + seconds(detail::undocumented) NOEXCEPT {return s_.seconds();} + CONSTCD11 precision subseconds() const NOEXCEPT {return s_.subseconds();} + CONSTCD11 bool is_negative() const NOEXCEPT {return neg_;} + + CONSTCD11 explicit operator precision() const NOEXCEPT {return to_duration();} + CONSTCD11 precision to_duration() const NOEXCEPT + {return (s_.to_duration() + m_ + h_) * (1-2*neg_);} + + CONSTCD11 bool in_conventional_range() const NOEXCEPT + { + return !neg_ && h_ < days{1} && m_ < std::chrono::hours{1} && + s_.in_conventional_range(); + } + +private: + + template + friend + std::basic_ostream& + operator<<(std::basic_ostream& os, hh_mm_ss const& tod) + { + if (tod.is_negative()) + os << '-'; + if (tod.h_ < std::chrono::hours{10}) + os << '0'; + os << tod.h_.count() << ':'; + if (tod.m_ < std::chrono::minutes{10}) + os << '0'; + os << tod.m_.count() << ':' << tod.s_; + return os; + } + + template + friend + std::basic_ostream& + date::to_stream(std::basic_ostream& os, const CharT* fmt, + const fields& fds, const std::string* abbrev, + const std::chrono::seconds* offset_sec); + + template + friend + std::basic_istream& + date::from_stream(std::basic_istream& is, const CharT* fmt, + fields& fds, + std::basic_string* abbrev, std::chrono::minutes* offset); +}; + +inline +CONSTCD14 +bool +is_am(std::chrono::hours const& h) NOEXCEPT +{ + using std::chrono::hours; + return hours{0} <= h && h < hours{12}; +} + +inline +CONSTCD14 +bool +is_pm(std::chrono::hours const& h) NOEXCEPT +{ + using std::chrono::hours; + return hours{12} <= h && h < hours{24}; +} + +inline +CONSTCD14 +std::chrono::hours +make12(std::chrono::hours h) NOEXCEPT +{ + using std::chrono::hours; + if (h < hours{12}) + { + if (h == hours{0}) + h = hours{12}; + } + else + { + if (h != hours{12}) + h = h - hours{12}; + } + return h; +} + +inline +CONSTCD14 +std::chrono::hours +make24(std::chrono::hours h, bool is_pm) NOEXCEPT +{ + using std::chrono::hours; + if (is_pm) + { + if (h != hours{12}) + h = h + hours{12}; + } + else if (h == hours{12}) + h = hours{0}; + return h; +} + +template +using time_of_day = hh_mm_ss; + +template +CONSTCD11 +inline +hh_mm_ss> +make_time(const std::chrono::duration& d) +{ + return hh_mm_ss>(d); +} + +template +inline +typename std::enable_if +< + !std::is_convertible::value, + std::basic_ostream& +>::type +operator<<(std::basic_ostream& os, const sys_time& tp) +{ + auto const dp = date::floor(tp); + return os << year_month_day(dp) << ' ' << make_time(tp-dp); +} + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const sys_days& dp) +{ + return os << year_month_day(dp); +} + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, const local_time& ut) +{ + return (os << sys_time{ut.time_since_epoch()}); +} + +namespace detail +{ + +template +class string_literal; + +template +inline +CONSTCD14 +string_literal::type, + N1 + N2 - 1> +operator+(const string_literal& x, const string_literal& y) NOEXCEPT; + +template +class string_literal +{ + CharT p_[N]; + + CONSTCD11 string_literal() NOEXCEPT + : p_{} + {} + +public: + using const_iterator = const CharT*; + + string_literal(string_literal const&) = default; + string_literal& operator=(string_literal const&) = delete; + + template ::type> + CONSTCD11 string_literal(CharT c) NOEXCEPT + : p_{c} + { + } + + template ::type> + CONSTCD11 string_literal(CharT c1, CharT c2) NOEXCEPT + : p_{c1, c2} + { + } + + template ::type> + CONSTCD11 string_literal(CharT c1, CharT c2, CharT c3) NOEXCEPT + : p_{c1, c2, c3} + { + } + + CONSTCD14 string_literal(const CharT(&a)[N]) NOEXCEPT + : p_{} + { + for (std::size_t i = 0; i < N; ++i) + p_[i] = a[i]; + } + + template ::type> + CONSTCD14 string_literal(const char(&a)[N]) NOEXCEPT + : p_{} + { + for (std::size_t i = 0; i < N; ++i) + p_[i] = a[i]; + } + + template ::value>::type> + CONSTCD14 string_literal(string_literal const& a) NOEXCEPT + : p_{} + { + for (std::size_t i = 0; i < N; ++i) + p_[i] = a[i]; + } + + CONSTCD11 const CharT* data() const NOEXCEPT {return p_;} + CONSTCD11 std::size_t size() const NOEXCEPT {return N-1;} + + CONSTCD11 const_iterator begin() const NOEXCEPT {return p_;} + CONSTCD11 const_iterator end() const NOEXCEPT {return p_ + N-1;} + + CONSTCD11 CharT const& operator[](std::size_t n) const NOEXCEPT + { + return p_[n]; + } + + template + friend + std::basic_ostream& + operator<<(std::basic_ostream& os, const string_literal& s) + { + return os << s.p_; + } + + template + friend + CONSTCD14 + string_literal::type, + N1 + N2 - 1> + operator+(const string_literal& x, const string_literal& y) NOEXCEPT; +}; + +template +CONSTCD11 +inline +string_literal +operator+(const string_literal& x, const string_literal& y) NOEXCEPT +{ + return string_literal(x[0], y[0]); +} + +template +CONSTCD11 +inline +string_literal +operator+(const string_literal& x, const string_literal& y) NOEXCEPT +{ + return string_literal(x[0], x[1], y[0]); +} + +template +CONSTCD14 +inline +string_literal::type, + N1 + N2 - 1> +operator+(const string_literal& x, const string_literal& y) NOEXCEPT +{ + using CT = typename std::conditional::type; + + string_literal r; + std::size_t i = 0; + for (; i < N1-1; ++i) + r.p_[i] = CT(x.p_[i]); + for (std::size_t j = 0; j < N2; ++j, ++i) + r.p_[i] = CT(y.p_[j]); + + return r; +} + + +template +inline +std::basic_string +operator+(std::basic_string x, const string_literal& y) +{ + x.append(y.data(), y.size()); + return x; +} + +#if __cplusplus >= 201402 && (!defined(__EDG_VERSION__) || __EDG_VERSION__ > 411) \ + && (!defined(__SUNPRO_CC) || __SUNPRO_CC > 0x5150) + +template ::value || + std::is_same::value || + std::is_same::value || + std::is_same::value>> +CONSTCD14 +inline +string_literal +msl(CharT c) NOEXCEPT +{ + return string_literal{c}; +} + +CONSTCD14 +inline +std::size_t +to_string_len(std::intmax_t i) +{ + std::size_t r = 0; + do + { + i /= 10; + ++r; + } while (i > 0); + return r; +} + +template +CONSTCD14 +inline +std::enable_if_t +< + N < 10, + string_literal +> +msl() NOEXCEPT +{ + return msl(char(N % 10 + '0')); +} + +template +CONSTCD14 +inline +std::enable_if_t +< + 10 <= N, + string_literal +> +msl() NOEXCEPT +{ + return msl() + msl(char(N % 10 + '0')); +} + +template +CONSTCD14 +inline +std::enable_if_t +< + std::ratio::type::den != 1, + string_literal::type::num) + + to_string_len(std::ratio::type::den) + 4> +> +msl(std::ratio) NOEXCEPT +{ + using R = typename std::ratio::type; + return msl(CharT{'['}) + msl() + msl(CharT{'/'}) + + msl() + msl(CharT{']'}); +} + +template +CONSTCD14 +inline +std::enable_if_t +< + std::ratio::type::den == 1, + string_literal::type::num) + 3> +> +msl(std::ratio) NOEXCEPT +{ + using R = typename std::ratio::type; + return msl(CharT{'['}) + msl() + msl(CharT{']'}); +} + + +#else // __cplusplus < 201402 || (defined(__EDG_VERSION__) && __EDG_VERSION__ <= 411) + +inline +std::string +to_string(std::uint64_t x) +{ + return std::to_string(x); +} + +template +inline +std::basic_string +to_string(std::uint64_t x) +{ + auto y = std::to_string(x); + return std::basic_string(y.begin(), y.end()); +} + +template +inline +typename std::enable_if +< + std::ratio::type::den != 1, + std::basic_string +>::type +msl(std::ratio) +{ + using R = typename std::ratio::type; + return std::basic_string(1, '[') + to_string(R::num) + CharT{'/'} + + to_string(R::den) + CharT{']'}; +} + +template +inline +typename std::enable_if +< + std::ratio::type::den == 1, + std::basic_string +>::type +msl(std::ratio) +{ + using R = typename std::ratio::type; + return std::basic_string(1, '[') + to_string(R::num) + CharT{']'}; +} + +#endif // __cplusplus < 201402 || (defined(__EDG_VERSION__) && __EDG_VERSION__ <= 411) + +template +CONSTCD11 +inline +string_literal +msl(std::atto) NOEXCEPT +{ + return string_literal{'a'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::femto) NOEXCEPT +{ + return string_literal{'f'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::pico) NOEXCEPT +{ + return string_literal{'p'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::nano) NOEXCEPT +{ + return string_literal{'n'}; +} + +template +CONSTCD11 +inline +typename std::enable_if +< + std::is_same::value, + string_literal +>::type +msl(std::micro) NOEXCEPT +{ + return string_literal{'\xC2', '\xB5'}; +} + +template +CONSTCD11 +inline +typename std::enable_if +< + !std::is_same::value, + string_literal +>::type +msl(std::micro) NOEXCEPT +{ + return string_literal{CharT{static_cast('\xB5')}}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::milli) NOEXCEPT +{ + return string_literal{'m'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::centi) NOEXCEPT +{ + return string_literal{'c'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::deca) NOEXCEPT +{ + return string_literal{'d', 'a'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::deci) NOEXCEPT +{ + return string_literal{'d'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::hecto) NOEXCEPT +{ + return string_literal{'h'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::kilo) NOEXCEPT +{ + return string_literal{'k'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::mega) NOEXCEPT +{ + return string_literal{'M'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::giga) NOEXCEPT +{ + return string_literal{'G'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::tera) NOEXCEPT +{ + return string_literal{'T'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::peta) NOEXCEPT +{ + return string_literal{'P'}; +} + +template +CONSTCD11 +inline +string_literal +msl(std::exa) NOEXCEPT +{ + return string_literal{'E'}; +} + +template +CONSTCD11 +inline +auto +get_units(Period p) + -> decltype(msl(p) + string_literal{'s'}) +{ + return msl(p) + string_literal{'s'}; +} + +template +CONSTCD11 +inline +string_literal +get_units(std::ratio<1>) +{ + return string_literal{'s'}; +} + +template +CONSTCD11 +inline +string_literal +get_units(std::ratio<3600>) +{ + return string_literal{'h'}; +} + +template +CONSTCD11 +inline +string_literal +get_units(std::ratio<60>) +{ + return string_literal{'m', 'i', 'n'}; +} + +template +CONSTCD11 +inline +string_literal +get_units(std::ratio<86400>) +{ + return string_literal{'d'}; +} + +template > +struct make_string; + +template <> +struct make_string +{ + template + static + std::string + from(Rep n) + { + return std::to_string(n); + } +}; + +template +struct make_string +{ + template + static + std::basic_string + from(Rep n) + { + auto s = std::to_string(n); + return std::basic_string(s.begin(), s.end()); + } +}; + +template <> +struct make_string +{ + template + static + std::wstring + from(Rep n) + { + return std::to_wstring(n); + } +}; + +template +struct make_string +{ + template + static + std::basic_string + from(Rep n) + { + auto s = std::to_wstring(n); + return std::basic_string(s.begin(), s.end()); + } +}; + +} // namespace detail + +// to_stream + +CONSTDATA year nanyear{-32768}; + +template +struct fields +{ + year_month_day ymd{nanyear/0/0}; + weekday wd{8u}; + hh_mm_ss tod{}; + bool has_tod = false; + +#if !defined(__clang__) && defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ <= 409) + fields() : ymd{nanyear/0/0}, wd{8u}, tod{}, has_tod{false} {} +#else + fields() = default; +#endif + + fields(year_month_day ymd_) : ymd(ymd_) {} + fields(weekday wd_) : wd(wd_) {} + fields(hh_mm_ss tod_) : tod(tod_), has_tod(true) {} + + fields(year_month_day ymd_, weekday wd_) : ymd(ymd_), wd(wd_) {} + fields(year_month_day ymd_, hh_mm_ss tod_) : ymd(ymd_), tod(tod_), + has_tod(true) {} + + fields(weekday wd_, hh_mm_ss tod_) : wd(wd_), tod(tod_), has_tod(true) {} + + fields(year_month_day ymd_, weekday wd_, hh_mm_ss tod_) + : ymd(ymd_) + , wd(wd_) + , tod(tod_) + , has_tod(true) + {} +}; + +namespace detail +{ + +template +unsigned +extract_weekday(std::basic_ostream& os, const fields& fds) +{ + if (!fds.ymd.ok() && !fds.wd.ok()) + { + // fds does not contain a valid weekday + os.setstate(std::ios::failbit); + return 8; + } + weekday wd; + if (fds.ymd.ok()) + { + wd = weekday{sys_days(fds.ymd)}; + if (fds.wd.ok() && wd != fds.wd) + { + // fds.ymd and fds.wd are inconsistent + os.setstate(std::ios::failbit); + return 8; + } + } + else + wd = fds.wd; + return static_cast((wd - Sunday).count()); +} + +template +unsigned +extract_month(std::basic_ostream& os, const fields& fds) +{ + if (!fds.ymd.month().ok()) + { + // fds does not contain a valid month + os.setstate(std::ios::failbit); + return 0; + } + return static_cast(fds.ymd.month()); +} + +} // namespace detail + +#if ONLY_C_LOCALE + +namespace detail +{ + +inline +std::pair +weekday_names() +{ + static const std::string nm[] = + { + "Sunday", + "Monday", + "Tuesday", + "Wednesday", + "Thursday", + "Friday", + "Saturday", + "Sun", + "Mon", + "Tue", + "Wed", + "Thu", + "Fri", + "Sat" + }; + return std::make_pair(nm, nm+sizeof(nm)/sizeof(nm[0])); +} + +inline +std::pair +month_names() +{ + static const std::string nm[] = + { + "January", + "February", + "March", + "April", + "May", + "June", + "July", + "August", + "September", + "October", + "November", + "December", + "Jan", + "Feb", + "Mar", + "Apr", + "May", + "Jun", + "Jul", + "Aug", + "Sep", + "Oct", + "Nov", + "Dec" + }; + return std::make_pair(nm, nm+sizeof(nm)/sizeof(nm[0])); +} + +inline +std::pair +ampm_names() +{ + static const std::string nm[] = + { + "AM", + "PM" + }; + return std::make_pair(nm, nm+sizeof(nm)/sizeof(nm[0])); +} + +template +FwdIter +scan_keyword(std::basic_istream& is, FwdIter kb, FwdIter ke) +{ + size_t nkw = static_cast(std::distance(kb, ke)); + const unsigned char doesnt_match = '\0'; + const unsigned char might_match = '\1'; + const unsigned char does_match = '\2'; + unsigned char statbuf[100]; + unsigned char* status = statbuf; + std::unique_ptr stat_hold(0, free); + if (nkw > sizeof(statbuf)) + { + status = (unsigned char*)std::malloc(nkw); + if (status == nullptr) + throw std::bad_alloc(); + stat_hold.reset(status); + } + size_t n_might_match = nkw; // At this point, any keyword might match + size_t n_does_match = 0; // but none of them definitely do + // Initialize all statuses to might_match, except for "" keywords are does_match + unsigned char* st = status; + for (auto ky = kb; ky != ke; ++ky, ++st) + { + if (!ky->empty()) + *st = might_match; + else + { + *st = does_match; + --n_might_match; + ++n_does_match; + } + } + // While there might be a match, test keywords against the next CharT + for (size_t indx = 0; is && n_might_match > 0; ++indx) + { + // Peek at the next CharT but don't consume it + auto ic = is.peek(); + if (ic == EOF) + { + is.setstate(std::ios::eofbit); + break; + } + auto c = static_cast(toupper(static_cast(ic))); + bool consume = false; + // For each keyword which might match, see if the indx character is c + // If a match if found, consume c + // If a match is found, and that is the last character in the keyword, + // then that keyword matches. + // If the keyword doesn't match this character, then change the keyword + // to doesn't match + st = status; + for (auto ky = kb; ky != ke; ++ky, ++st) + { + if (*st == might_match) + { + if (c == static_cast(toupper(static_cast((*ky)[indx])))) + { + consume = true; + if (ky->size() == indx+1) + { + *st = does_match; + --n_might_match; + ++n_does_match; + } + } + else + { + *st = doesnt_match; + --n_might_match; + } + } + } + // consume if we matched a character + if (consume) + { + (void)is.get(); + // If we consumed a character and there might be a matched keyword that + // was marked matched on a previous iteration, then such keywords + // are now marked as not matching. + if (n_might_match + n_does_match > 1) + { + st = status; + for (auto ky = kb; ky != ke; ++ky, ++st) + { + if (*st == does_match && ky->size() != indx+1) + { + *st = doesnt_match; + --n_does_match; + } + } + } + } + } + // We've exited the loop because we hit eof and/or we have no more "might matches". + // Return the first matching result + for (st = status; kb != ke; ++kb, ++st) + if (*st == does_match) + break; + if (kb == ke) + is.setstate(std::ios::failbit); + return kb; +} + +} // namespace detail + +#endif // ONLY_C_LOCALE + +template +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, + const fields& fds, const std::string* abbrev, + const std::chrono::seconds* offset_sec) +{ +#if ONLY_C_LOCALE + using detail::weekday_names; + using detail::month_names; + using detail::ampm_names; +#endif + using detail::save_ostream; + using detail::get_units; + using detail::extract_weekday; + using detail::extract_month; + using std::ios; + using std::chrono::duration_cast; + using std::chrono::seconds; + using std::chrono::minutes; + using std::chrono::hours; + date::detail::save_ostream ss(os); + os.fill(' '); + os.flags(std::ios::skipws | std::ios::dec); + os.width(0); + tm tm{}; + bool insert_negative = fds.has_tod && fds.tod.to_duration() < Duration::zero(); +#if !ONLY_C_LOCALE + auto& facet = std::use_facet>(os.getloc()); +#endif + const CharT* command = nullptr; + CharT modified = CharT{}; + for (; *fmt; ++fmt) + { + switch (*fmt) + { + case 'a': + case 'A': + if (command) + { + if (modified == CharT{}) + { + tm.tm_wday = static_cast(extract_weekday(os, fds)); + if (os.fail()) + return os; +#if !ONLY_C_LOCALE + const CharT f[] = {'%', *fmt}; + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); +#else // ONLY_C_LOCALE + os << weekday_names().first[tm.tm_wday+7*(*fmt == 'a')]; +#endif // ONLY_C_LOCALE + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'b': + case 'B': + case 'h': + if (command) + { + if (modified == CharT{}) + { + tm.tm_mon = static_cast(extract_month(os, fds)) - 1; +#if !ONLY_C_LOCALE + const CharT f[] = {'%', *fmt}; + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); +#else // ONLY_C_LOCALE + os << month_names().first[tm.tm_mon+12*(*fmt != 'B')]; +#endif // ONLY_C_LOCALE + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'c': + case 'x': + if (command) + { + if (modified == CharT{'O'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.ymd.ok()) + os.setstate(std::ios::failbit); + if (*fmt == 'c' && !fds.has_tod) + os.setstate(std::ios::failbit); +#if !ONLY_C_LOCALE + tm = std::tm{}; + auto const& ymd = fds.ymd; + auto ld = local_days(ymd); + if (*fmt == 'c') + { + tm.tm_sec = static_cast(fds.tod.seconds().count()); + tm.tm_min = static_cast(fds.tod.minutes().count()); + tm.tm_hour = static_cast(fds.tod.hours().count()); + } + tm.tm_mday = static_cast(static_cast(ymd.day())); + tm.tm_mon = static_cast(extract_month(os, fds) - 1); + tm.tm_year = static_cast(ymd.year()) - 1900; + tm.tm_wday = static_cast(extract_weekday(os, fds)); + if (os.fail()) + return os; + tm.tm_yday = static_cast((ld - local_days(ymd.year()/1/1)).count()); + CharT f[3] = {'%'}; + auto fe = std::begin(f) + 1; + if (modified == CharT{'E'}) + *fe++ = modified; + *fe++ = *fmt; + facet.put(os, os, os.fill(), &tm, std::begin(f), fe); +#else // ONLY_C_LOCALE + if (*fmt == 'c') + { + auto wd = static_cast(extract_weekday(os, fds)); + os << weekday_names().first[static_cast(wd)+7] + << ' '; + os << month_names().first[extract_month(os, fds)-1+12] << ' '; + auto d = static_cast(static_cast(fds.ymd.day())); + if (d < 10) + os << ' '; + os << d << ' ' + << make_time(duration_cast(fds.tod.to_duration())) + << ' ' << fds.ymd.year(); + + } + else // *fmt == 'x' + { + auto const& ymd = fds.ymd; + save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(2); + os << static_cast(ymd.month()) << CharT{'/'}; + os.width(2); + os << static_cast(ymd.day()) << CharT{'/'}; + os.width(2); + os << static_cast(ymd.year()) % 100; + } +#endif // ONLY_C_LOCALE + } + command = nullptr; + modified = CharT{}; + } + else + os << *fmt; + break; + case 'C': + if (command) + { + if (modified == CharT{'O'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.ymd.year().ok()) + os.setstate(std::ios::failbit); + auto y = static_cast(fds.ymd.year()); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + if (y >= 0) + { + os.width(2); + os << y/100; + } + else + { + os << CharT{'-'}; + os.width(2); + os << -(y-99)/100; + } + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'E'}) + { + tm.tm_year = y - 1900; + CharT f[3] = {'%', 'E', 'C'}; + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + command = nullptr; + modified = CharT{}; + } + else + os << *fmt; + break; + case 'd': + case 'e': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.ymd.day().ok()) + os.setstate(std::ios::failbit); + auto d = static_cast(static_cast(fds.ymd.day())); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + save_ostream _(os); + if (*fmt == CharT{'d'}) + os.fill('0'); + else + os.fill(' '); + os.flags(std::ios::dec | std::ios::right); + os.width(2); + os << d; + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + tm.tm_mday = d; + CharT f[3] = {'%', 'O', *fmt}; + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + command = nullptr; + modified = CharT{}; + } + else + os << *fmt; + break; + case 'D': + if (command) + { + if (modified == CharT{}) + { + if (!fds.ymd.ok()) + os.setstate(std::ios::failbit); + auto const& ymd = fds.ymd; + save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(2); + os << static_cast(ymd.month()) << CharT{'/'}; + os.width(2); + os << static_cast(ymd.day()) << CharT{'/'}; + os.width(2); + os << static_cast(ymd.year()) % 100; + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'F': + if (command) + { + if (modified == CharT{}) + { + if (!fds.ymd.ok()) + os.setstate(std::ios::failbit); + auto const& ymd = fds.ymd; + save_ostream _(os); + os.imbue(std::locale::classic()); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(4); + os << static_cast(ymd.year()) << CharT{'-'}; + os.width(2); + os << static_cast(ymd.month()) << CharT{'-'}; + os.width(2); + os << static_cast(ymd.day()); + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'g': + case 'G': + if (command) + { + if (modified == CharT{}) + { + if (!fds.ymd.ok()) + os.setstate(std::ios::failbit); + auto ld = local_days(fds.ymd); + auto y = year_month_day{ld + days{3}}.year(); + auto start = local_days((y-years{1})/December/Thursday[last]) + + (Monday-Thursday); + if (ld < start) + --y; + if (*fmt == CharT{'G'}) + os << y; + else + { + save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(2); + os << std::abs(static_cast(y)) % 100; + } + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'H': + case 'I': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); + if (insert_negative) + { + os << '-'; + insert_negative = false; + } + auto hms = fds.tod; +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + auto h = *fmt == CharT{'I'} ? date::make12(hms.hours()) : hms.hours(); + if (h < hours{10}) + os << CharT{'0'}; + os << h.count(); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_hour = static_cast(hms.hours().count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'j': + if (command) + { + if (modified == CharT{}) + { + if (fds.ymd.ok() || fds.has_tod) + { + days doy; + if (fds.ymd.ok()) + { + auto ld = local_days(fds.ymd); + auto y = fds.ymd.year(); + doy = ld - local_days(y/January/1) + days{1}; + } + else + { + doy = duration_cast(fds.tod.to_duration()); + } + save_ostream _(os); + os.fill('0'); + os.flags(std::ios::dec | std::ios::right); + os.width(3); + os << doy.count(); + } + else + { + os.setstate(std::ios::failbit); + } + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'm': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.ymd.month().ok()) + os.setstate(std::ios::failbit); + auto m = static_cast(fds.ymd.month()); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + if (m < 10) + os << CharT{'0'}; + os << m; + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_mon = static_cast(m-1); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'M': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); + if (insert_negative) + { + os << '-'; + insert_negative = false; + } +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + if (fds.tod.minutes() < minutes{10}) + os << CharT{'0'}; + os << fds.tod.minutes().count(); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_min = static_cast(fds.tod.minutes().count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'n': + if (command) + { + if (modified == CharT{}) + os << CharT{'\n'}; + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'p': + if (command) + { + if (modified == CharT{}) + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); +#if !ONLY_C_LOCALE + const CharT f[] = {'%', *fmt}; + tm.tm_hour = static_cast(fds.tod.hours().count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); +#else + if (date::is_am(fds.tod.hours())) + os << ampm_names().first[0]; + else + os << ampm_names().first[1]; +#endif + } + else + { + os << CharT{'%'} << modified << *fmt; + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'Q': + case 'q': + if (command) + { + if (modified == CharT{}) + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); + auto d = fds.tod.to_duration(); + if (*fmt == 'q') + os << get_units(typename decltype(d)::period::type{}); + else + os << d.count(); + } + else + { + os << CharT{'%'} << modified << *fmt; + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'r': + if (command) + { + if (modified == CharT{}) + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); +#if !ONLY_C_LOCALE + const CharT f[] = {'%', *fmt}; + tm.tm_hour = static_cast(fds.tod.hours().count()); + tm.tm_min = static_cast(fds.tod.minutes().count()); + tm.tm_sec = static_cast(fds.tod.seconds().count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); +#else + hh_mm_ss tod(duration_cast(fds.tod.to_duration())); + save_ostream _(os); + os.fill('0'); + os.width(2); + os << date::make12(tod.hours()).count() << CharT{':'}; + os.width(2); + os << tod.minutes().count() << CharT{':'}; + os.width(2); + os << tod.seconds().count() << CharT{' '}; + if (date::is_am(tod.hours())) + os << ampm_names().first[0]; + else + os << ampm_names().first[1]; +#endif + } + else + { + os << CharT{'%'} << modified << *fmt; + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'R': + if (command) + { + if (modified == CharT{}) + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); + if (fds.tod.hours() < hours{10}) + os << CharT{'0'}; + os << fds.tod.hours().count() << CharT{':'}; + if (fds.tod.minutes() < minutes{10}) + os << CharT{'0'}; + os << fds.tod.minutes().count(); + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'S': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); + if (insert_negative) + { + os << '-'; + insert_negative = false; + } +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + os << fds.tod.s_; + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_sec = static_cast(fds.tod.s_.seconds().count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 't': + if (command) + { + if (modified == CharT{}) + os << CharT{'\t'}; + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'T': + if (command) + { + if (modified == CharT{}) + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); + os << fds.tod; + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'u': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + auto wd = extract_weekday(os, fds); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + os << (wd != 0 ? wd : 7u); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_wday = static_cast(wd); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'U': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + auto const& ymd = fds.ymd; + if (!ymd.ok()) + os.setstate(std::ios::failbit); + auto ld = local_days(ymd); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + auto st = local_days(Sunday[1]/January/ymd.year()); + if (ld < st) + os << CharT{'0'} << CharT{'0'}; + else + { + auto wn = duration_cast(ld - st).count() + 1; + if (wn < 10) + os << CharT{'0'}; + os << wn; + } + } + #if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_year = static_cast(ymd.year()) - 1900; + tm.tm_wday = static_cast(extract_weekday(os, fds)); + if (os.fail()) + return os; + tm.tm_yday = static_cast((ld - local_days(ymd.year()/1/1)).count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'V': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.ymd.ok()) + os.setstate(std::ios::failbit); + auto ld = local_days(fds.ymd); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + auto y = year_month_day{ld + days{3}}.year(); + auto st = local_days((y-years{1})/12/Thursday[last]) + + (Monday-Thursday); + if (ld < st) + { + --y; + st = local_days((y - years{1})/12/Thursday[last]) + + (Monday-Thursday); + } + auto wn = duration_cast(ld - st).count() + 1; + if (wn < 10) + os << CharT{'0'}; + os << wn; + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + auto const& ymd = fds.ymd; + tm.tm_year = static_cast(ymd.year()) - 1900; + tm.tm_wday = static_cast(extract_weekday(os, fds)); + if (os.fail()) + return os; + tm.tm_yday = static_cast((ld - local_days(ymd.year()/1/1)).count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'w': + if (command) + { + auto wd = extract_weekday(os, fds); + if (os.fail()) + return os; +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + os << wd; + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_wday = static_cast(wd); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + else + { + os << CharT{'%'} << modified << *fmt; + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'W': + if (command) + { + if (modified == CharT{'E'}) + os << CharT{'%'} << modified << *fmt; + else + { + auto const& ymd = fds.ymd; + if (!ymd.ok()) + os.setstate(std::ios::failbit); + auto ld = local_days(ymd); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + auto st = local_days(Monday[1]/January/ymd.year()); + if (ld < st) + os << CharT{'0'} << CharT{'0'}; + else + { + auto wn = duration_cast(ld - st).count() + 1; + if (wn < 10) + os << CharT{'0'}; + os << wn; + } + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_year = static_cast(ymd.year()) - 1900; + tm.tm_wday = static_cast(extract_weekday(os, fds)); + if (os.fail()) + return os; + tm.tm_yday = static_cast((ld - local_days(ymd.year()/1/1)).count()); + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'X': + if (command) + { + if (modified == CharT{'O'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.has_tod) + os.setstate(std::ios::failbit); +#if !ONLY_C_LOCALE + tm = std::tm{}; + tm.tm_sec = static_cast(fds.tod.seconds().count()); + tm.tm_min = static_cast(fds.tod.minutes().count()); + tm.tm_hour = static_cast(fds.tod.hours().count()); + CharT f[3] = {'%'}; + auto fe = std::begin(f) + 1; + if (modified == CharT{'E'}) + *fe++ = modified; + *fe++ = *fmt; + facet.put(os, os, os.fill(), &tm, std::begin(f), fe); +#else + os << fds.tod; +#endif + } + command = nullptr; + modified = CharT{}; + } + else + os << *fmt; + break; + case 'y': + if (command) + { + if (!fds.ymd.year().ok()) + os.setstate(std::ios::failbit); + auto y = static_cast(fds.ymd.year()); +#if !ONLY_C_LOCALE + if (modified == CharT{}) + { +#endif + y = std::abs(y) % 100; + if (y < 10) + os << CharT{'0'}; + os << y; +#if !ONLY_C_LOCALE + } + else + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_year = y - 1900; + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'Y': + if (command) + { + if (modified == CharT{'O'}) + os << CharT{'%'} << modified << *fmt; + else + { + if (!fds.ymd.year().ok()) + os.setstate(std::ios::failbit); + auto y = fds.ymd.year(); +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + save_ostream _(os); + os.imbue(std::locale::classic()); + os << y; + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'E'}) + { + const CharT f[] = {'%', modified, *fmt}; + tm.tm_year = static_cast(y) - 1900; + facet.put(os, os, os.fill(), &tm, std::begin(f), std::end(f)); + } +#endif + } + modified = CharT{}; + command = nullptr; + } + else + os << *fmt; + break; + case 'z': + if (command) + { + if (offset_sec == nullptr) + { + // Can not format %z with unknown offset + os.setstate(ios::failbit); + return os; + } + auto m = duration_cast(*offset_sec); + auto neg = m < minutes{0}; + m = date::abs(m); + auto h = duration_cast(m); + m -= h; + if (neg) + os << CharT{'-'}; + else + os << CharT{'+'}; + if (h < hours{10}) + os << CharT{'0'}; + os << h.count(); + if (modified != CharT{}) + os << CharT{':'}; + if (m < minutes{10}) + os << CharT{'0'}; + os << m.count(); + command = nullptr; + modified = CharT{}; + } + else + os << *fmt; + break; + case 'Z': + if (command) + { + if (modified == CharT{}) + { + if (abbrev == nullptr) + { + // Can not format %Z with unknown time_zone + os.setstate(ios::failbit); + return os; + } + for (auto c : *abbrev) + os << CharT(c); + } + else + { + os << CharT{'%'} << modified << *fmt; + modified = CharT{}; + } + command = nullptr; + } + else + os << *fmt; + break; + case 'E': + case 'O': + if (command) + { + if (modified == CharT{}) + { + modified = *fmt; + } + else + { + os << CharT{'%'} << modified << *fmt; + command = nullptr; + modified = CharT{}; + } + } + else + os << *fmt; + break; + case '%': + if (command) + { + if (modified == CharT{}) + { + os << CharT{'%'}; + command = nullptr; + } + else + { + os << CharT{'%'} << modified << CharT{'%'}; + command = nullptr; + modified = CharT{}; + } + } + else + command = fmt; + break; + default: + if (command) + { + os << CharT{'%'}; + command = nullptr; + } + if (modified != CharT{}) + { + os << modified; + modified = CharT{}; + } + os << *fmt; + break; + } + } + if (command) + os << CharT{'%'}; + if (modified != CharT{}) + os << modified; + return os; +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, const year& y) +{ + using CT = std::chrono::seconds; + fields fds{y/0/0}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, const month& m) +{ + using CT = std::chrono::seconds; + fields fds{m/0/nanyear}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, const day& d) +{ + using CT = std::chrono::seconds; + fields fds{d/0/nanyear}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, const weekday& wd) +{ + using CT = std::chrono::seconds; + fields fds{wd}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, const year_month& ym) +{ + using CT = std::chrono::seconds; + fields fds{ym/0}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, const month_day& md) +{ + using CT = std::chrono::seconds; + fields fds{md/nanyear}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, + const year_month_day& ymd) +{ + using CT = std::chrono::seconds; + fields fds{ymd}; + return to_stream(os, fmt, fds); +} + +template +inline +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, + const std::chrono::duration& d) +{ + using Duration = std::chrono::duration; + using CT = typename std::common_type::type; + fields fds{hh_mm_ss{d}}; + return to_stream(os, fmt, fds); +} + +template +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, + const local_time& tp, const std::string* abbrev = nullptr, + const std::chrono::seconds* offset_sec = nullptr) +{ + using CT = typename std::common_type::type; + auto ld = std::chrono::time_point_cast(tp); + fields fds; + if (ld <= tp) + fds = fields{year_month_day{ld}, hh_mm_ss{tp-local_seconds{ld}}}; + else + fds = fields{year_month_day{ld - days{1}}, + hh_mm_ss{days{1} - (local_seconds{ld} - tp)}}; + return to_stream(os, fmt, fds, abbrev, offset_sec); +} + +template +std::basic_ostream& +to_stream(std::basic_ostream& os, const CharT* fmt, + const sys_time& tp) +{ + using std::chrono::seconds; + using CT = typename std::common_type::type; + const std::string abbrev("UTC"); + CONSTDATA seconds offset{0}; + auto sd = std::chrono::time_point_cast(tp); + fields fds; + if (sd <= tp) + fds = fields{year_month_day{sd}, hh_mm_ss{tp-sys_seconds{sd}}}; + else + fds = fields{year_month_day{sd - days{1}}, + hh_mm_ss{days{1} - (sys_seconds{sd} - tp)}}; + return to_stream(os, fmt, fds, &abbrev, &offset); +} + +// format + +template +auto +format(const std::locale& loc, const CharT* fmt, const Streamable& tp) + -> decltype(to_stream(std::declval&>(), fmt, tp), + std::basic_string{}) +{ + std::basic_ostringstream os; + os.exceptions(std::ios::failbit | std::ios::badbit); + os.imbue(loc); + to_stream(os, fmt, tp); + return os.str(); +} + +template +auto +format(const CharT* fmt, const Streamable& tp) + -> decltype(to_stream(std::declval&>(), fmt, tp), + std::basic_string{}) +{ + std::basic_ostringstream os; + os.exceptions(std::ios::failbit | std::ios::badbit); + to_stream(os, fmt, tp); + return os.str(); +} + +template +auto +format(const std::locale& loc, const std::basic_string& fmt, + const Streamable& tp) + -> decltype(to_stream(std::declval&>(), fmt.c_str(), tp), + std::basic_string{}) +{ + std::basic_ostringstream os; + os.exceptions(std::ios::failbit | std::ios::badbit); + os.imbue(loc); + to_stream(os, fmt.c_str(), tp); + return os.str(); +} + +template +auto +format(const std::basic_string& fmt, const Streamable& tp) + -> decltype(to_stream(std::declval&>(), fmt.c_str(), tp), + std::basic_string{}) +{ + std::basic_ostringstream os; + os.exceptions(std::ios::failbit | std::ios::badbit); + to_stream(os, fmt.c_str(), tp); + return os.str(); +} + +// parse + +namespace detail +{ + +template +bool +read_char(std::basic_istream& is, CharT fmt, std::ios::iostate& err) +{ + auto ic = is.get(); + if (Traits::eq_int_type(ic, Traits::eof()) || + !Traits::eq(Traits::to_char_type(ic), fmt)) + { + err |= std::ios::failbit; + is.setstate(std::ios::failbit); + return false; + } + return true; +} + +template +unsigned +read_unsigned(std::basic_istream& is, unsigned m = 1, unsigned M = 10) +{ + unsigned x = 0; + unsigned count = 0; + while (true) + { + auto ic = is.peek(); + if (Traits::eq_int_type(ic, Traits::eof())) + break; + auto c = static_cast(Traits::to_char_type(ic)); + if (!('0' <= c && c <= '9')) + break; + (void)is.get(); + ++count; + x = 10*x + static_cast(c - '0'); + if (count == M) + break; + } + if (count < m) + is.setstate(std::ios::failbit); + return x; +} + +template +int +read_signed(std::basic_istream& is, unsigned m = 1, unsigned M = 10) +{ + auto ic = is.peek(); + if (!Traits::eq_int_type(ic, Traits::eof())) + { + auto c = static_cast(Traits::to_char_type(ic)); + if (('0' <= c && c <= '9') || c == '-' || c == '+') + { + if (c == '-' || c == '+') + (void)is.get(); + auto x = static_cast(read_unsigned(is, std::max(m, 1u), M)); + if (!is.fail()) + { + if (c == '-') + x = -x; + return x; + } + } + } + if (m > 0) + is.setstate(std::ios::failbit); + return 0; +} + +template +long double +read_long_double(std::basic_istream& is, unsigned m = 1, unsigned M = 10) +{ + unsigned count = 0; + unsigned fcount = 0; + unsigned long long i = 0; + unsigned long long f = 0; + bool parsing_fraction = false; +#if ONLY_C_LOCALE + typename Traits::int_type decimal_point = '.'; +#else + auto decimal_point = Traits::to_int_type( + std::use_facet>(is.getloc()).decimal_point()); +#endif + while (true) + { + auto ic = is.peek(); + if (Traits::eq_int_type(ic, Traits::eof())) + break; + if (Traits::eq_int_type(ic, decimal_point)) + { + decimal_point = Traits::eof(); + parsing_fraction = true; + } + else + { + auto c = static_cast(Traits::to_char_type(ic)); + if (!('0' <= c && c <= '9')) + break; + if (!parsing_fraction) + { + i = 10*i + static_cast(c - '0'); + } + else + { + f = 10*f + static_cast(c - '0'); + ++fcount; + } + } + (void)is.get(); + if (++count == M) + break; + } + if (count < m) + { + is.setstate(std::ios::failbit); + return 0; + } + return static_cast(i) + static_cast(f)/std::pow(10.L, fcount); +} + +struct rs +{ + int& i; + unsigned m; + unsigned M; +}; + +struct ru +{ + int& i; + unsigned m; + unsigned M; +}; + +struct rld +{ + long double& i; + unsigned m; + unsigned M; +}; + +template +void +read(std::basic_istream&) +{ +} + +template +void +read(std::basic_istream& is, CharT a0, Args&& ...args); + +template +void +read(std::basic_istream& is, rs a0, Args&& ...args); + +template +void +read(std::basic_istream& is, ru a0, Args&& ...args); + +template +void +read(std::basic_istream& is, int a0, Args&& ...args); + +template +void +read(std::basic_istream& is, rld a0, Args&& ...args); + +template +void +read(std::basic_istream& is, CharT a0, Args&& ...args) +{ + // No-op if a0 == CharT{} + if (a0 != CharT{}) + { + auto ic = is.peek(); + if (Traits::eq_int_type(ic, Traits::eof())) + { + is.setstate(std::ios::failbit | std::ios::eofbit); + return; + } + if (!Traits::eq(Traits::to_char_type(ic), a0)) + { + is.setstate(std::ios::failbit); + return; + } + (void)is.get(); + } + read(is, std::forward(args)...); +} + +template +void +read(std::basic_istream& is, rs a0, Args&& ...args) +{ + auto x = read_signed(is, a0.m, a0.M); + if (is.fail()) + return; + a0.i = x; + read(is, std::forward(args)...); +} + +template +void +read(std::basic_istream& is, ru a0, Args&& ...args) +{ + auto x = read_unsigned(is, a0.m, a0.M); + if (is.fail()) + return; + a0.i = static_cast(x); + read(is, std::forward(args)...); +} + +template +void +read(std::basic_istream& is, int a0, Args&& ...args) +{ + if (a0 != -1) + { + auto u = static_cast(a0); + CharT buf[std::numeric_limits::digits10+2u] = {}; + auto e = buf; + do + { + *e++ = static_cast(CharT(u % 10) + CharT{'0'}); + u /= 10; + } while (u > 0); + std::reverse(buf, e); + for (auto p = buf; p != e && is.rdstate() == std::ios::goodbit; ++p) + read(is, *p); + } + if (is.rdstate() == std::ios::goodbit) + read(is, std::forward(args)...); +} + +template +void +read(std::basic_istream& is, rld a0, Args&& ...args) +{ + auto x = read_long_double(is, a0.m, a0.M); + if (is.fail()) + return; + a0.i = x; + read(is, std::forward(args)...); +} + +template +inline +void +checked_set(T& value, T from, T not_a_value, std::basic_ios& is) +{ + if (!is.fail()) + { + if (value == not_a_value) + value = std::move(from); + else if (value != from) + is.setstate(std::ios::failbit); + } +} + +} // namespace detail; + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, + fields& fds, std::basic_string* abbrev, + std::chrono::minutes* offset) +{ + using std::numeric_limits; + using std::ios; + using std::chrono::duration; + using std::chrono::duration_cast; + using std::chrono::seconds; + using std::chrono::minutes; + using std::chrono::hours; + using detail::round_i; + typename std::basic_istream::sentry ok{is, true}; + if (ok) + { + date::detail::save_istream ss(is); + is.fill(' '); + is.flags(std::ios::skipws | std::ios::dec); + is.width(0); +#if !ONLY_C_LOCALE + auto& f = std::use_facet>(is.getloc()); + std::tm tm{}; +#endif + const CharT* command = nullptr; + auto modified = CharT{}; + auto width = -1; + + CONSTDATA int not_a_year = numeric_limits::min(); + CONSTDATA int not_a_2digit_year = 100; + CONSTDATA int not_a_century = not_a_year / 100; + CONSTDATA int not_a_month = 0; + CONSTDATA int not_a_day = 0; + CONSTDATA int not_a_hour = numeric_limits::min(); + CONSTDATA int not_a_hour_12_value = 0; + CONSTDATA int not_a_minute = not_a_hour; + CONSTDATA Duration not_a_second = Duration::min(); + CONSTDATA int not_a_doy = -1; + CONSTDATA int not_a_weekday = 8; + CONSTDATA int not_a_week_num = 100; + CONSTDATA int not_a_ampm = -1; + CONSTDATA minutes not_a_offset = minutes::min(); + + int Y = not_a_year; // c, F, Y * + int y = not_a_2digit_year; // D, x, y * + int g = not_a_2digit_year; // g * + int G = not_a_year; // G * + int C = not_a_century; // C * + int m = not_a_month; // b, B, h, m, c, D, F, x * + int d = not_a_day; // c, d, D, e, F, x * + int j = not_a_doy; // j * + int wd = not_a_weekday; // a, A, u, w * + int H = not_a_hour; // c, H, R, T, X * + int I = not_a_hour_12_value; // I, r * + int p = not_a_ampm; // p, r * + int M = not_a_minute; // c, M, r, R, T, X * + Duration s = not_a_second; // c, r, S, T, X * + int U = not_a_week_num; // U * + int V = not_a_week_num; // V * + int W = not_a_week_num; // W * + std::basic_string temp_abbrev; // Z * + minutes temp_offset = not_a_offset; // z * + + using detail::read; + using detail::rs; + using detail::ru; + using detail::rld; + using detail::checked_set; + for (; *fmt != CharT{} && !is.fail(); ++fmt) + { + switch (*fmt) + { + case 'a': + case 'A': + case 'u': + case 'w': // wd: a, A, u, w + if (command) + { + int trial_wd = not_a_weekday; + if (*fmt == 'a' || *fmt == 'A') + { + if (modified == CharT{}) + { +#if !ONLY_C_LOCALE + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + is.setstate(err); + if (!is.fail()) + trial_wd = tm.tm_wday; +#else + auto nm = detail::weekday_names(); + auto i = detail::scan_keyword(is, nm.first, nm.second) - nm.first; + if (!is.fail()) + trial_wd = i % 7; +#endif + } + else + read(is, CharT{'%'}, width, modified, *fmt); + } + else // *fmt == 'u' || *fmt == 'w' + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + read(is, ru{trial_wd, 1, width == -1 ? + 1u : static_cast(width)}); + if (!is.fail()) + { + if (*fmt == 'u') + { + if (!(1 <= trial_wd && trial_wd <= 7)) + { + trial_wd = not_a_weekday; + is.setstate(ios::failbit); + } + else if (trial_wd == 7) + trial_wd = 0; + } + else // *fmt == 'w' + { + if (!(0 <= trial_wd && trial_wd <= 6)) + { + trial_wd = not_a_weekday; + is.setstate(ios::failbit); + } + } + } + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + is.setstate(err); + if (!is.fail()) + trial_wd = tm.tm_wday; + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + } + if (trial_wd != not_a_weekday) + checked_set(wd, trial_wd, not_a_weekday, is); + } + else // !command + read(is, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + break; + case 'b': + case 'B': + case 'h': + if (command) + { + if (modified == CharT{}) + { + int ttm = not_a_month; +#if !ONLY_C_LOCALE + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + ttm = tm.tm_mon + 1; + is.setstate(err); +#else + auto nm = detail::month_names(); + auto i = detail::scan_keyword(is, nm.first, nm.second) - nm.first; + if (!is.fail()) + ttm = i % 12 + 1; +#endif + checked_set(m, ttm, not_a_month, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'c': + if (command) + { + if (modified != CharT{'O'}) + { +#if !ONLY_C_LOCALE + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + { + checked_set(Y, tm.tm_year + 1900, not_a_year, is); + checked_set(m, tm.tm_mon + 1, not_a_month, is); + checked_set(d, tm.tm_mday, not_a_day, is); + checked_set(H, tm.tm_hour, not_a_hour, is); + checked_set(M, tm.tm_min, not_a_minute, is); + checked_set(s, duration_cast(seconds{tm.tm_sec}), + not_a_second, is); + } + is.setstate(err); +#else + // "%a %b %e %T %Y" + auto nm = detail::weekday_names(); + auto i = detail::scan_keyword(is, nm.first, nm.second) - nm.first; + checked_set(wd, static_cast(i % 7), not_a_weekday, is); + ws(is); + nm = detail::month_names(); + i = detail::scan_keyword(is, nm.first, nm.second) - nm.first; + checked_set(m, static_cast(i % 12 + 1), not_a_month, is); + ws(is); + int td = not_a_day; + read(is, rs{td, 1, 2}); + checked_set(d, td, not_a_day, is); + ws(is); + using dfs = detail::decimal_format_seconds; + CONSTDATA auto w = Duration::period::den == 1 ? 2 : 3 + dfs::width; + int tH; + int tM; + long double S{}; + read(is, ru{tH, 1, 2}, CharT{':'}, ru{tM, 1, 2}, + CharT{':'}, rld{S, 1, w}); + checked_set(H, tH, not_a_hour, is); + checked_set(M, tM, not_a_minute, is); + checked_set(s, round_i(duration{S}), + not_a_second, is); + ws(is); + int tY = not_a_year; + read(is, rs{tY, 1, 4u}); + checked_set(Y, tY, not_a_year, is); +#endif + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'x': + if (command) + { + if (modified != CharT{'O'}) + { +#if !ONLY_C_LOCALE + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + { + checked_set(Y, tm.tm_year + 1900, not_a_year, is); + checked_set(m, tm.tm_mon + 1, not_a_month, is); + checked_set(d, tm.tm_mday, not_a_day, is); + } + is.setstate(err); +#else + // "%m/%d/%y" + int ty = not_a_2digit_year; + int tm = not_a_month; + int td = not_a_day; + read(is, ru{tm, 1, 2}, CharT{'/'}, ru{td, 1, 2}, CharT{'/'}, + rs{ty, 1, 2}); + checked_set(y, ty, not_a_2digit_year, is); + checked_set(m, tm, not_a_month, is); + checked_set(d, td, not_a_day, is); +#endif + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'X': + if (command) + { + if (modified != CharT{'O'}) + { +#if !ONLY_C_LOCALE + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + { + checked_set(H, tm.tm_hour, not_a_hour, is); + checked_set(M, tm.tm_min, not_a_minute, is); + checked_set(s, duration_cast(seconds{tm.tm_sec}), + not_a_second, is); + } + is.setstate(err); +#else + // "%T" + using dfs = detail::decimal_format_seconds; + CONSTDATA auto w = Duration::period::den == 1 ? 2 : 3 + dfs::width; + int tH = not_a_hour; + int tM = not_a_minute; + long double S{}; + read(is, ru{tH, 1, 2}, CharT{':'}, ru{tM, 1, 2}, + CharT{':'}, rld{S, 1, w}); + checked_set(H, tH, not_a_hour, is); + checked_set(M, tM, not_a_minute, is); + checked_set(s, round_i(duration{S}), + not_a_second, is); +#endif + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'C': + if (command) + { + int tC = not_a_century; +#if !ONLY_C_LOCALE + if (modified == CharT{}) + { +#endif + read(is, rs{tC, 1, width == -1 ? 2u : static_cast(width)}); +#if !ONLY_C_LOCALE + } + else + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + { + auto tY = tm.tm_year + 1900; + tC = (tY >= 0 ? tY : tY-99) / 100; + } + is.setstate(err); + } +#endif + checked_set(C, tC, not_a_century, is); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'D': + if (command) + { + if (modified == CharT{}) + { + int tn = not_a_month; + int td = not_a_day; + int ty = not_a_2digit_year; + read(is, ru{tn, 1, 2}, CharT{'\0'}, CharT{'/'}, CharT{'\0'}, + ru{td, 1, 2}, CharT{'\0'}, CharT{'/'}, CharT{'\0'}, + rs{ty, 1, 2}); + checked_set(y, ty, not_a_2digit_year, is); + checked_set(m, tn, not_a_month, is); + checked_set(d, td, not_a_day, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'F': + if (command) + { + if (modified == CharT{}) + { + int tY = not_a_year; + int tn = not_a_month; + int td = not_a_day; + read(is, rs{tY, 1, width == -1 ? 4u : static_cast(width)}, + CharT{'-'}, ru{tn, 1, 2}, CharT{'-'}, ru{td, 1, 2}); + checked_set(Y, tY, not_a_year, is); + checked_set(m, tn, not_a_month, is); + checked_set(d, td, not_a_day, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'd': + case 'e': + if (command) + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + int td = not_a_day; + read(is, rs{td, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(d, td, not_a_day, is); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + command = nullptr; + width = -1; + modified = CharT{}; + if ((err & ios::failbit) == 0) + checked_set(d, tm.tm_mday, not_a_day, is); + is.setstate(err); + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'H': + if (command) + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + int tH = not_a_hour; + read(is, ru{tH, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(H, tH, not_a_hour, is); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + checked_set(H, tm.tm_hour, not_a_hour, is); + is.setstate(err); + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'I': + if (command) + { + if (modified == CharT{}) + { + int tI = not_a_hour_12_value; + // reads in an hour into I, but most be in [1, 12] + read(is, rs{tI, 1, width == -1 ? 2u : static_cast(width)}); + if (!(1 <= tI && tI <= 12)) + is.setstate(ios::failbit); + checked_set(I, tI, not_a_hour_12_value, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'j': + if (command) + { + if (modified == CharT{}) + { + int tj = not_a_doy; + read(is, ru{tj, 1, width == -1 ? 3u : static_cast(width)}); + checked_set(j, tj, not_a_doy, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'M': + if (command) + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + int tM = not_a_minute; + read(is, ru{tM, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(M, tM, not_a_minute, is); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + checked_set(M, tm.tm_min, not_a_minute, is); + is.setstate(err); + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'm': + if (command) + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + int tn = not_a_month; + read(is, rs{tn, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(m, tn, not_a_month, is); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + checked_set(m, tm.tm_mon + 1, not_a_month, is); + is.setstate(err); + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'n': + case 't': + if (command) + { + if (modified == CharT{}) + { + // %n matches a single white space character + // %t matches 0 or 1 white space characters + auto ic = is.peek(); + if (Traits::eq_int_type(ic, Traits::eof())) + { + ios::iostate err = ios::eofbit; + if (*fmt == 'n') + err |= ios::failbit; + is.setstate(err); + break; + } + if (isspace(ic)) + { + (void)is.get(); + } + else if (*fmt == 'n') + is.setstate(ios::failbit); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'p': + if (command) + { + if (modified == CharT{}) + { + int tp = not_a_ampm; +#if !ONLY_C_LOCALE + tm = std::tm{}; + tm.tm_hour = 1; + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + is.setstate(err); + if (tm.tm_hour == 1) + tp = 0; + else if (tm.tm_hour == 13) + tp = 1; + else + is.setstate(err); +#else + auto nm = detail::ampm_names(); + auto i = detail::scan_keyword(is, nm.first, nm.second) - nm.first; + tp = static_cast(i); +#endif + checked_set(p, tp, not_a_ampm, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + + break; + case 'r': + if (command) + { + if (modified == CharT{}) + { +#if !ONLY_C_LOCALE + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + { + checked_set(H, tm.tm_hour, not_a_hour, is); + checked_set(M, tm.tm_min, not_a_hour, is); + checked_set(s, duration_cast(seconds{tm.tm_sec}), + not_a_second, is); + } + is.setstate(err); +#else + // "%I:%M:%S %p" + using dfs = detail::decimal_format_seconds; + CONSTDATA auto w = Duration::period::den == 1 ? 2 : 3 + dfs::width; + long double S{}; + int tI = not_a_hour_12_value; + int tM = not_a_minute; + read(is, ru{tI, 1, 2}, CharT{':'}, ru{tM, 1, 2}, + CharT{':'}, rld{S, 1, w}); + checked_set(I, tI, not_a_hour_12_value, is); + checked_set(M, tM, not_a_minute, is); + checked_set(s, round_i(duration{S}), + not_a_second, is); + ws(is); + auto nm = detail::ampm_names(); + auto i = detail::scan_keyword(is, nm.first, nm.second) - nm.first; + checked_set(p, static_cast(i), not_a_ampm, is); +#endif + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'R': + if (command) + { + if (modified == CharT{}) + { + int tH = not_a_hour; + int tM = not_a_minute; + read(is, ru{tH, 1, 2}, CharT{'\0'}, CharT{':'}, CharT{'\0'}, + ru{tM, 1, 2}, CharT{'\0'}); + checked_set(H, tH, not_a_hour, is); + checked_set(M, tM, not_a_minute, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'S': + if (command) + { + #if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'E'}) +#endif + { + using dfs = detail::decimal_format_seconds; + CONSTDATA auto w = Duration::period::den == 1 ? 2 : 3 + dfs::width; + long double S{}; + read(is, rld{S, 1, width == -1 ? w : static_cast(width)}); + checked_set(s, round_i(duration{S}), + not_a_second, is); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'O'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + checked_set(s, duration_cast(seconds{tm.tm_sec}), + not_a_second, is); + is.setstate(err); + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'T': + if (command) + { + if (modified == CharT{}) + { + using dfs = detail::decimal_format_seconds; + CONSTDATA auto w = Duration::period::den == 1 ? 2 : 3 + dfs::width; + int tH = not_a_hour; + int tM = not_a_minute; + long double S{}; + read(is, ru{tH, 1, 2}, CharT{':'}, ru{tM, 1, 2}, + CharT{':'}, rld{S, 1, w}); + checked_set(H, tH, not_a_hour, is); + checked_set(M, tM, not_a_minute, is); + checked_set(s, round_i(duration{S}), + not_a_second, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'Y': + if (command) + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#else + if (modified != CharT{'O'}) +#endif + { + int tY = not_a_year; + read(is, rs{tY, 1, width == -1 ? 4u : static_cast(width)}); + checked_set(Y, tY, not_a_year, is); + } +#if !ONLY_C_LOCALE + else if (modified == CharT{'E'}) + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + checked_set(Y, tm.tm_year + 1900, not_a_year, is); + is.setstate(err); + } +#endif + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'y': + if (command) + { +#if !ONLY_C_LOCALE + if (modified == CharT{}) +#endif + { + int ty = not_a_2digit_year; + read(is, ru{ty, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(y, ty, not_a_2digit_year, is); + } +#if !ONLY_C_LOCALE + else + { + ios::iostate err = ios::goodbit; + f.get(is, nullptr, is, err, &tm, command, fmt+1); + if ((err & ios::failbit) == 0) + checked_set(Y, tm.tm_year + 1900, not_a_year, is); + is.setstate(err); + } +#endif + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'g': + if (command) + { + if (modified == CharT{}) + { + int tg = not_a_2digit_year; + read(is, ru{tg, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(g, tg, not_a_2digit_year, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'G': + if (command) + { + if (modified == CharT{}) + { + int tG = not_a_year; + read(is, rs{tG, 1, width == -1 ? 4u : static_cast(width)}); + checked_set(G, tG, not_a_year, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'U': + if (command) + { + if (modified == CharT{}) + { + int tU = not_a_week_num; + read(is, ru{tU, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(U, tU, not_a_week_num, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'V': + if (command) + { + if (modified == CharT{}) + { + int tV = not_a_week_num; + read(is, ru{tV, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(V, tV, not_a_week_num, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'W': + if (command) + { + if (modified == CharT{}) + { + int tW = not_a_week_num; + read(is, ru{tW, 1, width == -1 ? 2u : static_cast(width)}); + checked_set(W, tW, not_a_week_num, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'E': + case 'O': + if (command) + { + if (modified == CharT{}) + { + modified = *fmt; + } + else + { + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + } + else + read(is, *fmt); + break; + case '%': + if (command) + { + if (modified == CharT{}) + read(is, *fmt); + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + command = fmt; + break; + case 'z': + if (command) + { + int tH, tM; + minutes toff = not_a_offset; + bool neg = false; + auto ic = is.peek(); + if (!Traits::eq_int_type(ic, Traits::eof())) + { + auto c = static_cast(Traits::to_char_type(ic)); + if (c == '-') + neg = true; + } + if (modified == CharT{}) + { + read(is, rs{tH, 2, 2}); + if (!is.fail()) + toff = hours{std::abs(tH)}; + if (is.good()) + { + ic = is.peek(); + if (!Traits::eq_int_type(ic, Traits::eof())) + { + auto c = static_cast(Traits::to_char_type(ic)); + if ('0' <= c && c <= '9') + { + read(is, ru{tM, 2, 2}); + if (!is.fail()) + toff += minutes{tM}; + } + } + } + } + else + { + read(is, rs{tH, 1, 2}); + if (!is.fail()) + toff = hours{std::abs(tH)}; + if (is.good()) + { + ic = is.peek(); + if (!Traits::eq_int_type(ic, Traits::eof())) + { + auto c = static_cast(Traits::to_char_type(ic)); + if (c == ':') + { + (void)is.get(); + read(is, ru{tM, 2, 2}); + if (!is.fail()) + toff += minutes{tM}; + } + } + } + } + if (neg) + toff = -toff; + checked_set(temp_offset, toff, not_a_offset, is); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + case 'Z': + if (command) + { + if (modified == CharT{}) + { + std::basic_string buf; + while (is.rdstate() == std::ios::goodbit) + { + auto i = is.rdbuf()->sgetc(); + if (Traits::eq_int_type(i, Traits::eof())) + { + is.setstate(ios::eofbit); + break; + } + auto wc = Traits::to_char_type(i); + auto c = static_cast(wc); + // is c a valid time zone name or abbreviation character? + if (!(CharT{1} < wc && wc < CharT{127}) || !(isalnum(c) || + c == '_' || c == '/' || c == '-' || c == '+')) + break; + buf.push_back(c); + is.rdbuf()->sbumpc(); + } + if (buf.empty()) + is.setstate(ios::failbit); + checked_set(temp_abbrev, buf, {}, is); + } + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + else + read(is, *fmt); + break; + default: + if (command) + { + if (width == -1 && modified == CharT{} && '0' <= *fmt && *fmt <= '9') + { + width = static_cast(*fmt) - '0'; + while ('0' <= fmt[1] && fmt[1] <= '9') + width = 10*width + static_cast(*++fmt) - '0'; + } + else + { + if (modified == CharT{}) + read(is, CharT{'%'}, width, *fmt); + else + read(is, CharT{'%'}, width, modified, *fmt); + command = nullptr; + width = -1; + modified = CharT{}; + } + } + else // !command + { + if (isspace(static_cast(*fmt))) + { + // space matches 0 or more white space characters + if (is.good()) + ws(is); + } + else + read(is, *fmt); + } + break; + } + } + // is.fail() || *fmt == CharT{} + if (is.rdstate() == ios::goodbit && command) + { + if (modified == CharT{}) + read(is, CharT{'%'}, width); + else + read(is, CharT{'%'}, width, modified); + } + if (!is.fail()) + { + if (y != not_a_2digit_year) + { + // Convert y and an optional C to Y + if (!(0 <= y && y <= 99)) + goto broken; + if (C == not_a_century) + { + if (Y == not_a_year) + { + if (y >= 69) + C = 19; + else + C = 20; + } + else + { + C = (Y >= 0 ? Y : Y-100) / 100; + } + } + int tY; + if (C >= 0) + tY = 100*C + y; + else + tY = 100*(C+1) - (y == 0 ? 100 : y); + if (Y != not_a_year && Y != tY) + goto broken; + Y = tY; + } + if (g != not_a_2digit_year) + { + // Convert g and an optional C to G + if (!(0 <= g && g <= 99)) + goto broken; + if (C == not_a_century) + { + if (G == not_a_year) + { + if (g >= 69) + C = 19; + else + C = 20; + } + else + { + C = (G >= 0 ? G : G-100) / 100; + } + } + int tG; + if (C >= 0) + tG = 100*C + g; + else + tG = 100*(C+1) - (g == 0 ? 100 : g); + if (G != not_a_year && G != tG) + goto broken; + G = tG; + } + if (Y < static_cast(year::min()) || Y > static_cast(year::max())) + Y = not_a_year; + bool computed = false; + if (G != not_a_year && V != not_a_week_num && wd != not_a_weekday) + { + year_month_day ymd_trial = sys_days(year{G-1}/December/Thursday[last]) + + (Monday-Thursday) + weeks{V-1} + + (weekday{static_cast(wd)}-Monday); + if (Y == not_a_year) + Y = static_cast(ymd_trial.year()); + else if (year{Y} != ymd_trial.year()) + goto broken; + if (m == not_a_month) + m = static_cast(static_cast(ymd_trial.month())); + else if (month(static_cast(m)) != ymd_trial.month()) + goto broken; + if (d == not_a_day) + d = static_cast(static_cast(ymd_trial.day())); + else if (day(static_cast(d)) != ymd_trial.day()) + goto broken; + computed = true; + } + if (Y != not_a_year && U != not_a_week_num && wd != not_a_weekday) + { + year_month_day ymd_trial = sys_days(year{Y}/January/Sunday[1]) + + weeks{U-1} + + (weekday{static_cast(wd)} - Sunday); + if (Y == not_a_year) + Y = static_cast(ymd_trial.year()); + else if (year{Y} != ymd_trial.year()) + goto broken; + if (m == not_a_month) + m = static_cast(static_cast(ymd_trial.month())); + else if (month(static_cast(m)) != ymd_trial.month()) + goto broken; + if (d == not_a_day) + d = static_cast(static_cast(ymd_trial.day())); + else if (day(static_cast(d)) != ymd_trial.day()) + goto broken; + computed = true; + } + if (Y != not_a_year && W != not_a_week_num && wd != not_a_weekday) + { + year_month_day ymd_trial = sys_days(year{Y}/January/Monday[1]) + + weeks{W-1} + + (weekday{static_cast(wd)} - Monday); + if (Y == not_a_year) + Y = static_cast(ymd_trial.year()); + else if (year{Y} != ymd_trial.year()) + goto broken; + if (m == not_a_month) + m = static_cast(static_cast(ymd_trial.month())); + else if (month(static_cast(m)) != ymd_trial.month()) + goto broken; + if (d == not_a_day) + d = static_cast(static_cast(ymd_trial.day())); + else if (day(static_cast(d)) != ymd_trial.day()) + goto broken; + computed = true; + } + if (j != not_a_doy && Y != not_a_year) + { + auto ymd_trial = year_month_day{local_days(year{Y}/1/1) + days{j-1}}; + if (m == not_a_month) + m = static_cast(static_cast(ymd_trial.month())); + else if (month(static_cast(m)) != ymd_trial.month()) + goto broken; + if (d == not_a_day) + d = static_cast(static_cast(ymd_trial.day())); + else if (day(static_cast(d)) != ymd_trial.day()) + goto broken; + j = not_a_doy; + } + auto ymd = year{Y}/m/d; + if (ymd.ok()) + { + if (wd == not_a_weekday) + wd = static_cast((weekday(sys_days(ymd)) - Sunday).count()); + else if (wd != static_cast((weekday(sys_days(ymd)) - Sunday).count())) + goto broken; + if (!computed) + { + if (G != not_a_year || V != not_a_week_num) + { + sys_days sd = ymd; + auto G_trial = year_month_day{sd + days{3}}.year(); + auto start = sys_days((G_trial - years{1})/December/Thursday[last]) + + (Monday - Thursday); + if (sd < start) + { + --G_trial; + if (V != not_a_week_num) + start = sys_days((G_trial - years{1})/December/Thursday[last]) + + (Monday - Thursday); + } + if (G != not_a_year && G != static_cast(G_trial)) + goto broken; + if (V != not_a_week_num) + { + auto V_trial = duration_cast(sd - start).count() + 1; + if (V != V_trial) + goto broken; + } + } + if (U != not_a_week_num) + { + auto start = sys_days(Sunday[1]/January/ymd.year()); + auto U_trial = floor(sys_days(ymd) - start).count() + 1; + if (U != U_trial) + goto broken; + } + if (W != not_a_week_num) + { + auto start = sys_days(Monday[1]/January/ymd.year()); + auto W_trial = floor(sys_days(ymd) - start).count() + 1; + if (W != W_trial) + goto broken; + } + } + } + fds.ymd = ymd; + if (I != not_a_hour_12_value) + { + if (!(1 <= I && I <= 12)) + goto broken; + if (p != not_a_ampm) + { + // p is in [0, 1] == [AM, PM] + // Store trial H in I + if (I == 12) + --p; + I += p*12; + // Either set H from I or make sure H and I are consistent + if (H == not_a_hour) + H = I; + else if (I != H) + goto broken; + } + else // p == not_a_ampm + { + // if H, make sure H and I could be consistent + if (H != not_a_hour) + { + if (I == 12) + { + if (H != 0 && H != 12) + goto broken; + } + else if (!(I == H || I == H+12)) + { + goto broken; + } + } + else // I is ambiguous, AM or PM? + goto broken; + } + } + if (H != not_a_hour) + { + fds.has_tod = true; + fds.tod = hh_mm_ss{hours{H}}; + } + if (M != not_a_minute) + { + fds.has_tod = true; + fds.tod.m_ = minutes{M}; + } + if (s != not_a_second) + { + fds.has_tod = true; + fds.tod.s_ = detail::decimal_format_seconds{s}; + } + if (j != not_a_doy) + { + fds.has_tod = true; + fds.tod.h_ += hours{days{j}}; + } + if (wd != not_a_weekday) + fds.wd = weekday{static_cast(wd)}; + if (abbrev != nullptr) + *abbrev = std::move(temp_abbrev); + if (offset != nullptr && temp_offset != not_a_offset) + *offset = temp_offset; + } + return is; + } +broken: + is.setstate(ios::failbit); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, year& y, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.year().ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + y = fds.ymd.year(); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, month& m, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.month().ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + m = fds.ymd.month(); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, day& d, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.day().ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + d = fds.ymd.day(); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, weekday& wd, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.wd.ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + wd = fds.wd; + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, year_month& ym, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.month().ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + ym = fds.ymd.year()/fds.ymd.month(); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, month_day& md, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.month().ok() || !fds.ymd.day().ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + md = fds.ymd.month()/fds.ymd.day(); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, + year_month_day& ymd, std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = std::chrono::seconds; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.ok()) + is.setstate(std::ios::failbit); + if (!is.fail()) + ymd = fds.ymd; + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, + sys_time& tp, std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = typename std::common_type::type; + using detail::round_i; + std::chrono::minutes offset_local{}; + auto offptr = offset ? offset : &offset_local; + fields fds{}; + fds.has_tod = true; + date::from_stream(is, fmt, fds, abbrev, offptr); + if (!fds.ymd.ok() || !fds.tod.in_conventional_range()) + is.setstate(std::ios::failbit); + if (!is.fail()) + tp = round_i(sys_days(fds.ymd) - *offptr + fds.tod.to_duration()); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, + local_time& tp, std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using CT = typename std::common_type::type; + using detail::round_i; + fields fds{}; + fds.has_tod = true; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.ymd.ok() || !fds.tod.in_conventional_range()) + is.setstate(std::ios::failbit); + if (!is.fail()) + tp = round_i(local_seconds{local_days(fds.ymd)} + fds.tod.to_duration()); + return is; +} + +template > +std::basic_istream& +from_stream(std::basic_istream& is, const CharT* fmt, + std::chrono::duration& d, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) +{ + using Duration = std::chrono::duration; + using CT = typename std::common_type::type; + using detail::round_i; + fields fds{}; + date::from_stream(is, fmt, fds, abbrev, offset); + if (!fds.has_tod) + is.setstate(std::ios::failbit); + if (!is.fail()) + d = round_i(fds.tod.to_duration()); + return is; +} + +template , + class Alloc = std::allocator> +struct parse_manip +{ + const std::basic_string format_; + Parsable& tp_; + std::basic_string* abbrev_; + std::chrono::minutes* offset_; + +public: + parse_manip(std::basic_string format, Parsable& tp, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) + : format_(std::move(format)) + , tp_(tp) + , abbrev_(abbrev) + , offset_(offset) + {} + +#if HAS_STRING_VIEW + parse_manip(const CharT* format, Parsable& tp, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) + : format_(format) + , tp_(tp) + , abbrev_(abbrev) + , offset_(offset) + {} + + parse_manip(std::basic_string_view format, Parsable& tp, + std::basic_string* abbrev = nullptr, + std::chrono::minutes* offset = nullptr) + : format_(format) + , tp_(tp) + , abbrev_(abbrev) + , offset_(offset) + {} +#endif // HAS_STRING_VIEW +}; + +template +std::basic_istream& +operator>>(std::basic_istream& is, + const parse_manip& x) +{ + return date::from_stream(is, x.format_.c_str(), x.tp_, x.abbrev_, x.offset_); +} + +template +inline +auto +parse(const std::basic_string& format, Parsable& tp) + -> decltype(date::from_stream(std::declval&>(), + format.c_str(), tp), + parse_manip{format, tp}) +{ + return {format, tp}; +} + +template +inline +auto +parse(const std::basic_string& format, Parsable& tp, + std::basic_string& abbrev) + -> decltype(date::from_stream(std::declval&>(), + format.c_str(), tp, &abbrev), + parse_manip{format, tp, &abbrev}) +{ + return {format, tp, &abbrev}; +} + +template +inline +auto +parse(const std::basic_string& format, Parsable& tp, + std::chrono::minutes& offset) + -> decltype(date::from_stream(std::declval&>(), + format.c_str(), tp, + std::declval*>(), + &offset), + parse_manip{format, tp, nullptr, &offset}) +{ + return {format, tp, nullptr, &offset}; +} + +template +inline +auto +parse(const std::basic_string& format, Parsable& tp, + std::basic_string& abbrev, std::chrono::minutes& offset) + -> decltype(date::from_stream(std::declval&>(), + format.c_str(), tp, &abbrev, &offset), + parse_manip{format, tp, &abbrev, &offset}) +{ + return {format, tp, &abbrev, &offset}; +} + +// const CharT* formats + +template +inline +auto +parse(const CharT* format, Parsable& tp) + -> decltype(date::from_stream(std::declval&>(), format, tp), + parse_manip{format, tp}) +{ + return {format, tp}; +} + +template +inline +auto +parse(const CharT* format, Parsable& tp, std::basic_string& abbrev) + -> decltype(date::from_stream(std::declval&>(), format, + tp, &abbrev), + parse_manip{format, tp, &abbrev}) +{ + return {format, tp, &abbrev}; +} + +template +inline +auto +parse(const CharT* format, Parsable& tp, std::chrono::minutes& offset) + -> decltype(date::from_stream(std::declval&>(), format, + tp, std::declval*>(), &offset), + parse_manip{format, tp, nullptr, &offset}) +{ + return {format, tp, nullptr, &offset}; +} + +template +inline +auto +parse(const CharT* format, Parsable& tp, + std::basic_string& abbrev, std::chrono::minutes& offset) + -> decltype(date::from_stream(std::declval&>(), format, + tp, &abbrev, &offset), + parse_manip{format, tp, &abbrev, &offset}) +{ + return {format, tp, &abbrev, &offset}; +} + +// duration streaming + +template +inline +std::basic_ostream& +operator<<(std::basic_ostream& os, + const std::chrono::duration& d) +{ + return os << detail::make_string::from(d.count()) + + detail::get_units(typename Period::type{}); +} + +} // namespace date + +#ifdef _MSC_VER +# pragma warning(pop) +#endif + +#ifdef __GNUC__ +# pragma GCC diagnostic pop +#endif + +#endif // DATE_H diff --git a/wsjtx_lib/example/wave.cpp b/wsjtx_lib/example/wave.cpp new file mode 100644 index 0000000..c7c55be --- /dev/null +++ b/wsjtx_lib/example/wave.cpp @@ -0,0 +1,184 @@ +#include "wave.h" + +#include +#include +#include + +#include + +// Save signal in floating point format (-1 .. +1) as a WAVE file using 16-bit signed integers. +void save_wav(const float* signal, int num_samples, int sample_rate, const char* path) +{ + char subChunk1ID[4] = { 'f', 'm', 't', ' ' }; + uint32_t subChunk1Size = 16; // 16 for PCM + uint16_t audioFormat = 1; // PCM = 1 + uint16_t numChannels = 1; + uint16_t bitsPerSample = 16; + uint32_t sampleRate = sample_rate; + uint16_t blockAlign = numChannels * bitsPerSample / 8; + uint32_t byteRate = sampleRate * blockAlign; + + char subChunk2ID[4] = { 'd', 'a', 't', 'a' }; + uint32_t subChunk2Size = num_samples * blockAlign; + + char chunkID[4] = { 'R', 'I', 'F', 'F' }; + uint32_t chunkSize = 4 + (8 + subChunk1Size) + (8 + subChunk2Size); + char format[4] = { 'W', 'A', 'V', 'E' }; + + int16_t* raw_data = (int16_t*)malloc(num_samples * blockAlign); + for (int i = 0; i < num_samples; i++) + { + float x = signal[i]; + if (x > 1.0) + x = 1.0; + else if (x < -1.0) + x = -1.0; + raw_data[i] = (int)(0.5 + (x * 32767.0)); + } + + FILE* f = fopen(path, "wb"); + + // NOTE: works only on little-endian architecture + fwrite(chunkID, sizeof(chunkID), 1, f); + fwrite(&chunkSize, sizeof(chunkSize), 1, f); + fwrite(format, sizeof(format), 1, f); + + fwrite(subChunk1ID, sizeof(subChunk1ID), 1, f); + fwrite(&subChunk1Size, sizeof(subChunk1Size), 1, f); + fwrite(&audioFormat, sizeof(audioFormat), 1, f); + fwrite(&numChannels, sizeof(numChannels), 1, f); + fwrite(&sampleRate, sizeof(sampleRate), 1, f); + fwrite(&byteRate, sizeof(byteRate), 1, f); + fwrite(&blockAlign, sizeof(blockAlign), 1, f); + fwrite(&bitsPerSample, sizeof(bitsPerSample), 1, f); + + fwrite(subChunk2ID, sizeof(subChunk2ID), 1, f); + fwrite(&subChunk2Size, sizeof(subChunk2Size), 1, f); + + fwrite(raw_data, blockAlign, num_samples, f); + + fclose(f); + + free(raw_data); +} + +// Load signal in floating point format (-1 .. +1) as a WAVE file using 16-bit signed integers. +int load_wav(float* signal, int* num_samples, int* sample_rate, const char* path) +{ + char subChunk1ID[4]; // = {'f', 'm', 't', ' '}; + uint32_t subChunk1Size; // = 16; // 16 for PCM + uint16_t audioFormat; // = 1; // PCM = 1 + uint16_t numChannels; // = 1; + uint16_t bitsPerSample; // = 16; + uint32_t sampleRate; + uint16_t blockAlign; // = numChannels * bitsPerSample / 8; + uint32_t byteRate; // = sampleRate * blockAlign; + + char subChunk2ID[4]; // = {'d', 'a', 't', 'a'}; + uint32_t subChunk2Size; // = num_samples * blockAlign; + + char chunkID[4]; // = {'R', 'I', 'F', 'F'}; + uint32_t chunkSize; // = 4 + (8 + subChunk1Size) + (8 + subChunk2Size); + char format[4]; // = {'W', 'A', 'V', 'E'}; + + FILE* f = fopen(path, "rb"); + + // NOTE: works only on little-endian architecture + fread((void*)chunkID, sizeof(chunkID), 1, f); + fread((void*)&chunkSize, sizeof(chunkSize), 1, f); + fread((void*)format, sizeof(format), 1, f); + + fread((void*)subChunk1ID, sizeof(subChunk1ID), 1, f); + fread((void*)&subChunk1Size, sizeof(subChunk1Size), 1, f); + if (subChunk1Size != 16) + return -1; + + fread((void*)&audioFormat, sizeof(audioFormat), 1, f); + fread((void*)&numChannels, sizeof(numChannels), 1, f); + fread((void*)&sampleRate, sizeof(sampleRate), 1, f); + fread((void*)&byteRate, sizeof(byteRate), 1, f); + fread((void*)&blockAlign, sizeof(blockAlign), 1, f); + fread((void*)&bitsPerSample, sizeof(bitsPerSample), 1, f); + + if (audioFormat != 1 || numChannels != 1 || bitsPerSample != 16) + return -1; + + fread((void*)subChunk2ID, sizeof(subChunk2ID), 1, f); + fread((void*)&subChunk2Size, sizeof(subChunk2Size), 1, f); + + if (subChunk2Size / blockAlign > *num_samples) + return -2; + + *num_samples = subChunk2Size / blockAlign; + *sample_rate = sampleRate; + + int16_t* raw_data = (int16_t*)malloc(*num_samples * blockAlign); + + fread((void*)raw_data, blockAlign, *num_samples, f); + for (int i = 0; i < *num_samples; i++) + { + signal[i] = raw_data[i] / 32768.0f; + } + + free(raw_data); + + fclose(f); + + return 0; +} + +int load_wav_int(short int *signal, int *num_samples, int *sample_rate, const char *path) +{ + char subChunk1ID[4]; // = {'f', 'm', 't', ' '}; + uint32_t subChunk1Size; // = 16; // 16 for PCM + uint16_t audioFormat; // = 1; // PCM = 1 + uint16_t numChannels; // = 1; + uint16_t bitsPerSample; // = 16; + uint32_t sampleRate; + uint16_t blockAlign; // = numChannels * bitsPerSample / 8; + uint32_t byteRate; // = sampleRate * blockAlign; + + char subChunk2ID[4]; // = {'d', 'a', 't', 'a'}; + uint32_t subChunk2Size; // = num_samples * blockAlign; + + char chunkID[4]; // = {'R', 'I', 'F', 'F'}; + uint32_t chunkSize; // = 4 + (8 + subChunk1Size) + (8 + subChunk2Size); + char format[4]; // = {'W', 'A', 'V', 'E'}; + + FILE *f = fopen(path, "rb"); + + // NOTE: works only on little-endian architecture + fread((void *)chunkID, sizeof(chunkID), 1, f); + fread((void *)&chunkSize, sizeof(chunkSize), 1, f); + fread((void *)format, sizeof(format), 1, f); + + fread((void *)subChunk1ID, sizeof(subChunk1ID), 1, f); + fread((void *)&subChunk1Size, sizeof(subChunk1Size), 1, f); + if (subChunk1Size != 16) + return -1; + + fread((void *)&audioFormat, sizeof(audioFormat), 1, f); + fread((void *)&numChannels, sizeof(numChannels), 1, f); + fread((void *)&sampleRate, sizeof(sampleRate), 1, f); + fread((void *)&byteRate, sizeof(byteRate), 1, f); + fread((void *)&blockAlign, sizeof(blockAlign), 1, f); + fread((void *)&bitsPerSample, sizeof(bitsPerSample), 1, f); + + if (audioFormat != 1 || numChannels != 1 || bitsPerSample != 16) + return -1; + + fread((void *)subChunk2ID, sizeof(subChunk2ID), 1, f); + fread((void *)&subChunk2Size, sizeof(subChunk2Size), 1, f); + + if (subChunk2Size / blockAlign > *num_samples) + return -2; + + *num_samples = subChunk2Size / blockAlign; + *sample_rate = sampleRate; + + printf("Number of samples %d\n", subChunk2Size / blockAlign); + fread((void *)signal, blockAlign, *num_samples, f); + fclose(f); + + return 0; +} \ No newline at end of file diff --git a/wsjtx_lib/example/wave.h b/wsjtx_lib/example/wave.h new file mode 100644 index 0000000..535c0ae --- /dev/null +++ b/wsjtx_lib/example/wave.h @@ -0,0 +1,11 @@ +#ifndef _INCLUDE_WAVE_H_ +#define _INCLUDE_WAVE_H_ + +// Save signal in floating point format (-1 .. +1) as a WAVE file using 16-bit signed integers. +void save_wav(const float* signal, int num_samples, int sample_rate, const char* path); + +// Load signal in floating point format (-1 .. +1) as a WAVE file using 16-bit signed integers. +int load_wav(float* signal, int* num_samples, int* sample_rate, const char* path); + +int load_wav_int(short int *signal, int *num_samples, int *sample_rate, const char *path); +#endif // _INCLUDE_WAVE_H_ diff --git a/wsjtx_lib/example/wsjtx_test.cpp b/wsjtx_lib/example/wsjtx_test.cpp new file mode 100644 index 0000000..f12869a --- /dev/null +++ b/wsjtx_lib/example/wsjtx_test.cpp @@ -0,0 +1,232 @@ +#include +#include "wave.h" +#include +#include +#include +#include +#include "date.h" + +using namespace std; + +IntWsjTxVector audioSignal; +WsjtxIQSampleVector iqdat; + +wsjtx_lib decoder; + +//*************************************************************************** +unsigned long readc2file(char *ptr_to_infile, WsjtxIQSampleVector &iqdat, + double *freq, int *wspr_type) +{ + float *buffer; + double dfreq; + int i, ntrmin; + char c2file[15]; + size_t nr; + FILE *fp; + + iqdat.clear(); + iqdat.resize(45000); + fp = fopen(ptr_to_infile, "rb"); + if (fp == NULL) + { + fprintf(stderr, "Cannot open data file '%s'\n", ptr_to_infile); + return 1; + } + nr = fread(c2file, sizeof(char), 14, fp); + nr = fread(&ntrmin, sizeof(int), 1, fp); + nr = fread(&dfreq, sizeof(double), 1, fp); + *freq = dfreq; + + nr = fread(iqdat.data(), sizeof(float), 2 * 45000, fp); + fclose(fp); + + *wspr_type = ntrmin; + + for (i = 0; i < 45000; i++) + { + iqdat[i].imag(iqdat[i].imag() * -1.0); + } + + + if (nr == 2 * 45000) + { + return (unsigned long)nr / 2; + } + else + { + return 1; + } +} + +// Possible PATIENCE options: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, +// FFTW_MEASURE, FFTW_PATIENT, FFTW_EXHAUSTIVE +#define PATIENCE FFTW_ESTIMATE +fftwf_plan PLAN1, PLAN2, PLAN3; + +//*************************************************************************** +unsigned long readwavfile(char *ptr_to_infile, int ntrmin, WsjtxIQSampleVector &iqdat) +{ + size_t i, j, npoints, nr; + int nfft1, nfft2, nh2, i0; + double df; + + nfft2 = 46080; //this is the number of downsampled points that will be returned + nh2 = nfft2 / 2; + + if (ntrmin == 2) + { + nfft1 = nfft2 * 32; //need to downsample by a factor of 32 + df = 12000.0 / nfft1; + i0 = 1500.0 / df + 0.5; + npoints = 114 * 12000; + } + else if (ntrmin == 15) + { + nfft1 = nfft2 * 8 * 32; + df = 12000.0 / nfft1; + i0 = (1500.0 + 112.5) / df + 0.5; + npoints = 8 * 114 * 12000; + } + else + { + fprintf(stderr, "This should not happen\n"); + return 1; + } + + float *realin; + fftwf_complex *fftin, *fftout; + + FILE *fp; + short int *buf2; + + fp = fopen(ptr_to_infile, "rb"); + if (fp == NULL) + { + fprintf(stderr, "Cannot open data file '%s'\n", ptr_to_infile); + return 1; + } + + buf2 = (short int *)calloc(npoints, sizeof(short int)); + nr = fread(buf2, 2, 22, fp); //Read and ignore header + nr = fread(buf2, 2, npoints, fp); //Read raw data + fclose(fp); + if (nr == 0) + { + fprintf(stderr, "No data in file '%s'\n", ptr_to_infile); + return 1; + } + + realin = (float *)fftwf_malloc(sizeof(float) * nfft1); + fftout = (fftwf_complex *)fftwf_malloc(sizeof(fftwf_complex) * (nfft1 / 2 + 1)); + PLAN1 = fftwf_plan_dft_r2c_1d(nfft1, realin, fftout, PATIENCE); + + for (i = 0; i < npoints; i++) + { + realin[i] = buf2[i] / 32768.0; + } + + for (i = npoints; i < (size_t)nfft1; i++) + { + realin[i] = 0.0; + } + free(buf2); + + fftwf_execute(PLAN1); + fftwf_free(realin); + + fftin = (fftwf_complex *)fftwf_malloc(sizeof(fftwf_complex) * nfft2); + + for (i = 0; i < (size_t)nfft2; i++) + { + j = i0 + i; + if (i > (size_t)nh2) + j = j - nfft2; + fftin[i][0] = fftout[j][0]; + fftin[i][1] = fftout[j][1]; + } + + fftwf_free(fftout); + fftout = (fftwf_complex *)fftwf_malloc(sizeof(fftwf_complex) * nfft2); + PLAN2 = fftwf_plan_dft_1d(nfft2, fftin, fftout, FFTW_BACKWARD, PATIENCE); + fftwf_execute(PLAN2); + + for (i = 0; i < (size_t)nfft2; i++) + { + complex iq; + iq.real(fftout[i][0] / 1000.0); + iq.imag(fftout[i][1] / 1000.0); + iqdat.push_back(iq); + } + + fftwf_free(fftin); + fftwf_free(fftout); + return nfft2; +} + + +int main(int argc, char *argv[]) +{ + auto startTime = std::chrono::high_resolution_clock::now(); + auto today = date::floor(startTime); + + int num_samples = 15 * 48000; + int sample_rate = 48000; + WsjtxMessage msg; + + audioSignal.resize(15 * 48000 * 2); + for (int i =0 ; i < 2; i++) + { + num_samples = 15 * 48000; + load_wav_int((short int *)audioSignal.data(), &num_samples, &sample_rate, "/home/pi/samples/FT8/210703_133430.wav"); + decoder.decode(FT8, audioSignal, 1000, 4); + load_wav_int((short int *)audioSignal.data(), &num_samples, &sample_rate, "/home/pi/samples/FT4/000000_000002.wav"); + decoder.decode(FT4, audioSignal, 1000, 4); + while (decoder.pullMessage(msg)) + { + printf("hh %d min %d s %d, snr %d dt %f, freq %d, message %s, \n",msg.hh, + msg.min, + msg.sec, + msg.snr, + msg.dt, + msg.freq, + msg.msg.c_str()); + } + } + + decoder_options options; + + double freq; + int wspr_type = 2; + char filestr[] = "./150426_0918.wav"; + std::vector results; + + unsigned int points = readwavfile(filestr, wspr_type,iqdat); + options.freq = 70000000; + strcpy(options.rcall, "PA0PHH"); + strcpy(options.rloc, "JO22"); + + //wspr_decode(iqdat, iqdat.size(), options, results, 4); + results = decoder.wspr_decode(iqdat, options); + printf("UTC dB DT Freq Drift Call dbm\n"); + auto now = std::chrono::system_clock::now(); + for (auto col : results) + { + + cout << date::make_time(now - today) << " "; + printf("%2.0f", col.snr); + cout << " "; + printf("%2.0f", col.dt); + cout << " "; + printf("%1.0f", col.freq); + cout << " "; + printf("%2.0f", col.drift); + cout << " "; + printf("%s", col.call); + cout << " "; + printf("%s", col.loc); + cout << " "; + printf("%s", col.pwr); + cout << "\n"; + } + return 0; +} \ No newline at end of file diff --git a/wsjtx_lib/fortran_interface.h b/wsjtx_lib/fortran_interface.h new file mode 100644 index 0000000..5ad6433 --- /dev/null +++ b/wsjtx_lib/fortran_interface.h @@ -0,0 +1,116 @@ +#pragma once +#include + +#define NSMAX 6827 + +typedef size_t fortran_charlen_t; + +extern "C" { + +int wsjtx_libTest(); + +//----------------------------------------------------- C and Fortran routines +void symspec_(struct dec_data *, int *k, double *trperiod, int *nsps, int *ingain, + bool *bLowSidelobes, int *minw, float *px, float s[], float *df3, + int *nhsym, int *npts8, float *m_pxmax, int *npct); + +void hspec_(short int d2[], int *k, int *nutc0, int *ntrperiod, int *nrxfreq, int *ntol, + bool *bmsk144, bool *btrain, double const pcoeffs[], int *ingain, + char mycall[], char hiscall[], bool *bshmsg, bool *bswl, char ddir[], float green[], + float s[], int *jh, float *pxmax, float *rmsNoGain, char line[], + fortran_charlen_t, fortran_charlen_t, fortran_charlen_t, fortran_charlen_t); + +void genft8_(char *msg, int *i3, int *n3, char *msgsent, char ft8msgbits[], + int itone[], fortran_charlen_t, fortran_charlen_t); + +void genft4_(char *msg, int *ichk, char *msgsent, char ft4msgbits[], int itone[], + fortran_charlen_t, fortran_charlen_t); + +void genfst4_(char *msg, int *ichk, char *msgsent, char fst4msgbits[], + int itone[], int *iwspr, fortran_charlen_t, fortran_charlen_t); + +void gen_ft8wave_(int itone[], int *nsym, int *nsps, float *bt, float *fsample, float *f0, + float xjunk[], float wave[], int *icmplx, int *nwave); + +void gen_ft4wave_(int itone[], int *nsym, int *nsps, float *fsample, float *f0, + float xjunk[], float wave[], int *icmplx, int *nwave); + +void gen_fst4wave_(int itone[], int *nsym, int *nsps, int *nwave, float *fsample, + int *hmod, float *f0, int *icmplx, float xjunk[], float wave[]); + +void genwave_(int itone[], int *nsym, int *nsps, int *nwave, float *fsample, + int *hmod, float *f0, int *icmplx, float xjunk[], float wave[]); + +void gen4_(char *msg, int *ichk, char *msgsent, int itone[], + int *itext, fortran_charlen_t, fortran_charlen_t); + +void gen9_(char *msg, int *ichk, char *msgsent, int itone[], + int *itext, fortran_charlen_t, fortran_charlen_t); + +void genmsk_128_90_(char *msg, int *ichk, char *msgsent, int itone[], int *itype, + fortran_charlen_t, fortran_charlen_t); + +void gen65_(char *msg, int *ichk, char *msgsent, int itone[], + int *itext, fortran_charlen_t, fortran_charlen_t); + +void genq65_(char *msg, int *ichk, char *msgsent, int itone[], + int *i3, int *n3, fortran_charlen_t, fortran_charlen_t); + +void genwspr_(char *msg, char *msgsent, int itone[], fortran_charlen_t, fortran_charlen_t); + +void azdist_(char *MyGrid, char *HisGrid, double *utch, int *nAz, int *nEl, + int *nDmiles, int *nDkm, int *nHotAz, int *nHotABetter, + fortran_charlen_t, fortran_charlen_t); + +void morse_(char *msg, int *icw, int *ncw, fortran_charlen_t); + +int ptt_(int nport, int ntx, int *iptt, int *nopen); + +void wspr_downsample_(short int d2[], int *k); + +int savec2_(char *fname, int *TR_seconds, double *dial_freq, fortran_charlen_t); + +void avecho_(short id2[], int *dop, int *nfrit, int *nqual, float *f1, + float *level, float *sigdb, float *snr, float *dfreq, + float *width); + +void fast_decode_(short id2[], int narg[], double *trperiod, + char msg[], char mycall[], char hiscall[], + fortran_charlen_t, fortran_charlen_t, fortran_charlen_t); + +void mskrtd_(short int id2[], int *nutc0, float *tsec, int *ntol, + int *nrxfreq, int *ndepth, char mycall[], char hiscall[], + bool *bshmsg, bool *btrain, double pcoeffs[], bool *bswl, + char datadir[], char line[], + fortran_charlen_t, fortran_charlen_t, fortran_charlen_t, + fortran_charlen_t); + +void degrade_snr_(short d2[], int *n, float *db, float *bandwidth); + +void wav12_(short d2[], short d1[], int *nbytes, short *nbitsam2); + +void refspectrum_(short int d2[], bool *bclearrefspec, + bool *brefspec, bool *buseref, const char *c_fname, fortran_charlen_t); + +void freqcal_(short d2[], int *k, int *nkhz, int *noffset, int *ntol, + char line[], fortran_charlen_t); + +void fix_contest_msg_(char *MyGrid, char *msg, fortran_charlen_t, fortran_charlen_t); + +void calibrate_(char data_dir[], int *iz, double *a, double *b, double *rms, + double *sigmaa, double *sigmab, int *irc, fortran_charlen_t); + +void foxgen_(); + +void plotsave_(float swide[], int *m_w, int *m_h1, int *irow); + +void chkcall_(char *w, char *basc_call, bool cok, int len1, int len2); + +void get_ft4msg_(int *idecode, char *line, int len); + +void chk_samples_(int *m_ihsym, int *k, int *m_hsymStop); + +void __packjt77_MOD_unpack77(char *c77, int *nrx, char *msg, int *unpk77_success, fortran_charlen_t, fortran_charlen_t); +void __packjt77_MOD_pack77(char *msg, int *i3, int *n3, char *c77, fortran_charlen_t, fortran_charlen_t); +void multimode_decoder_(float *ss, short int *id2, params_t *p, int *nfsample); +} diff --git a/wsjtx_lib/lib/77bit/77bit.txt b/wsjtx_lib/lib/77bit/77bit.txt new file mode 100644 index 0000000..ae8f3dd --- /dev/null +++ b/wsjtx_lib/lib/77bit/77bit.txt @@ -0,0 +1,84 @@ +Starting with WSJT-X 2.0, the FT8 and MSK144 protocols convey a 77-bit +payload. For most purposes these bits are interpreted as 3 bits (i3) +for message type and 74 for user information. Any message type that +uses fewer than 74 information bits can assign the remaining bits to +define message subtypes. For example, Type i3=0 uses 71 information +bits and the remaining 3 bits, here called n3, define 8 possible +subtypes. + +---------------------------------------------------------------------------------- +i3.n3 Example message Bits Total Purpose +---------------------------------------------------------------------------------- +0.0 FREE TEXT MSG 71 71 Free text +0.1 K1ABC RR73; W9XYZ -12 28 28 10 5 71 DXpedition Mode +0.2 ... tbd +0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day +0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day +0.5 123456789ABCDEF012 71 71 Telemetry (18 hex) +0.6 Temporarily hijacked in packjt77 for WSPR-LF. This is not necessary! +0.7 ... tbd + +1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg +2 PA3XYZ/P GM4ABC/P R JO22 28 1 28 1 1 15 74 EU VHF contest +3 TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY Roundup +4 PJ4/KA1ABC RR73 12 58 1 2 1 74 Nonstandard calls +5 R 570007 JO22DB 12 22 1 3 11 25 74 EU VHF Contest +6 ... tbd +7 ... tbd +---------------------------------------------------------------------------------- +NB: three 74-bit message types and two 71-bit message subtypes are still TBD. +---------------------------------------------------------------------------------- + +The 28-bit fields normally used for callsigns are configured rather +differently from before. + +Facts about the 28-bit integers used to encode standard callsigns: + 2^28 = 268,435,456 Available values + 37*36*10*27*27*27 = 262,177,560 Used for standard callsigns + ----------- + 6,257,896 Difference + 2^22 = 4,194,304 Used for 22-bit hash codes + ----------- + 2,063,592 available for CQ, CQ nnn, CQ xxxx, QRZ, ... + + +Further details on message types: +----------------------------------------------------------------------------- +i3.n3 +----------------------------------------------------------------------------- +0.0 Free text, up to 13 characters. + +0.1 DXpedition mode, as developed for KH1/KH7Z. + +0.2 Report, QSO serial number from 0001 to 4095, 6-character grid, and Roger + for EU VHF contests. + +0.3 ARRL Field Day exchange (1-16 transmitters). + +0.4 ARRL Field Day exchange (17-32 transmitters). + +0.5 Telemetry, 71 bits + +1. Two callsigns, Roger, and grid or report. Each callsign may have + an appended "/R" to indicate Rover status for NA VHF contests. + Either callsign may be nonstandard if enclosed in angle brackets, + for example . + +2. Same as Type 1, but uses /P instead of /R. For European VHF contests. + +3. Standard message for ARRL RTTY Roundup. Optional "TU;" at + beginning to finish a previous QSO; then two standard callsigns, + optional "R", a 3-bit report (529 to 599), and 13 bits to indicate + US state, Canadian province/territory, or DX serial number from + 0001 to 7999. + +4. One hashed call or "CQ"; one compound or nonstandard call with up + to 11 characters; and (if not "CQ") an optional RRR, RR73, or 73. + +--------------------------------------------------------------------------- +The following are tentative and not included in first release. + +5. CQ WW RTTY - US/Can: RST CQZ state/prov R 579 5 NJ R1 r3 z6 u7 + DX: RST + CQzone R 559 15 R1 r3 z6 + +6. CQ WPX RTTY - RST + serial R 589 0013 R1 r3 n12 diff --git a/wsjtx_lib/lib/77bit/CQ_messages.txt b/wsjtx_lib/lib/77bit/CQ_messages.txt new file mode 100644 index 0000000..f131f9f --- /dev/null +++ b/wsjtx_lib/lib/77bit/CQ_messages.txt @@ -0,0 +1,12 @@ +CQ K1ABC FN42 +DE K1ABC FN42 +QRZ K1ABC FN42 +CQ AA K1ABC FN42 +CQ ZZ K1ABC FN42 +CQ 000 K1ABC FN42 +CQ 313 K1ABC FN42 +CQ 999 K1ABC FN42 +CQ AAA K1ABC FN42 +CQ ZZZ K1ABC FN42 +CQ AAAA K1ABC FN42 +CQ ZZZZ K1ABC FN42 diff --git a/wsjtx_lib/lib/77bit/NewCode.txt b/wsjtx_lib/lib/77bit/NewCode.txt new file mode 100644 index 0000000..99b3603 --- /dev/null +++ b/wsjtx_lib/lib/77bit/NewCode.txt @@ -0,0 +1,49 @@ +i3 n3 isync Operating activity, Message Type +----------------------------------------------------------- + 0 0 1 Std QSO msg (bit 72=0) + 0 0 1 Free text (bit 72=1) + 0 1 1 Fox DXpedition msg with "RR73;" +----------------------------------------------------------- + 1 0 2 Std QSO msg + 0 1 2 Fox DXpedition msg with "RR73;" + 1 * 2 NA VHF contest + 2 * 2 EU VHF contest (Tx1, Tx6) + 0 2 2 EU VHF contest (Tx2, Tx3) + 0 3 2 ARRL Field Day (1-16 transmitters) + 0 4 2 ARRL Field Day (17-32 transmitters) + 3 * 2 ARRL RTTY Roundup + 4 * 2 Compound and non-standard calls +----------------------------------------------------------- +* ==> "don't care" (types i3=1,2,3,4 do not have subtypes) +----------------------------------------------------------- + +A. Required GUI Additions (after July 3): + + 1. Entry widgets for fixed parts of contest exchanges: comboBoxes + for ARRL section, US State/Canadian Province, number of + transmitters and entry Class for Field Day. + + 2. Spinner control for serial numbers: used for EU_VHF_Contest, + and for DX stations in RTTYroundup. + +B. Code near the end of GenStdMsgs(): + + 1. if(m_config.bNA_VHF_Contest()): do as with present checkbox + 2. if(m_config.bEU_VHF_Contest()): make EU_VHF messages + 3. if(m_config.bFieldDay()): make FD messages + 4. if(m_config.bRTTYroundup()): make RR messages + 5. if MyCall or DXcall is compound or nonstandard, make new msgs + +C. Code just before calling genft8_(): + + 1. m_i3=0, m_n3=0, m_isync=1 + 2. if(check m_config.bGenerate77()) m_isync=2 + 3. if msg is not an old-style standard msg, see if it's valid + as a 77-bit msg + 4. if NO: transmit as Free Text + if YES: set i3, n3, and isync=2 + +D. Auto-sequencer code + + 1. Probably lots of changes needed: details TBD, after we make the + new messages work with Auto-Seq off. diff --git a/wsjtx_lib/lib/77bit/New_Features_WSJT-X_2.0.txt b/wsjtx_lib/lib/77bit/New_Features_WSJT-X_2.0.txt new file mode 100644 index 0000000..55d5f3c --- /dev/null +++ b/wsjtx_lib/lib/77bit/New_Features_WSJT-X_2.0.txt @@ -0,0 +1,263 @@ + New Features in WSJT-X 2.0 + September 17, 2018 + -------------------------- + +This document is an update to the white paper "Plans for WSJT-X +Version 2.0" that was publicly distributed on July 26, 2018. It +describes the most important enhancements in WSJT-X 2.0 relative to +version 1.9.1. + +A majority of new program features involve the FT8 and MSK144 +protocols. Both modes have been upgraded to use use 77-bit +information payloads rather than the 75 bits of the older FT8 protocol +or 72 bits of JT4, JT9, JT65, MSK144, and QRA64. Cyclic redundancy +checks (CRCs) that protect against false decodes have been increased +from 12 to 14 bits (FT8) and from 8 to 13 bits (MSK144). These +changes bring many benefits, including support of structured messages +optimized for the following special types of QSOs and exchanged +information: + +1. NA VHF Contest operation with full and transparent support of grid + locators and "/R" (Rover) callsigns + +2. EU VHF Contest operation with the exchange of 6-digit locators, QSO + serial numbers, and "/P" (portable) callsigns + +3. ARRL Field Day operation with standard Field Day exchanges such as + "6A SNJ" + +4. ARRL RTTY Roundup operation with standard contest exchanges such as + "579 NJ" or "559 0071" + +5. Compound and nonstandard callsigns (up tp 11 characters); no need + for distinctions about "Type 1" or "Type 2" prefixes/suffixes + +6. A special "telemetry" message format for exchange of arbitrary + information up to 71 bits + +7. All features of FT8 DXpedition mode, as in WSJT-X v1.9.1 + +Conveying more information in the same bandwidth, using the same +modulation scheme, necessarily means a higher code rate and less +energy per information bit. Nevertheless, the decoding threshold S/N +for the new FT8 is slightly lower than for the old version, because of +improvements in the decoding algorithm. Decoding threshold for MSK144 +is a fraction of a dB higher than before. Symbol rates and occupied +bandwidths for both modes are the same as before, and false-decode +rates are significantly lower. + +OTHER PROGRAM ENHANCEMENTS: WSJT-X 2.0 has several other new features +and capabilities. The WSPR decoder has significantly better +sensitivity, by about 1 dB. Color highlighting of decoded messages +provides worked-before status for callsigns, grid locators, and DXCC +entities on a "by band" basis. Color highlighting can also identify +stations that have (or have not) uploaded their logs to "Logbook of +the World" (LoTW) within the past year. (Recent information from LoTW +for this purpose can be downloaded from the ARRL web site.) + +WSJT-X 2.0 introduces no significant changes to any of the modes JT4, +JT9, JT65, QRA64, ISCAT, Echo, or FreqCal. + +IMPORTANT: For the convenience of beta-testers, the first and second +release candidates -- releases with "-rc1" or "-rc2" in their names -- +will have Rx and Tx capability for both the new FT8 protocol and the +older one. Starting with the third release candidate ("-rc3"), and in +the general-availability full release of WSJT-X 2.0, only the new +protocol will be supported. In contrast, the new MSK144 protocol +replaces the old one from the outset, without backward compatibility. +To minimize on-the-air confusion, it's important that users be aware +of these distinctions and the schedule for release of WSJT-X 2.0, as +detailed below. + +MESSAGE FORMATS: The following table shows examples of message formats +supported by the new FT8 and MSK144 protocols. Parameters i3 and n3 +(shown in the first column) are used in the software to define major +and minor 77-bit message types. + +---------------------------------------------------------------------------------- +i3.n3 Example Messages Comments +---------------------------------------------------------------------------------- + 0.0 TNX BOB 73 GL Free text + 0.1 K1ABC RR73; W9XYZ -08 DXpedition Mode + 0.2 PA9XYZ 590003 IO91NP EU VHF Contest + 0.2 G4ABC/P R 570007 JO22DB EU VHF Contest + 0.3 K1ABC W9XYZ 6A WI ARRL Field Day + 0.3 W9XYZ K1ABC R 2B EMA ARRL Field Day + 0.5 123456789ABCDEF012 Telemetry (71 bits, 18 hex digits) + 1. CQ FD K1ABC FN42 ARRL Field Day + 1. CQ RU K1ABC FN42 ARRL RTTY Roundup + 1. CQ K1ABC FN42 + 1. CQ TEST K1ABC FN42 NA VHF Contest + 1. CQ TEST K1ABC/R FN42 NA VHF Contest + 1. K1ABC W9XYZ EN37 + 1. K1ABC W9XYZ -09 + 1. K1ABC W9XYZ R-17 + 1. K1ABC W9XYZ RRR + 1. K1ABC W9XYZ 73 + 1. K1ABC W9XYZ RR73 + 1. K1ABC/R W9XYZ EN37 NA VHF Contest + 1. K1ABC W9XYZ/R RR73 NA VHF Contest + 1. K1ABC/R W9XYZ/R RR73 NA VHF Contest + 1. W9XYZ Compound call + 1. W9XYZ 73 Compound call + 1. W9XYZ -13 Nonstandard call + 1. W9XYZ R+02 Nonstandard call + 1. W9XYZ RRR Nonstandard call + 1. W9XYZ RR73 Nonstandard call + 2. CQ G4ABC/P IO91 EU VHF contest + 2. G4ABC/P PA9XYZ JO22 EU VHF contest + 2. PA9XYZ G4ABC/P RR73 EU VHF contest + 3. K1ABC KA0DEF 559 MO ARRL RTTY Roundup + 3. K1ABC W9XYZ 579 WI ARRL RTTY Roundup + 3. KA1ABC G3AAA 529 0013 ARRL RTTY Roundup + 3. TU; KA0DEF K1ABC R 569 MA ARRL RTTY Roundup + 3. TU; K1ABC G3AAA R 559 0194 ARRL RTTY Roundup + 3. W9XYZ K1ABC R 589 MA ARRL RTTY Roundup + 4. CQ PJ4/K1ABC + 4. CQ YW18FIFA Nonstandard call + 4. YW18FIFA RR73 Nonstandard call + 4. PJ4/K1ABC RRR Nonstandard call + 4. YW18FIFA Nonstandard call + 4. YW18FIFA 73 Nonstandard call + 4. PJ4/K1ABC Nonstandard call + 4. PJ4/K1ABC 73 Nonstandard call + 4. YW18FIFA RRR Nonstandard call +---------------------------------------------------------------------------------- + +In the above list, callsigns enclosed in angle brackets (e.g., +, ) are transmitted as hash codes. They will be +displayed correctly by receiving stations that have copied the full +callsign without brackets in a previous transmissiion. Otherwise the +receiving software will display <...>. Hash collisions are possible +but should be rare, and extremely rare within a particular QSO. + +Some minimal message sequences that take advantage of the new 77-bit +formats are illustrated below. Model QSOs 1 and 2 are the same as +those used by the old FT8 and MSK144 protocols, and QSO number 3 is +the same as the existing FT8 DXpedition Mode. Model QSOs 4 through 9 +were not possible with the old protocols. + +---------------------------------------------------------------------------------- +1. Standard QSO +---------------------------------------------------------------------------------- +CQ K1ABC FN42 + K1ABC W9XYZ EN37 +W9XYZ K1ABC -11 + K1ABC W9XYZ R-09 +W9XYZ K1ABC RRR + K1ABC W9XYZ 73 + +---------------------------------------------------------------------------------- +2. Short-cycle QSO +---------------------------------------------------------------------------------- +CQ K1ABC FN42 + K1ABC W9XYZ -09 +W9XYZ K1ABC R-11 + K1ABC W9XYZ RR73 +W9XYZ K1ABC 73 + +---------------------------------------------------------------------------------- +3. FT8 DXpedition Mode +---------------------------------------------------------------------------------- +CQ KH1/KH7Z + KH7Z K1ABC FN42 +K1ABC KH7Z -12 + KH7Z K1ABC R-14 + KH7Z W9XYZ EN37 + ... possibly other callers ... +K1ABC RR73; W9XYZ -08 + +---------------------------------------------------------------------------------- +4. ARRL Field Day +---------------------------------------------------------------------------------- +CQ FD K1ABC FN42 + K1ABC W9XYZ 6A WI +W9XYZ K1ABC R 2B EMA + K1ABC W9XYZ RR73 + +---------------------------------------------------------------------------------- +5. ARRL VHF Contests +---------------------------------------------------------------------------------- +CQ TEST K1ABC/R FN42 "/R" is optional + K1ABC/R W9XYZ EN37 on either callsign +W9XYZ K1ABC/R R FN42 + K1ABC/R W9XYZ RR73 + +---------------------------------------------------------------------------------- +6. ARRL RTTY Roundup +---------------------------------------------------------------------------------- +CQ TEST K1ABC FN42 + K1ABC W9XYZ 579 WI +W9XYZ K1ABC R 589 MA + K1ABC KA0DEF 559 MO +TU; KA0DEF K1ABC R 569 MA + KA1ABC G3AAA 529 0013 +TU; G3AAA K1ABC R 559 MA + +---------------------------------------------------------------------------------- +7. EU VHF Contest +---------------------------------------------------------------------------------- +CQ TEST G4ABC/P IO91 "/P" is optional + G4ABC/P PA9XYZ JO22 on either callsign +PA9XYZ 590003 IO91NP + G4ABC/P R 570007 JO22DB +PA9XYZ G4ABC/P RR73 + +---------------------------------------------------------------------------------- +8. Compound or nonstandard callsign calling CQ +---------------------------------------------------------------------------------- +CQ PJ4/K1ABC + PJ4/K1ABC +W9XYZ -11 + W9XYZ R-09 + PJ4/K1ABC RRR + PJ4/K1ABC 73 + +---------------------------------------------------------------------------------- +9. Compound or nonstandard callsign answering CQ +---------------------------------------------------------------------------------- +CQ W9XYZ EN37 + YW18FIFA + W9XYZ -11 + W9XYZ R-09 +YW18FIFA RRR + YW18FIFA 73 +---------------------------------------------------------------------------------- + + +RELEASE SCHEDULE: Candidate releases of WSJT-X 2.0 will have built-in +expiration dates after which they cannot be used. Target dates for +planned releases are as follows: + +September 17: -rc1 (expires Oct 31) +October 15: -rc2 (expires Nov 30) +November 12: -rc3 (expires Dec 31) +December 10: GA Full release of WSJT-X 2.0 + +WSJT-X 2.0-rc1 provides the first chance for beta testers to use the +new 77-bit messages. It supports the old (v1.9.1) FT8 protocol as +well as the new message types illustrated above. To avoid QRMing +legacy FT8 users with incompatible messages they can't decode, and to +help concentrate testing activity into a few sub-bands, we recommend +using the new FT8 capabilities on the 40- or 20-meter bands at dial +frequencies 7.078 or 14.078 MHz. These frequencies are offered as FT8 +alternatives on the drop-down frequency-selection control on the main +window. + +The new MSK144 is fully functional for QSOs between any two stations +using a WSJT-X v2.0 release. MSK144 is not backward compatible with +earlier program versions. Therefore during the testing period, +approximately Sept 17 through December 10, we recommend using the new +MSK144 capabilities on 50.380 MHz (IARU Region 1) or 50.280 (Regions 2 +and 3). By specific arrangement, or as soon as most regular users +have upgraded to a v2.0 release, MSK144 activity can be moved back to +50.360 (Region 1) or 50.260 (Regions 2 and 3). + +By design, our proposed release schedule will make WSJT-X 2.0 usable +for all relevant ARRL operating events and Eurpoean VHF contests after +January 1, 2019. + +Dates of relevant upcoming ARRL contests +---------------------------------------- +RTTY Roundup: January 5-6, 2019 +VHF Sweepstakes: January 19-21, 2019 diff --git a/wsjtx_lib/lib/77bit/all28.txt b/wsjtx_lib/lib/77bit/all28.txt new file mode 100644 index 0000000..2a6e278 --- /dev/null +++ b/wsjtx_lib/lib/77bit/all28.txt @@ -0,0 +1,40 @@ + + +5B1ABC +999ABC +9Y4AB +9Y4XYZ +A00A +A0A +A0AA +A0AAA +A0AAB +AA0AAA +CQ +CQ_000 +CQ_313 +CQ_999 +CQ_A +CQ_AAAA +CQ_AB +CQ_ABC +CQ_ABCD +CQ_DX +CQ_ZZZZ +DE +EI30T +HA70BAY +HB9GOLD +K1ABC +K1JT +KA0ABC +KA1ABC +KA1JT +KH1/KH7Z +QRZ +W2000XYZ +WB9XYZ +YB50ST +YW18FIFA +ZM90DX +ZS9YOTA diff --git a/wsjtx_lib/lib/77bit/arrl_sec.txt b/wsjtx_lib/lib/77bit/arrl_sec.txt new file mode 100644 index 0000000..b97b64f --- /dev/null +++ b/wsjtx_lib/lib/77bit/arrl_sec.txt @@ -0,0 +1,83 @@ +AB +AK +AL +AR +AZ +BC +CO +CT +DE +EB +EMA +ENY +EPA +EWA +GA +GTA +IA +ID +IL +IN +KS +KY +LA +LAX +MAR +MB +MDC +ME +MI +MN +MO +MS +MT +NC +ND +NE +NFL +NH +NL +NLI +NM +NNJ +NNY +NT +NTX +NV +OH +OK +ONE +ONN +ONS +OR +ORG +PAC +PR +QC +RI +SB +SC +SCV +SD +SDG +SF +SFL +SJV +SK +SNJ +STX +SV +TN +UT +VA +VI +VT +WCF +WI +WMA +WNY +WPA +WTX +WV +WWA +WY diff --git a/wsjtx_lib/lib/77bit/call_to_c28.f90 b/wsjtx_lib/lib/77bit/call_to_c28.f90 new file mode 100644 index 0000000..96930c5 --- /dev/null +++ b/wsjtx_lib/lib/77bit/call_to_c28.f90 @@ -0,0 +1,21 @@ +program call_to_c28 + parameter (NTOKENS=2063592,MAX22=4194304) + character*6 call_std + character a1*37,a2*36,a3*10,a4*27 + data a1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data a2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data a3/'0123456789'/ + data a4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + ! call_std must be right adjusted, length 6 + call_std=' K1ABC' !Redefine as needed + i1=index(a1,call_std(1:1))-1 + i2=index(a2,call_std(2:2))-1 + i3=index(a3,call_std(3:3))-1 + i4=index(a4,call_std(4:4))-1 + i5=index(a4,call_std(5:5))-1 + i6=index(a4,call_std(6:6))-1 + n28=NTOKENS + MAX22 + 36*10*27*27*27*i1 + 10*27*27*27*i2 + & + 27*27*27*i3 + 27*27*i4 + 27*i5 + i6 + write(*,1000) call_std,n28 +1000 format('Callsign: ',a6,2x,'c28 as decimal integer:',i10) +end program call_to_c28 diff --git a/wsjtx_lib/lib/77bit/calls.txt b/wsjtx_lib/lib/77bit/calls.txt new file mode 100644 index 0000000..c542c9b --- /dev/null +++ b/wsjtx_lib/lib/77bit/calls.txt @@ -0,0 +1,5 @@ +KA1ABC +WB9XYZ +KH1/KH7Z + +CQ DX K1ABC diff --git a/wsjtx_lib/lib/77bit/calls1.txt b/wsjtx_lib/lib/77bit/calls1.txt new file mode 100644 index 0000000..888b455 --- /dev/null +++ b/wsjtx_lib/lib/77bit/calls1.txt @@ -0,0 +1,21 @@ + + +K1ABC +WB9XYZ +KA1ABC +WB9XYZ +K1JT +KA1JT +5B1ABC +9Y4XYZ +9Y4AB +999ABC +ZM90DX +EI30T +ZS9YOTA +HA70BAY +HB9GOLD +YW18FIFA +YB50ST +WB2000XYZ +WB2000XYZABCD diff --git a/wsjtx_lib/lib/77bit/calls2.txt b/wsjtx_lib/lib/77bit/calls2.txt new file mode 100644 index 0000000..b1f4877 --- /dev/null +++ b/wsjtx_lib/lib/77bit/calls2.txt @@ -0,0 +1,7 @@ +A0A +A00A +A0AA +A0AAA +KA0ABC +5B1ABC +9Y4XYZ diff --git a/wsjtx_lib/lib/77bit/calls3.txt b/wsjtx_lib/lib/77bit/calls3.txt new file mode 100644 index 0000000..69a81bb --- /dev/null +++ b/wsjtx_lib/lib/77bit/calls3.txt @@ -0,0 +1,4 @@ +AA0AAA +A0AAA +A0AAB +A0AA diff --git a/wsjtx_lib/lib/77bit/encode77.f90 b/wsjtx_lib/lib/77bit/encode77.f90 new file mode 100644 index 0000000..99af70c --- /dev/null +++ b/wsjtx_lib/lib/77bit/encode77.f90 @@ -0,0 +1,60 @@ +program encode77 + + use packjt77 + + character*80 msg0 + character msg*37,cerr*1 + character*77 c77 + character*80 infile + character*13 w(19) + integer nw(19) + logical unpk77_success + + nargs=iargc() + if(nargs.ne.1 .and.nargs.ne.2) then + print*,'Usage: encode77 "message"' + print*,' encode77 -f ' + go to 999 + endif + call getarg(1,msg0) + call fmtmsg(msg0,iz) + if(nargs.eq.2) then + call getarg(2,infile) + open(10,file=infile,status='old') + write(*,1000) +1000 format('i3.n3 Err Message to be encoded Decoded message' & + /80('-')) + endif + + do iline=1,999 + if(nargs.eq.2) read(10,1002,end=999) msg0 +1002 format(a80) + if(msg0(1:1).eq.'$') exit + if(msg0.eq.' ') cycle + if(msg0(2:2).eq.'.' .or. msg0(3:3).eq.'.') cycle + if(msg0(1:3).eq.'---') cycle + msg0=adjustl(msg0) + i3=-1 + n3=-1 + call pack77(msg0(1:37),i3,n3,c77) + call unpack77(c77,1,msg,unpk77_success) + cerr=' ' + if(msg.ne.msg0(1:37)) cerr='*' + if(i3.eq.0 .and.n3.ne.6) write(*,1004) i3,n3,cerr,msg0(1:37),msg +1004 format(i2,'.',i1,4x,a1,1x,a37,1x,a37) + if(i3.eq.0 .and.n3.eq.6) then + call split77(msg,nwords,nw,w) + j2=0 + if(nwords.eq.2 .and. len(trim(w(2))).le.2) j2=1 + if(nwords.eq.2 .and. len(trim(w(2))).eq.6) j2=2 + write(*,1005) i3,n3,j2,cerr,msg0(1:37),msg +1005 format(i2,'.',i1,'.',i1,2x,a1,1x,a37,1x,a37) + endif + if(i3.ge.1) write(*,1006) i3,cerr,msg0(1:37),msg +1006 format(i2,'.',5x,a1,1x,a37,1x,a37) + if(nargs.eq.1) exit + enddo + +999 end program encode77 + +include '../chkcall.f90' diff --git a/wsjtx_lib/lib/77bit/encode77.out b/wsjtx_lib/lib/77bit/encode77.out new file mode 100644 index 0000000..2d0f7d4 --- /dev/null +++ b/wsjtx_lib/lib/77bit/encode77.out @@ -0,0 +1,41 @@ +i3.n3 Err Message to be encoded Decoded message +-------------------------------------------------------------------------------- + 1. CQ K1ABC FN42 CQ K1ABC FN42 + 1. K1ABC W9XYZ EN37 K1ABC W9XYZ EN37 + 1. W9XYZ K1ABC -11 W9XYZ K1ABC -11 + 1. K1ABC W9XYZ R-09 K1ABC W9XYZ R-09 + 1. W9XYZ K1ABC RRR W9XYZ K1ABC RRR + 1. K1ABC W9XYZ 73 K1ABC W9XYZ 73 + 1. CQ K1ABC FN42 CQ K1ABC FN42 + 1. K1ABC W9XYZ -09 K1ABC W9XYZ -09 + 1. W9XYZ K1ABC R-11 W9XYZ K1ABC R-11 + 1. K1ABC W9XYZ RR73 K1ABC W9XYZ RR73 + 1. W9XYZ K1ABC 73 W9XYZ K1ABC 73 + 4. CQ KH1/KH7Z CQ KH1/KH7Z + 1. KH7Z K1ABC FN42 KH7Z K1ABC FN42 + 1. K1ABC KH7Z -12 K1ABC KH7Z -12 + 1. KH7Z K1ABC R-14 KH7Z K1ABC R-14 + 0.1 K1ABC RR73; W9XYZ -08 K1ABC RR73; W9XYZ -08 + 1. CQ FD K1ABC FN42 CQ FD K1ABC FN42 + 0.3 K1ABC W9XYZ 6A WI K1ABC W9XYZ 6A WI + 0.3 W9XYZ K1ABC R 2B EMA W9XYZ K1ABC R 2B EMA + 1. K1ABC W9XYZ RR73 K1ABC W9XYZ RR73 + 1. CQ TEST K1ABC/R FN42 CQ TEST K1ABC/R FN42 + 1. K1ABC/R W9XYZ EN37 K1ABC/R W9XYZ EN37 + 1. W9XYZ K1ABC/R R FN42 W9XYZ K1ABC/R R FN42 + 1. K1ABC/R W9XYZ RR73 K1ABC/R W9XYZ RR73 + 1. CQ TEST K1ABC FN42 CQ TEST K1ABC FN42 + 3. K1ABC W9XYZ 579 WI K1ABC W9XYZ 579 WI + 3. W9XYZ K1ABC R 589 MA W9XYZ K1ABC R 589 MA + 1. K1ABC W9XYZ RR73 K1ABC W9XYZ RR73 + 2. CQ G4ABC/P IO91 CQ G4ABC/P IO91 + 2. G4ABC/P PA9XYZ JO22 G4ABC/P PA9XYZ JO22 + 0.2 PA9XYZ 590003 IO91NP PA9XYZ 590003 IO91NP + 0.2 G4ABC/P R 570007 JO22DB G4ABC/P R 570007 JO22DB + 2. PA9XYZ G4ABC/P RR73 PA9XYZ G4ABC/P RR73 + 4. CQ PJ4/K1ABC CQ PJ4/K1ABC + 4. W9XYZ W9XYZ + 1. W9XYZ K1ABC -11 W9XYZ K1ABC -11 + 1. K1ABC W9XYZ R-09 K1ABC W9XYZ R-09 + 4. W9XYZ RRR W9XYZ RRR + 4. W9XYZ 73 W9XYZ 73 diff --git a/wsjtx_lib/lib/77bit/free_text.f90 b/wsjtx_lib/lib/77bit/free_text.f90 new file mode 100644 index 0000000..c7e6682 --- /dev/null +++ b/wsjtx_lib/lib/77bit/free_text.f90 @@ -0,0 +1,58 @@ +program free_text + character*13 c13,w + character*71 f71 + character*42 c + character*1 qa(10),qb(10) + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/ + c13='TNX BOB 73 GL' !Redefine as needed + call mp_short_init + qa=char(0) + w=adjustr(c13) + do i=1,13 + j=index(c,w(i:i))-1 + if(j.lt.0) j=0 + call mp_short_mult(qb,qa(2:10),9,42) !qb(1:9)=42*qa(2:9) + call mp_short_add(qa,qb(2:10),9,j) !qa(1:9)=qb(2:9)+j + enddo + write(f71,1000) qa(2:10) +1000 format(b7.7,8b8.8) + write(*,1010) c13,f71 +1010 format('Free text: ',a13/'f71: ',a71) +end program free_text + +subroutine mp_short_ops(w,u) +! Multi-precision arithmetic with storage in character arrays. + character*1 w(*),u(*) + integer i,ireg,j,n,ir,iv,ii1,ii2 + character*1 creg(4) + save ii1,ii2 + equivalence (ireg,creg) + + entry mp_short_init + ireg=256*ichar('2')+ichar('1') + do j=1,4 + if (creg(j).eq.'1') ii1=j + if (creg(j).eq.'2') ii2=j + enddo + return + + entry mp_short_add(w,u,n,iv) + ireg=256*iv + do j=n,1,-1 + ireg=ichar(u(j))+ichar(creg(ii2)) + w(j+1)=creg(ii1) + enddo + w(1)=creg(ii2) + return + + entry mp_short_mult(w,u,n,iv) + ireg=0 + do j=n,1,-1 + ireg=ichar(u(j))*iv+ichar(creg(ii2)) + w(j+1)=creg(ii1) + enddo + w(1)=creg(ii2) + return + + return +end subroutine mp_short_ops diff --git a/wsjtx_lib/lib/77bit/g2 b/wsjtx_lib/lib/77bit/g2 new file mode 100644 index 0000000..9c19b3a --- /dev/null +++ b/wsjtx_lib/lib/77bit/g2 @@ -0,0 +1,6 @@ +gfortran -c ../packjt.f90 +gfortran -c packjt77.f90 +gfortran -o encode77 -fbounds-check -Wall -Wno-conversion \ + encode77.f90 ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \ + ../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 \ + packjt.o packjt77.o diff --git a/wsjtx_lib/lib/77bit/g8 b/wsjtx_lib/lib/77bit/g8 new file mode 100644 index 0000000..3381913 --- /dev/null +++ b/wsjtx_lib/lib/77bit/g8 @@ -0,0 +1,3 @@ +gfortran -c packjt77.f90 +gfortran -o test28 -fbounds-check -Wall -Wno-conversion test28.f90 \ + ../chkcall.f90 packjt77.o diff --git a/wsjtx_lib/lib/77bit/hash22calc.f90 b/wsjtx_lib/lib/77bit/hash22calc.f90 new file mode 100644 index 0000000..500e1ee --- /dev/null +++ b/wsjtx_lib/lib/77bit/hash22calc.f90 @@ -0,0 +1,42 @@ +program hash22calc +! Given a valid callsign, calculate and print its 22-bit hash. + + use packjt77 + + character*13 callsign + character*1 c + character*6 basecall + logical cok + + nargs=iargc() + if(nargs.ne.1) then + print*,'Given a valid callsign, print its 22-bit hash.' + print*,'Usage: hash22calc ' + print*,' e.g. hash22calc W9ABC' + go to 999 + endif + call getarg(1,callsign) + +! convert to upper case + ilen=len(trim(callsign)) + do i=1, ilen + c=callsign(i:i) + if(c.ge.'a' .and. c.le.'z') c=char(ichar(c)-32) !Force upper case + callsign(i:i)=c + enddo + +! check for a valid callsign + call chkcall(callsign,basecall,cok) + if(.not.cok) then + print*,'Invalid callsign' + print*,'Usage: hash22calc ' + goto 999 + endif + +! calculate the hash + n22 = ihashcall(callsign,22) + write(*,'(a,i7.7)') callsign,n22 + +999 end program hash22calc + +include '../chkcall.f90' diff --git a/wsjtx_lib/lib/77bit/messages.txt b/wsjtx_lib/lib/77bit/messages.txt new file mode 100644 index 0000000..d84bba2 --- /dev/null +++ b/wsjtx_lib/lib/77bit/messages.txt @@ -0,0 +1,100 @@ +1. Standard QSO +----------------------------------------------------------- +CQ K1ABC FN42 + K1ABC W9XYZ EN37 +W9XYZ K1ABC -11 + K1ABC W9XYZ R-09 +W9XYZ K1ABC RRR + K1ABC W9XYZ 73 + +2. Short-cycle QSO +----------------------------------------------------------- +CQ K1ABC FN42 + K1ABC W9XYZ -09 +W9XYZ K1ABC R-11 + K1ABC W9XYZ RR73 +W9XYZ K1ABC 73 + +3. FT8 DXpedition Mode +----------------------------------------------------------- +CQ KH1/KH7Z + KH7Z K1ABC FN42 +K1ABC KH7Z -12 + KH7Z K1ABC R-14 +K1ABC RR73; W9XYZ -08 + +4. ARRL Field Day +----------------------------------------------------------- +CQ FD K1ABC FN42 + K1ABC W9XYZ 6A WI +W9XYZ K1ABC R 2B EMA + K1ABC W9XYZ RR73 + +5. ARRL VHF Contests +----------------------------------------------------------- +CQ TEST K1ABC/R FN42 + K1ABC/R W9XYZ EN37 +W9XYZ K1ABC/R R FN42 + K1ABC/R W9XYZ RR73 + +6. ARRL RTTY Contest +----------------------------------------------------------- +CQ TEST K1ABC FN42 + K1ABC W9XYZ 579 WI +W9XYZ K1ABC R 589 MA + K1ABC KA0DEF 559 MO +TU; KA0DEF K1ABC R 569 MA + KA1ABC G3AAA 529 0013 +TU; G3AAA K1ABC R 559 MA + +7. EU VHF Contest +----------------------------------------------------------- +CQ G4ABC/P IO91 + G4ABC/P PA9XYZ JO22 + 590003 IO91NP + R 570007 JO22DB +PA9XYZ G4ABC/P RR73 + +8. Compound or nonstandard calls CQ +----------------------------------------------------------- +CQ PJ4/K1ABC + PJ4/K1ABC +W9XYZ -11 + W9XYZ R-09 + PJ4/K1ABC RRR + PJ4/K1ABC 73 + +9. Compound or nonstandard answers CQ +----------------------------------------------------------- +CQ W9XYZ EN37 + YW18FIFA + W9XYZ -11 + W9XYZ R-09 +YW18FIFA RRR + YW18FIFA 73 + +10. Other stuff +----------------------------------------------------------- +TNX BOB 73 GL +CQ YW18FIFA + KA1ABC +KA1ABC -11 + KA1ABC R-17 + YW18FIFA RR73 + KA1ABC 73 +123456789ABCDEF012 +K1ABC FN42 37 +PJ4/K1ABC 37 +K1ABC/VE3 37 +KA1ABC/VEX 37 + FK52UD + FK52UD + 590001 FN20QI + 590001 FN20QI + 590001 FN20QI + 590001 FN20QI + 590001 FN20QI +CQ OE21FTDMC +K9AN K1JT R- +K9AN K1JT R+ +K1AN K1JT WXY diff --git a/wsjtx_lib/lib/77bit/messages_2.txt b/wsjtx_lib/lib/77bit/messages_2.txt new file mode 100644 index 0000000..38399e6 --- /dev/null +++ b/wsjtx_lib/lib/77bit/messages_2.txt @@ -0,0 +1,49 @@ +FREE TEXT MSG 71 0 71 +CQ YW18FIFA +K1ABC RR73; W9XYZ -12 28 28 10 5 1 71 DXpedition Mode +PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2) +PA3XYZ 520093 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2) +WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 3 71 ARRL Field Day +WA9XYZ KA1ABC 7D EMA 28 28 1 4 3 7 3 71 ARRL Field Day +WA9XYZ G8ABC 1D DX 28 28 1 4 3 7 3 71 ARRL Field Day +WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 4 71 ARRL Field Day +123456789ABCDEF012 71 71 Telemetry (18 hex) +71234567 71 71 Telemetry (18 hex) +81234567 71 71 Telemetry (18 hex) +7123456789ABCDEF01 71 71 Telemetry (18 hex) +8123456789ABCDEF01 71 71 Telemetry (18 hex) +WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg +WA9XYZ KA1ABC R-19 28 1 28 1 1 15 74 Standard msg +WA9XYZ KA1ABC +03 28 1 28 1 1 15 74 Standard msg +WA9XYZ KA1ABC -30 28 1 28 1 1 15 74 Standard msg +WA9XYZ KA1ABC +30 28 1 28 1 1 15 74 Standard msg +CQ K1ABC FN42 +DE K1ABC FN42 +QRZ K1ABC FN42 +CQ AA K1ABC FN42 +CQ ZZ K1ABC FN42 +CQ 000 K1ABC FN42 +CQ 313 K1ABC FN42 +CQ 999 K1ABC FN42 +CQ AAA K1ABC FN42 +CQ ZZZ K1ABC FN42 +CQ AAAA K1ABC FN42 +CQ ZZZZ K1ABC FN42 +CQ KH1/KH7Z +CQ YW18FIFA +CQ W4/YW18FIFA +PA1XYZ/P GM4ABC/P R FN42 28 1 28 1 1 15 74 EU VHF Contest +TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY contest +TU; W9XYZ G8ABC R 559 0013 1 28 28 1 3 13 74 ARRL RTTY (DX) +W9XYZ K1ABC 519 MA 1 28 28 1 3 13 74 ARRL RTTY contest +W9XYZ K1ABC 529 MA 1 28 28 1 3 13 74 ARRL RTTY contest +W9XYZ K1ABC 599 MA 1 28 28 1 3 13 74 ARRL RTTY contest +W9XYZ K1ABC 599 SNJ 1 28 28 1 3 13 74 ARRL RTTY contest +W9XYZ G8ABC 529 0013 1 28 28 1 3 13 74 ARRL RTTY (DX) +W9XYZ G8ABC 599 0013 1 28 28 1 3 13 74 ARRL RTTY (DX) + PJ4/KA1ABC 13 58 1 2 74 Nonstandard call +PJ4/KA1ABC RRR 13 58 1 2 74 Nonstandard call + PJ4/KA1ABC RR73 13 58 1 2 74 Nonstandard call +PJ4/KA1ABC 73 13 58 1 2 74 Nonstandard call + PJ4/KA1ABC 73 13 58 1 2 74 Nonstandard call +CQ 313 YW18FIFA diff --git a/wsjtx_lib/lib/77bit/msgtypes.txt b/wsjtx_lib/lib/77bit/msgtypes.txt new file mode 100644 index 0000000..0cb0044 --- /dev/null +++ b/wsjtx_lib/lib/77bit/msgtypes.txt @@ -0,0 +1,23 @@ +i3 n3 Bits Total Message type +--------------------------------------------------------------------------------------- +0 0 FREE TEXT MSG 71 71 +0 1 K1ABC RR73; W9XYZ -12 28 28 10 5 71 DXpedition Mode +0 2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest (2) +0 2 PA3XYZ 520093 IO91NP 28 1 1 3 12 25 70 EU VHF contest (2) +0 3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day +0 3 WA9XYZ KA1ABC 7D EMA 28 28 1 4 3 7 71 ARRL Field Day +0 3 WA9XYZ G8ABC 1D DX 28 28 1 4 3 7 71 ARRL Field Day +0 4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day +0 5 123456789ABCDEF012 71 71 Telemetry (18 hex) +0 5 7123456789ABCDEF01 71 71 Telemetry (18 hex) +0 5 71234567 71 71 Telemetry (18 hex) +0 5 81234567 71 71 Telemetry (18 hex) +0 5 8123456789ABCDEF01 71 71 Telemetry (18 hex) +1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg +1 WA9XYZ KA1ABC R-11 28 1 28 1 1 15 74 Standard msg +2 PA1XYZ/P GM4ABC/P R FN42 28 1 28 1 1 15 74 EU VHF Contest +3 TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY contest +3 TU; W9XYZ G8ABC R 559 0013 1 28 28 1 3 13 74 ARRL RTTY (DX) +4 PJ4/KA1ABC RR73 13 58 1 2 74 Nonstandard call +4 PJ4/KA1ABC 13 58 1 2 74 Nonstandard call +4 PJ4/KA1ABC RRR 13 58 1 2 74 Nonstandard call diff --git a/wsjtx_lib/lib/77bit/msgtypes.txt.0 b/wsjtx_lib/lib/77bit/msgtypes.txt.0 new file mode 100644 index 0000000..a1ab61f --- /dev/null +++ b/wsjtx_lib/lib/77bit/msgtypes.txt.0 @@ -0,0 +1,23 @@ +i3 n3 +-------------------------------------------------------------------------------------- +0 0 FREE TEXT MSG 71 0 71 +0 1 K1ABC RR73; W9XYZ -11 28 28 10 5 1 71 DXpedition Mode +0 2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2) +0 3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 3 71 ARRL Field Day +0 4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 4 71 ARRL Field Day +1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg +2 TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY contest +3 PJ4/KA1ABC R-11 13 53 1 1 6 74 Nonstandard calls +4 PA3XYZ/P GM4ABC/P R IO91 28 1 28 1 1 15 74 EU VHF contest + +0 0 HELLO WORLD 1 +0 0 hello world 2 + +0 1 K1ABC RR73; W9XYZ -11 +0 2 PA3XYZ 590003 IO91NP +0 3 WA9XYZ KA1ABC 16A EMA +0 4 WA9XYZ KA1ABC 32A EMA +1 WA9XYZ/R KA1ABC/R R FN42 +2 W9XYZ K1ABC 579 MA +3 PJ4/KA1ABC -11 +4 PA3XYZ/P GM4ABC/P R IO91 diff --git a/wsjtx_lib/lib/77bit/my_hash.f90 b/wsjtx_lib/lib/77bit/my_hash.f90 new file mode 100644 index 0000000..4e1a6c6 --- /dev/null +++ b/wsjtx_lib/lib/77bit/my_hash.f90 @@ -0,0 +1,11 @@ +subroutine my_hash(mycall) + + use packjt77 + character*(*) mycall + character*13 c13 + + c13=mycall//' ' + call save_hash_call(c13,n10,n12,n22) + + return +end subroutine my_hash diff --git a/wsjtx_lib/lib/77bit/nonstd_to_c58.f90 b/wsjtx_lib/lib/77bit/nonstd_to_c58.f90 new file mode 100644 index 0000000..0919042 --- /dev/null +++ b/wsjtx_lib/lib/77bit/nonstd_to_c58.f90 @@ -0,0 +1,13 @@ +program nonstd_to_c58 + integer*8 n58 + character*11 call_nonstd + character*38 c + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ + call_nonstd='PJ4/K1ABC' !Redifine as needed + n58=0 + do i=1,11 + n58=n58*38 + index(c,call_nonstd(i:i)) - 1 + enddo + write(*,1000) call_nonstd,n58 +1000 format('Callsign: ',a11,2x,'c58 as decimal integer:',i20) +end program nonstd_to_c58 diff --git a/wsjtx_lib/lib/77bit/packjt77.f90 b/wsjtx_lib/lib/77bit/packjt77.f90 new file mode 100644 index 0000000..5729cee --- /dev/null +++ b/wsjtx_lib/lib/77bit/packjt77.f90 @@ -0,0 +1,1640 @@ +module packjt77 + +! These variables are accessible from outside via "use packjt77": + parameter (MAXHASH=1000,MAXRECENT=10) + character (len=13), dimension(0:1023) :: calls10='' + character (len=13), dimension(0:4095) :: calls12='' + character (len=13), dimension(1:MAXHASH) :: calls22='' + character (len=13), dimension(1:MAXRECENT) :: recent_calls='' + character (len=13) :: mycall13='' + character (len=13) :: dxcall13='' + character (len=6) :: dxbase='' + integer, dimension(1:MAXHASH) :: ihash22=-1 + integer :: nzhash=0 + integer n28a,n28b + + contains + +subroutine hash10(n10,c13) + + character*13 c13 + + c13='<...>' + if(n10.lt.0 .or. n10.gt.1023) return + if(len(trim(calls10(n10))).gt.0) then + c13=calls10(n10) + c13='<'//trim(c13)//'>' + endif + return + +end subroutine hash10 + +subroutine hash12(n12,c13) + + character*13 c13 + + c13='<...>' + if(n12.lt.0 .or. n12.gt.4095) return + if(len(trim(calls12(n12))).gt.0) then + c13=calls12(n12) + c13='<'//trim(c13)//'>' + endif + return + +end subroutine hash12 + + +subroutine hash22(n22,c13) + + character*13 c13 + + c13='<...>' + do i=1,nzhash + if(ihash22(i).eq.n22) then + c13=calls22(i) + c13='<'//trim(c13)//'>' + go to 900 + endif + enddo + +900 return +end subroutine hash22 + + +integer function ihashcall(c0,m) + + integer*8 n8 + character*13 c0 + character*38 c + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ + + n8=0 + do i=1,11 + j=index(c,c0(i:i)) - 1 + n8=38*n8 + j + enddo + ihashcall=ishft(47055833459_8*n8,m-64) + + return +end function ihashcall + +subroutine save_hash_call(c13,n10,n12,n22) + + character*13 c13,cw + + cw=c13 + if(cw(1:1).eq.' ' .or. cw(1:5).eq.'<...>') return + if(cw(1:1).eq.'<') cw=cw(2:) + i=index(cw,'>') + if(i.gt.0) cw(i:)=' ' + + if(len(trim(cw)) .lt. 3) return + + n10=ihashcall(cw,10) + if(n10.ge.0 .and. n10 .le. 1023 .and. cw.ne.mycall13) calls10(n10)=cw + + n12=ihashcall(cw,12) + if(n12.ge.0 .and. n12 .le. 4095 .and. cw.ne.mycall13) calls12(n12)=cw + + n22=ihashcall(cw,22) + if(any(ihash22.eq.n22)) then ! If entry exists, make sure callsign is the most recently received one + where(ihash22.eq.n22) calls22=cw + go to 900 + endif + +! New entry: move table down, making room for new one at the top + ihash22(MAXHASH:2:-1)=ihash22(MAXHASH-1:1:-1) + +! Add the new entry + calls22(MAXHASH:2:-1)=calls22(MAXHASH-1:1:-1) + ihash22(1)=n22 + calls22(1)=cw + if(nzhash.lt.MAXHASH) nzhash=nzhash+1 +900 continue + return +end subroutine save_hash_call + +subroutine pack77(msg0,i3,n3,c77) + + use packjt + character*37 msg,msg0 + character*18 c18 + character*13 w(19) + character*77 c77 + integer nw(19) + integer ntel(3) + + msg=msg0 + if(msg(1:3).eq.'$DX') then + i1=index(msg,' ') + msg=trim(dxbase)//' '//msg(i1+1:) + endif + + i3_hint=i3 + n3_hint=n3 + i3=-1 + n3=-1 + if(i3_hint.eq.0 .and. n3_hint.eq.5) go to 5 + +! Convert msg to upper case; collapse multiple blanks; parse into words. + call split77(msg,nwords,nw,w) + if(msg(1:3).eq.'CQ ' .or. msg(1:3).eq.'DE ' .or. msg(1:4).eq.'QRZ ') go to 100 + +! Check 0.1 (DXpedition mode) + call pack77_01(nwords,w,i3,n3,c77) + if(i3.ge.0 .or. n3.ge.1) go to 900 +! Check 0.2 (EU VHF contest exchange) +! call pack77_02(nwords,w,i3,n3,c77) +! if(i3.ge.0) go to 900 + +! Check 0.3 and 0.4 (ARRL Field Day exchange) + call pack77_03(nwords,w,i3,n3,c77) + if(i3.ge.0) go to 900 + if(nwords.ge.2) go to 100 + + ! Check 0.5 (telemetry) +5 i0=index(msg,' ') + c18=msg(1:i0-1) + c18=adjustr(c18) + ntel=-99 + read(c18,1005,err=6) ntel +1005 format(3z6) + if(ntel(1).ge.2**23) go to 800 +6 if(ntel(1).ge.0 .and. ntel(2).ge.0 .and. ntel(3).ge.0) then + i3=0 + n3=5 + write(c77,1006) ntel,n3,i3 +1006 format(b23.23,2b24.24,2b3.3) + go to 900 + endif + +100 call pack77_06(nwords,w,i3,n3,c77,i3_hint,n3_hint) + if(i3.ge.0) go to 900 + +! Check Type 1 (Standard 77-bit message) or Type 2, with optional "/P" + call pack77_1(nwords,w,i3,n3,c77) + if(i3.ge.0) go to 900 + +! Check Type 3 (ARRL RTTY contest exchange) + call pack77_3(nwords,w,i3,n3,c77) + if(i3.ge.0) go to 900 + +! Check Type 4 (One nonstandard call and one hashed call) + call pack77_4(nwords,w,i3,n3,c77) + if(i3.ge.0) go to 900 + +! Check Type 5 (EU VHF Contest with 2 hashed calls, report, serial, and grid6) + call pack77_5(nwords,w,i3,n3,c77) + if(i3.ge.0) go to 900 + +! It defaults to free text +800 i3=0 + n3=0 + msg(14:)=' ' + call packtext77(msg(1:13),c77(1:71)) + write(c77(72:77),'(2b3.3)') n3,i3 + +900 return +end subroutine pack77 + +subroutine unpack77(c77,nrx,msg,unpk77_success) +! +! nrx=1 when unpacking a received message +! nrx=0 when unpacking a to-be-transmitted message +! the value of nrx is used to decide when mycall13 or dxcall13 should +! be used in place of a callsign from the hashtable +! + parameter (NSEC=86) !Number of ARRL Sections + parameter (NUSCAN=171) !Number of States and Provinces + parameter (MAXGRID4=32400) + integer*8 n58 + integer ntel(3) + character*77 c77 + character*37 msg + character*13 call_1,call_2,call_3,call_1a + character*13 mycall13_0,dxcall13_0 + character*11 c11 + character*3 crpt,cntx,cpfx + character*3 cmult(NUSCAN) + character*6 cexch,grid6 + character*4 grid4,cserial + character*3 csec(NSEC) + character*38 c + character*36 a2 + integer hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22 + logical unpk28_success,unpk77_success,unpkg4_success + logical dxcall13_set,mycall13_set + + data a2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/,nzzz/46656/ + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ + data csec/ & + "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", & + "EMA","ENY","EPA","EWA","GA ","GH ","IA ","ID ","IL ","IN ", & + "KS ","KY ","LA ","LAX","NS ","MB ","MDC","ME ","MI ","MN ", & + "MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI", & + "NM ","NNJ","NNY","TER","NTX","NV ","OH ","OK ","ONE","ONN", & + "ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", & + "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", & + "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", & + "WV ","WWA","WY ","DX ","PE ","NB "/ + data cmult/ & + "AL ","AK ","AZ ","AR ","CA ","CO ","CT ","DE ","FL ","GA ", & + "HI ","ID ","IL ","IN ","IA ","KS ","KY ","LA ","ME ","MD ", & + "MA ","MI ","MN ","MS ","MO ","MT ","NE ","NV ","NH ","NJ ", & + "NM ","NY ","NC ","ND ","OH ","OK ","OR ","PA ","RI ","SC ", & + "SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ", & + "NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ", & + "LB ","NU ","YT ","PEI","DC ","DR ","FR ","GD ","GR ","OV ", & + "ZH ","ZL ","X01","X02","X03","X04","X05","X06","X07","X08", & + "X09","X10","X11","X12","X13","X14","X15","X16","X17","X18", & + "X19","X20","X21","X22","X23","X24","X25","X26","X27","X28", & + "X29","X30","X31","X32","X33","X34","X35","X36","X37","X38", & + "X39","X40","X41","X42","X43","X44","X45","X46","X47","X48", & + "X49","X50","X51","X52","X53","X54","X55","X56","X57","X58", & + "X59","X60","X61","X62","X63","X64","X65","X66","X67","X68", & + "X69","X70","X71","X72","X73","X74","X75","X76","X77","X78", & + "X79","X80","X81","X82","X83","X84","X85","X86","X87","X88", & + "X89","X90","X91","X92","X93","X94","X95","X96","X97","X98", & + "X99"/ + data dxcall13_set/.false./ + data mycall13_set/.false./ + data mycall13_0/''/ + data dxcall13_0/''/ + + save hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22 + + if(mycall13.ne.mycall13_0) then + if(len(trim(mycall13)).gt.2) then + mycall13_set=.true. + mycall13_0=mycall13 + call save_hash_call(mycall13,hashmy10,hashmy12,hashmy22) + else + mycall13_set=.false. + endif + endif + + if(dxcall13.ne.dxcall13_0) then + if(len(trim(dxcall13)).gt.2) then + dxcall13_set=.true. + dxcall13_0=dxcall13 + hashdx10=ihashcall(dxcall13,10) + hashdx12=ihashcall(dxcall13,12) + hashdx22=ihashcall(dxcall13,22) + endif + endif + unpk77_success=.true. + +! Check for bad data + do i=1,77 + if(c77(i:i).ne.'0' .and. c77(i:i).ne.'1') then + msg='failed unpack' + unpk77_success=.false. + return + endif + enddo + + read(c77(72:77),'(2b3)') n3,i3 + msg=repeat(' ',37) + + if(i3.eq.0 .and. n3.eq.0) then +! 0.0 Free text + call unpacktext77(c77(1:71),msg(1:13)) + msg(14:)=' ' + msg=adjustl(msg) + if(msg(1:1).eq.' ') then + unpk77_success=.false. + return + endif + + else if(i3.eq.0 .and. n3.eq.1) then +! 0.1 K1ABC RR73; W9XYZ -11 28 28 10 5 71 DXpedition Mode + read(c77,1010) n28a,n28b,n10,n5 +1010 format(2b28,b10,b5) + irpt=2*n5 - 30 + write(crpt,1012) irpt +1012 format(i3.2) + if(irpt.ge.0) crpt(1:1)='+' + call unpack28(n28a,call_1,unpk28_success) + if(.not.unpk28_success .or. n28a.le.2) unpk77_success=.false. + call unpack28(n28b,call_2,unpk28_success) + if(.not.unpk28_success .or. n28b.le.2) unpk77_success=.false. + call hash10(n10,call_3) + if(nrx.eq.1 .and. & + dxcall13_set .and. & + hashdx10.eq.n10) call_3='<'//trim(dxcall13)//'>' + if(nrx.eq.0 .and. & + mycall13_set .and. & + n10.eq.hashmy10) call_3='<'//trim(mycall13)//'>' + msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)//' '//crpt + + else if(i3.eq.0 .and. n3.eq.2) then + unpk77_success=.false. + + else if(i3.eq.0 .and. (n3.eq.3 .or. n3.eq.4)) then +! 0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day +! 0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day + read(c77,1030) n28a,n28b,ir,intx,nclass,isec +1030 format(2b28,b1,b4,b3,b7) + if(isec.gt.NSEC .or. isec.lt.1) then + unpk77_success=.false. + isec=1 + endif + call unpack28(n28a,call_1,unpk28_success) + if(.not.unpk28_success .or. n28a.le.2) unpk77_success=.false. + call unpack28(n28b,call_2,unpk28_success) + if(.not.unpk28_success .or. n28b.le.2) unpk77_success=.false. + ntx=intx+1 + if(n3.eq.4) ntx=ntx+16 + write(cntx(1:2),1032) ntx +1032 format(i2) + cntx(3:3)=char(ichar('A')+nclass) + if(ir.eq.0 .and. ntx.lt.10) msg=trim(call_1)//' '//trim(call_2)// & + cntx//' '//csec(isec) + if(ir.eq.1 .and. ntx.lt.10) msg=trim(call_1)//' '//trim(call_2)// & + ' R'//cntx//' '//csec(isec) + if(ir.eq.0 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// & + ' '//cntx//' '//csec(isec) + if(ir.eq.1 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// & + ' R '//cntx//' '//csec(isec) + + else if(i3.eq.0 .and. n3.eq.5) then +! 0.5 0123456789abcdef01 71 71 Telemetry (18 hex) + read(c77,1006) ntel +1006 format(b23,2b24) + write(msg,1007) ntel +1007 format(3z6.6) + do i=1,18 + if(msg(i:i).ne.'0') exit + msg(i:i)=' ' + enddo + msg=adjustl(msg) + + else if(i3.eq.0 .and. n3.eq.6) then + read(c77(48:50),'(3b1)') j48,j49,j50 +! bits 48:50 +! itype=1: x00 +! itype=2: xx1 +! itype=3: 010 + if(j50.eq.1) then + itype=2 + else if(j49.eq.0) then + itype=1 + else if(j48.eq.0) then + itype=3 + else + itype=-1 + unpk77_success=.false. + endif + + if(itype.eq.1) then +! WSPR Type 1 + read(c77,2010) n28,igrid4,idbm +2010 format(b28.28,b15.15,b5.5) + idbm=nint(idbm*10.0/3.0) + if(idbm.lt.0 .or. idbm.gt.60) unpk77_success=.false. + call unpack28(n28,call_1,unpk28_success) + if(.not.unpk28_success) unpk77_success=.false. + call to_grid4(igrid4,grid4,unpkg4_success) + if(.not.unpkg4_success) unpk77_success=.false. + write(crpt,'(i3)') idbm + msg=trim(call_1)//' '//grid4//' '//trim(adjustl(crpt)) + if (unpk77_success) call save_hash_call(call_1,n10,n12,n22) !### Is this OK here? ### + + else if(itype.eq.2) then +! WSPR Type 2 + read(c77,2020) n28,npfx,idbm +2020 format(b28.28,b16.16,b5.5) + idbm=nint(idbm*10.0/3.0) + if(idbm.lt.0 .or. idbm.gt.60) unpk77_success=.false. + call unpack28(n28,call_1,unpk28_success) + if(.not.unpk28_success) unpk77_success=.false. + write(crpt,'(i3)') idbm + cpfx=' ' + if(npfx.lt.nzzz) then +! Prefix + do i=3,1,-1 + j=mod(npfx,36)+1 + cpfx(i:i)=a2(j:j) + npfx=npfx/36 + if(npfx.eq.0) exit + enddo + msg=trim(adjustl(cpfx))//'/'//trim(call_1)//' '//trim(adjustl(crpt)) + call_1a=trim(adjustl(cpfx))//'/'//trim(call_1) + call save_hash_call(call_1a,n10,n12,n22) !### Is this OK here? ### + else +! Suffix + npfx=npfx-nzzz + if(npfx.le.35) then + cpfx(1:1)=a2(npfx+1:npfx+1) + else if(npfx.gt.35 .and. npfx.le.1295) then + cpfx(1:1)=a2(npfx/36+1:npfx/36+1) + cpfx(2:2)=a2(mod(npfx,36)+1:mod(npfx,36)+1) + else if(npfx.gt.1295 .and. npfx.le.12959) then + cpfx(1:1)=a2(npfx/360+1:npfx/360+1) + cpfx(2:2)=a2(mod(npfx/10,36)+1:mod(npfx/10,36)+1) + cpfx(3:3)=a2(mod(npfx,10)+1:mod(npfx,10)+1) + else + unpk77_success=.false. + return + endif + msg=trim(call_1)//'/'//trim(adjustl(cpfx))//' '//trim(adjustl(crpt)) + call_1a=trim(call_1)//'/'//trim(adjustl(cpfx)) + call save_hash_call(call_1a,n10,n12,n22) !### Is this OK here? ### + endif + + else if(itype.eq.3) then +! WSPR Type 3 + read(c77,2030) n22,igrid6 +2030 format(b22.22,b25.25) + n28=n22+2063592 + call unpack28(n28,call_1,unpk28_success) + if(.not.unpk28_success) unpk77_success=.false. + call to_grid(igrid6,grid6,unpkg4_success) + if(.not.unpkg4_success) unpk77_success=.false. + msg=trim(call_1)//' '//grid6 + endif + + else if(i3.eq.0 .and. n3.gt.6) then + unpk77_success=.false. + + else if(i3.eq.1 .or. i3.eq.2) then +! Type 1 (standard message) or Type 2 ("/P" form for EU VHF contest) + read(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3 +1000 format(2(b28,b1),b1,b15,b3) + call unpack28(n28a,call_1,unpk28_success) + if(nrx.eq.1 .and. mycall13_set .and. hashmy22.eq.(n28a-2063592)) then + call_1='<'//trim(mycall13)//'>' + unpk28_success=.true. + endif + if(.not.unpk28_success) unpk77_success=.false. + call unpack28(n28b,call_2,unpk28_success) + if(.not.unpk28_success) unpk77_success=.false. + if(call_1(1:3).eq.'CQ_') call_1(3:3)=' ' + if(index(call_1,'<').le.0) then + i=index(call_1,' ') + if(i.ge.4 .and. ipa.eq.1 .and. i3.eq.1) call_1(i:i+1)='/R' + if(i.ge.4 .and. ipa.eq.1 .and. i3.eq.2) call_1(i:i+1)='/P' + if(i.ge.4) call add_call_to_recent_calls(call_1) + endif + if(index(call_2,'<').le.0) then + i=index(call_2,' ') + if(i.ge.4 .and. ipb.eq.1 .and. i3.eq.1) call_2(i:i+1)='/R' + if(i.ge.4 .and. ipb.eq.1 .and. i3.eq.2) call_2(i:i+1)='/P' + if(i.ge.4) call add_call_to_recent_calls(call_2) + endif + if(igrid4.le.MAXGRID4) then + call to_grid4(igrid4,grid4,unpkg4_success) + if(.not.unpkg4_success) unpk77_success=.false. + if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//grid4 + if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R '//grid4 + if(msg(1:3).eq.'CQ ' .and. ir.eq.1) unpk77_success=.false. + else + irpt=igrid4-MAXGRID4 + if(irpt.eq.1) msg=trim(call_1)//' '//trim(call_2) + if(irpt.eq.2) msg=trim(call_1)//' '//trim(call_2)//' RRR' + if(irpt.eq.3) msg=trim(call_1)//' '//trim(call_2)//' RR73' + if(irpt.eq.4) msg=trim(call_1)//' '//trim(call_2)//' 73' + if(irpt.ge.5) then + isnr=irpt-35 + if(isnr.gt.50) isnr=isnr-101 + write(crpt,'(i3.2)') isnr + if(crpt(1:1).eq.' ') crpt(1:1)='+' + if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//crpt + if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R'//crpt + endif + if(msg(1:3).eq.'CQ ' .and. irpt.ge.2) unpk77_success=.false. + endif + + else if(i3.eq.3) then +! Type 3: ARRL RTTY Contest + read(c77,1040) itu,n28a,n28b,ir,irpt,nexch,i3 +1040 format(b1,2b28.28,b1,b3.3,b13.13,b3.3) + write(crpt,1042) irpt+2 +1042 format('5',i1,'9') + nserial=nexch + imult=-1 + if(nexch.gt.8000) then + imult=nexch-8000 + nserial=-1 + endif + call unpack28(n28a,call_1,unpk28_success) + if(.not.unpk28_success) unpk77_success=.false. + call unpack28(n28b,call_2,unpk28_success) + if(.not.unpk28_success) unpk77_success=.false. + imult=0 + nserial=0 + if(nexch.gt.8000) imult=nexch-8000 + if(nexch.lt.8000) nserial=nexch + + if(imult.ge.1 .and.imult.le.NUSCAN) then + if(itu.eq.0 .and. ir.eq.0) msg=trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cmult(imult) + if(itu.eq.1 .and. ir.eq.0) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cmult(imult) + if(itu.eq.0 .and. ir.eq.1) msg=trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cmult(imult) + if(itu.eq.1 .and. ir.eq.1) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cmult(imult) + else if(nserial.ge.1 .and. nserial.le.7999) then + write(cserial,'(i4.4)') nserial + if(itu.eq.0 .and. ir.eq.0) msg=trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cserial + if(itu.eq.1 .and. ir.eq.0) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cserial + if(itu.eq.0 .and. ir.eq.1) msg=trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cserial + if(itu.eq.1 .and. ir.eq.1) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cserial + endif + else if(i3.eq.4) then +! Type 4 + read(c77,1050) n12,n58,iflip,nrpt,icq +1050 format(b12,b58,b1,b2,b1) + do i=11,1,-1 + j=mod(n58,38)+1 + c11(i:i)=c(j:j) + n58=n58/38 + enddo + call hash12(n12,call_3) + if(iflip.eq.0) then ! 12 bit hash for TO call + call_1=call_3 + call_2=adjustl(c11)//' ' + call add_call_to_recent_calls(call_2) + if(nrx.eq.1 .and. & + dxcall13_set .and. mycall13_set .and. & + call_2.eq.dxcall13 .and. & + n12.eq.hashmy12 ) call_1='<'//trim(mycall13)//'>' + if(nrx.eq.1 .and. & + mycall13_set .and. & + index(call_1,'<...>').gt.0 .and. & + n12.eq.hashmy12 ) call_1='<'//trim(mycall13)//'>' + else ! 12 bit hash for DE call + call_1=adjustl(c11) + call_2=call_3 + call add_call_to_recent_calls(call_1) + if(nrx.eq.0 .and. & + mycall13_set .and. & + n12.eq.hashmy12) call_2='<'//trim(mycall13)//'>' + endif + if(icq.eq.0) then + if(nrpt.eq.0) msg=trim(call_1)//' '//trim(call_2) + if(nrpt.eq.1) msg=trim(call_1)//' '//trim(call_2)//' RRR' + if(nrpt.eq.2) msg=trim(call_1)//' '//trim(call_2)//' RR73' + if(nrpt.eq.3) msg=trim(call_1)//' '//trim(call_2)//' 73' + else + msg='CQ '//trim(call_2) + endif + + else if(i3.eq.5) then + +! Type 5 R 590003 IO91NP h12 h22 r1 s3 S11 g25 +! EU VHF contest + read(c77,1060) n12,n22,ir,irpt,iserial,igrid6 +1060 format(b12,b22,b1,b3,b11,b25) + if(igrid6.lt.0 .or. igrid6.gt.18662399) then + unpk77_success=.false. + return + endif + call hash12(n12,call_1) + if(n12.eq.hashmy12) call_1='<'//trim(mycall13)//'>' + call hash22(n22,call_2) + nrs=52+irpt + write(cexch,1022) nrs,iserial +1022 format(i2,i4.4) + call to_grid6(igrid6,grid6,unpk77_success) + if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//cexch//' '//grid6 + if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R '//cexch//' '//grid6 + + else if(i3.ge.6) then ! i3 values 6 and 7 are not yet defined + unpk77_success=.false. + endif + if(msg(1:4).eq.'CQ <') unpk77_success=.false. + + return +end subroutine unpack77 + +subroutine pack28(c13,n28) + +! Pack a special token, a 22-bit hash code, or a valid base call into a 28-bit +! integer. + + parameter (NTOKENS=2063592,MAX22=4194304) + logical is_digit,is_letter + character*13 c13 + character*6 callsign + character*1 c + character*4 c4 + character*37 a1 + character*36 a2 + character*10 a3 + character*27 a4 + data a1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data a2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data a3/'0123456789'/ + data a4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + + is_digit(c)=c.ge.'0' .and. c.le.'9' + is_letter(c)=c.ge.'A' .and. c.le.'Z' + + n28=-1 +! Work-around for Swaziland prefix: + if(c13(1:4).eq.'3DA0') callsign='3D0'//c13(5:7) +! Work-around for Guinea prefixes: + if(c13(1:2).eq.'3X' .and. c13(3:3).ge.'A' .and. & + c13(3:3).le.'Z') callsign='Q'//c13(3:6) + +! Check for special tokens first + if(c13(1:3).eq.'DE ') then + n28=0 + go to 900 + endif + + if(c13(1:4).eq.'QRZ ') then + n28=1 + go to 900 + endif + + if(c13(1:3).eq.'CQ ') then + n28=2 + go to 900 + endif + + if(c13(1:3).eq.'CQ_') then + n=len(trim(c13)) + if(n.ge.4 .and. n.le.7) then + nlet=0 + nnum=0 + do i=4,n + c=c13(i:i) + if(c.ge.'A' .and. c.le.'Z') nlet=nlet+1 + if(c.ge.'0' .and. c.le.'9') nnum=nnum+1 + enddo + if(nnum.eq.3 .and. nlet.eq.0) then + read(c13(4:3+nnum),*) nqsy + n28=3+nqsy + go to 900 + endif + if(nlet.ge.1 .and. nlet.le.4 .and. nnum.eq.0) then + c4=c13(4:n) + c4=adjustr(c4) + m=0 + do i=1,4 + j=0 + c=c4(i:i) + if(c.ge.'A' .and. c.le.'Z') j=ichar(c)-ichar('A')+1 + m=27*m + j + enddo + n28=3+1000+m + go to 900 + endif + endif + endif + +! Check for <...> callsign + if(c13(1:1).eq.'<')then + call save_hash_call(c13,n10,n12,n22) !Save callsign in hash table + i2=index(c13,'>') + c13=c13(2:i2-1) + n22=ihashcall(c13,22) + n28=NTOKENS + n22 + go to 900 + endif + +! Check for standard callsign + iarea=-1 + n=len(trim(c13)) + do i=n,2,-1 + if(is_digit(c13(i:i))) exit + enddo + iarea=i !Call-area digit + npdig=0 !Digits before call area + nplet=0 !Letters before call area + do i=1,iarea-1 + if(is_digit(c13(i:i))) npdig=npdig+1 + if(is_letter(c13(i:i))) nplet=nplet+1 + enddo + nslet=0 + do i=iarea+1,n + if(is_letter(c13(i:i))) nslet=nslet+1 + enddo + if(iarea.lt.2 .or. iarea.gt.3 .or. nplet.eq.0 .or. & + npdig.ge.iarea-1 .or. nslet.gt.3) then +! Treat this as a nonstandard callsign: compute its 22-bit hash + call save_hash_call(c13,n10,n12,n22) !Save callsign in hash table + n22=ihashcall(c13,22) + n28=NTOKENS + n22 + go to 900 + endif + + n=len(trim(c13)) +! This is a standard callsign + call save_hash_call(c13,n10,n12,n22) !Save callsign in hash table + if(iarea.eq.2) callsign=' '//c13(1:5) + if(iarea.eq.3) callsign=c13(1:6) + i1=index(a1,callsign(1:1))-1 + i2=index(a2,callsign(2:2))-1 + i3=index(a3,callsign(3:3))-1 + i4=index(a4,callsign(4:4))-1 + i5=index(a4,callsign(5:5))-1 + i6=index(a4,callsign(6:6))-1 + n28=36*10*27*27*27*i1 + 10*27*27*27*i2 + 27*27*27*i3 + 27*27*i4 + & + 27*i5 + i6 + n28=n28 + NTOKENS + MAX22 + +900 n28=iand(n28,ishft(1,28)-1) + return +end subroutine pack28 + + +subroutine unpack28(n28_0,c13,success) + + parameter (NTOKENS=2063592,MAX22=4194304) + logical success + character*13 c13 + character*37 c1 + character*36 c2 + character*10 c3 + character*27 c4 + data c1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data c2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data c3/'0123456789'/ + data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + + success=.true. + n28=n28_0 + if(n28.lt.NTOKENS) then +! Special tokens DE, QRZ, CQ, CQ_nnn, CQ_aaaa + if(n28.eq.0) c13='DE ' + if(n28.eq.1) c13='QRZ ' + if(n28.eq.2) c13='CQ ' + if(n28.le.2) go to 900 + if(n28.le.1002) then + write(c13,1002) n28-3 +1002 format('CQ_',i3.3) + go to 900 + endif + if(n28.le.532443) then + n=n28-1003 + n0=n + i1=n/(27*27*27) + n=n-27*27*27*i1 + i2=n/(27*27) + n=n-27*27*i2 + i3=n/27 + i4=n-27*i3 + c13=c4(i1+1:i1+1)//c4(i2+1:i2+1)//c4(i3+1:i3+1)//c4(i4+1:i4+1) + c13=adjustl(c13) + c13='CQ_'//c13(1:10) + go to 900 + endif + endif + n28=n28-NTOKENS + if(n28.lt.MAX22) then +! This is a 22-bit hash of a callsign + n22=n28 + call hash22(n22,c13) !Retrieve callsign from hash table + go to 900 + endif + +! Standard callsign + n=n28 - MAX22 + i1=n/(36*10*27*27*27) + n=n-36*10*27*27*27*i1 + i2=n/(10*27*27*27) + n=n-10*27*27*27*i2 + i3=n/(27*27*27) + n=n-27*27*27*i3 + i4=n/(27*27) + n=n-27*27*i4 + i5=n/27 + i6=n-27*i5 + c13=c1(i1+1:i1+1)//c2(i2+1:i2+1)//c3(i3+1:i3+1)//c4(i4+1:i4+1)// & + c4(i5+1:i5+1)//c4(i6+1:i6+1) + c13=adjustl(c13) + +900 i0=index(c13,' ') + if(i0.ne.0 .and. i0.lt.len(trim(c13))) then + c13='QU1RK' + success=.false. + endif + return +end subroutine unpack28 + +subroutine split77(msg,nwords,nw,w) + +! Convert msg to upper case; collapse multiple blanks; parse into words. + + character*37 msg + character*13 w(19) + character*1 c,c0 + character*6 bcall_1 + logical ok1 + integer nw(19) + + iz=len(trim(msg)) + j=0 + k=0 + n=0 + c0=' ' + w=' ' + do i=1,iz + if(ichar(msg(i:i)).eq.0) msg(i:i)=' ' + c=msg(i:i) !Single character + if(c.eq.' ' .and. c0.eq.' ') cycle !Skip leading/repeated blanks + if(c.ne.' ' .and. c0.eq.' ') then + k=k+1 !New word + n=0 + endif + j=j+1 !Index in msg + n=n+1 !Index in word + if(c.ge.'a' .and. c.le.'z') c=char(ichar(c)-32) !Force upper case + msg(j:j)=c + if(n.le.13) w(k)(n:n)=c !Copy character c into word + c0=c + enddo + iz=j !Message length + nwords=k !Number of words in msg + if(nwords.le.0) go to 900 + do i=1,nwords + nw(i)=len(trim(w(i))) + enddo + msg(iz+1:)=' ' + if(nwords.lt.3) go to 900 + call chkcall(w(3),bcall_1,ok1) + if(ok1 .and. w(1)(1:3).eq.'CQ ') then + w(1)='CQ_'//w(2)(1:10) !Make "CQ " into "CQ_" + w(2:12)=w(3:13) !Move all remaining words down by one + nwords=nwords-1 + endif + +900 return +end subroutine split77 + + +subroutine pack77_01(nwords,w,i3,n3,c77) + +! Pack a Type 0.1 message: DXpedition mode +! Example message: "K1ABC RR73; W9XYZ -11" 28 28 10 5 + + character*13 w(19),c13 + character*77 c77 + character*6 bcall_1,bcall_2 + logical ok1,ok2 + + if(nwords.ne.5) go to 900 !Must have 5 words + if(trim(w(2)).ne.'RR73;') go to 900 !2nd word must be "RR73;" + if(w(4)(1:1).ne.'<') go to 900 !4th word must have <...> + if(index(w(4),'>').lt.1) go to 900 + n=-99 + read(w(5),*,err=1) n +1 if(n.eq.-99) go to 900 !5th word must be a valid report + n5=(n+30)/2 + if(n5.lt.0) n5=0 + if(n5.gt.31) n5=31 + call chkcall(w(1),bcall_1,ok1) + if(.not.ok1) go to 900 !1st word must be a valid basecall + call chkcall(w(3),bcall_2,ok2) + if(.not.ok2) go to 900 !3rd word must be a valid basecall + +! Type 0.1: K1ABC RR73; W9XYZ -11 28 28 10 5 71 + i3=0 + n3=1 + call pack28(w(1),n28a) + call pack28(w(3),n28b) + call save_hash_call(w(4),n10,n12,n22) + i2=index(w(4),'>') + c13=w(4)(2:i2-1) + n10=ihashcall(c13,10) + write(c77,1010) n28a,n28b,n10,n5,n3,i3 +1010 format(2b28.28,b10.10,b5.5,2b3.3) + +900 return +end subroutine pack77_01 + + +subroutine pack77_03(nwords,w,i3,n3,c77) + +! Check 0.3 and 0.4 (ARRL Field Day exchange) +! Example message: WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 + + parameter (NSEC=86) !Number of ARRL Sections + character*13 w(19) + character*77 c77 + character*6 bcall_1,bcall_2 + character*3 csec(NSEC) + logical ok1,ok2 + data csec/ & + "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", & + "EMA","ENY","EPA","EWA","GA ","GH ","IA ","ID ","IL ","IN ", & + "KS ","KY ","LA ","LAX","NS ","MB ","MDC","ME ","MI ","MN ", & + "MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI", & + "NM ","NNJ","NNY","TER","NTX","NV ","OH ","OK ","ONE","ONN", & + "ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", & + "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", & + "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", & + "WV ","WWA","WY ","DX ","PE ","NB "/ + + if(nwords.lt.4 .or. nwords.gt.5) return + call chkcall(w(1),bcall_1,ok1) + call chkcall(w(2),bcall_2,ok2) + if(.not.ok1 .or. .not.ok2) return + isec=-1 + do i=1,NSEC + if(csec(i).eq.w(nwords)(1:3)) then + isec=i + exit + endif + enddo + if(isec.eq.-1) return + if(nwords.eq.5 .and. trim(w(3)).ne.'R') return + + ntx=-1 + j=len(trim(w(nwords-1)))-1 + read(w(nwords-1)(1:j),*,err=1,end=1) ntx !Number of transmitters +1 if(ntx.lt.1 .or. ntx.gt.32) return + nclass=ichar(w(nwords-1)(j+1:j+1))-ichar('A') + + m=len(trim(w(nwords))) !Length of section abbreviation + if(m.lt.2 .or. m.gt.3) return + +! 0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day +! 0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day + + i3=0 + n3=3 !Type 0.3 ARRL Field Day + intx=ntx-1 + if(intx.ge.16) then + n3=4 !Type 0.4 ARRL Field Day + intx=ntx-17 + endif + call pack28(w(1),n28a) + call pack28(w(2),n28b) + ir=0 + if(w(3)(1:2).eq.'R ') ir=1 + write(c77,1010) n28a,n28b,ir,intx,nclass,isec,n3,i3 +1010 format(2b28.28,b1,b4.4,b3.3,b7.7,2b3.3) + + return +end subroutine pack77_03 + + +subroutine pack77_06(nwords,w,i3,n3,c77,i3_hint,n3_hint) + + character*13 w(19) + character*77 c77 + character*6 bcall,grid6 + character*4 grid4 + character*1 c + character*36 a2 + data a2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/,nzzz/46656/ + + logical is_grid4,is_grid6,is_digit,ok + is_grid4(grid4)=len(trim(grid4)).eq.4 .and. & + grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and. & + grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and. & + grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. & + grid4(4:4).ge.'0' .and. grid4(4:4).le.'9' + + is_grid6(grid6)=(len(trim(grid6)).eq.6.or.len(trim(grid6)).eq.4).and. & + grid6(1:1).ge.'A' .and. grid6(1:1).le.'R' .and. & + grid6(2:2).ge.'A' .and. grid6(2:2).le.'R' .and. & + grid6(3:3).ge.'0' .and. grid6(3:3).le.'9' .and. & + grid6(4:4).ge.'0' .and. grid6(4:4).le.'9' .and. & + (len(trim(grid6)).eq.4.or. & + (grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. & + grid6(6:6).ge.'A' .and. grid6(6:6).le.'X')) + + is_digit(c)=c.ge.'0' .and. c.le.'9' + + m1=len(trim(w(1))) + m2=len(trim(w(2))) + m3=len(trim(w(3))) + if(nwords.eq.3 .and. m1.ge.3 .and. m1.le.6 .and. m2.eq.4 .and. m3.le.2) then +! WSPR Type 1 + if(.not.is_grid4(w(2)(1:4))) go to 900 + if(.not.is_digit(w(3)(1:1))) go to 900 + if(m3.eq.2) then + if(.not.is_digit(w(3)(2:2))) go to 900 + endif + i3=0 + n3=6 + call pack28(w(1),n28) + grid4=w(2)(1:4) + k1=(ichar(grid4(1:1))-ichar('A'))*18*10*10 + k2=(ichar(grid4(2:2))-ichar('A'))*10*10 + k3=(ichar(grid4(3:3))-ichar('0'))*10 + k4=(ichar(grid4(4:4))-ichar('0')) + igrid4=k1+k2+k3+k4 + read(w(3),*) idbm + if(idbm.lt.0) idbm=0 + if(idbm.gt.60) idbm=60 + idbm=nint(0.3*idbm) + write(c77,1010) n28,igrid4,idbm,0,0,0,n3,i3 +1010 format(b28.28,b15.15,b5.5,2i1,b21.21,2b3.3) + go to 900 + endif + if(nwords.eq.2 .and. m1.ge.5 .and. m1.le.10 .and. m2.le.2) then +! WSPR Type 2 + i1=index(w(1),'/') + if(i1.lt.2 .or. i1.eq.m1) go to 900 + if(.not.is_digit(w(2)(1:1))) go to 900 + if(i1.eq.(m1-3) .and. .not.is_digit(w(1)(m1:m1))) go to 900 + if(m2.eq.2) then + if(.not.is_digit(w(2)(2:2))) go to 900 + endif + call chkcall(w(1),bcall,ok) + if(.not.ok) go to 900 + if(i1.le.4) then +! We have a prefix + npfx=index(a2,w(1)(1:1))-1 + if(i1.ge.3) npfx=36*npfx + index(a2,w(1)(2:2))-1 + if(i1.eq.4) npfx=36*npfx + index(a2,w(1)(3:3))-1 + else +! We have a suffix + if((m1-i1).eq.1) npfx=index(a2,w(1)(i1+1:i1+1))-1 + if((m1-i1).eq.2) npfx=36*(index(a2,w(1)(i1+1:i1+1))-1) + & + index(a2,w(1)(i1+2:i1+2))-1 + if((m1-i1).eq.3) then +! Third character of a suffix must be a digit + if(.not.is_digit(w(1)(i1+3:i1+3))) go to 900 + npfx=36*10*(index(a2,w(1)(i1+1:i1+1))-1) + & + 10*(index(a2,w(1)(i1+2:i1+2))-1) + index(a2,w(1)(i1+3:i1+3))-1 + endif + npfx=npfx + nzzz + endif + i3=0 + n3=6 + call pack28(bcall//' ',n28) + read(w(2),*) idbm + if(idbm.lt.0) idbm=0 + if(idbm.gt.60) idbm=60 + idbm=nint(0.3*idbm) + write(c77,1020) n28,npfx,idbm,1,0,n3,i3 +1020 format(b28.28,b16.16,b5.5,i1,b21.21,2b3.3) + go to 900 + endif + + if(i3_hint.eq.0.and.n3_hint.eq.6.and.nwords.eq.2 .and. m1.ge.5 & + .and. m1.le.12 .and. m2.le.6) then +! WSPR Type 3 + + !n3_hint=6 and i3_hint=0 is a hint that the caller wanted a + !50-bit encoding rather than the possible alternative n3=4 77-bit + !encoding + if(index(w(1),'<').lt.1 .or. index(w(1),'>').lt.1) go to 900 + grid6=w(2)(1:6) + if(.not.is_grid6(grid6)) go to 900 + i3=0 + n3=6 + call pack28(w(1),n28) + n22=n28-2063592 + k1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*25*25 + k2=(ichar(grid6(2:2))-ichar('A'))*10*10*25*25 + k3=(ichar(grid6(3:3))-ichar('0'))*10*25*25 + k4=(ichar(grid6(4:4))-ichar('0'))*25*25 + if (grid6(5:6).eq.' ') then + igrid6=k1+k2+k3+k4+24*25+24 + else + k5=(ichar(grid6(5:5))-ichar('A'))*25 + k6=(ichar(grid6(6:6))-ichar('A')) + igrid6=k1+k2+k3+k4+k5+k6 + endif + write(c77,1030) n22,igrid6,2,0,n3,i3 +1030 format(b22.22,b25.25,b3.3,b21.21,2b3.3) + endif + +900 return +end subroutine pack77_06 + + +subroutine pack77_1(nwords,w,i3,n3,c77) + +! Check Type 1 (Standard 77-bit message) and Type 2 (ditto, with a "/P" call) +! Example message: WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 + + parameter (MAXGRID4=32400) + character*13 w(19),c13 + character*77 c77 + character*6 bcall_1,bcall_2 + character*4 grid4 + character c1*1,c2*2 + logical is_grid4 + logical ok1,ok2 + is_grid4(grid4)=len(trim(grid4)).eq.4 .and. & + grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and. & + grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and. & + grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. & + grid4(4:4).ge.'0' .and. grid4(4:4).le.'9' + + if(nwords.lt.2 .or. nwords.gt.4) return + call chkcall(w(1),bcall_1,ok1) + call chkcall(w(2),bcall_2,ok2) + if(w(1)(1:3).eq.'DE ' .or. w(1)(1:3).eq.'CQ_' .or. w(1)(1:3).eq.'CQ ' .or. & + w(1)(1:4).eq.'QRZ ') ok1=.true. + if(w(1)(1:1).eq.'<' .and. index(w(1),'>').ge.5) ok1=.true. + if(w(2)(1:1).eq.'<' .and. index(w(2),'>').ge.5) ok2=.true. + if(.not.ok1 .or. .not.ok2) return + if(w(1)(1:1).eq.'<' .and. index(w(2),'/').gt.0) return + if(w(2)(1:1).eq.'<' .and. index(w(1),'/').gt.0) return + if(nwords.eq.2 .and. (.not.ok2 .or. index(w(2),'/').ge.2)) return + if(nwords.eq.2) go to 10 + + c1=w(nwords)(1:1) + c2=w(nwords)(1:2) + if(.not.is_grid4(w(nwords)(1:4)) .and. c1.ne.'+' .and. c1.ne.'-' & + .and. c2.ne.'R+' .and. c2.ne.'R-' .and. trim(w(nwords)).ne.'RRR' .and. & + trim(w(nwords)).ne.'RR73' .and. trim(w(nwords)).ne.'73') return + if(c1.eq.'+' .or. c1.eq.'-') then + ir=0 + read(w(nwords),*,err=900) irpt + if(irpt.ge.-50 .and. irpt.le.-31) irpt=irpt+101 + irpt=irpt+35 + else if(c2.eq.'R+' .or. c2.eq.'R-') then + ir=1 + read(w(nwords)(2:),*,err=900) irpt + if(irpt.ge.-50 .and. irpt.le.-31) irpt=irpt+101 + irpt=irpt+35 + else if(trim(w(nwords)).eq.'RRR') then + ir=0 + irpt=2 + else if(trim(w(nwords)).eq.'RR73') then + ir=0 + irpt=3 + else if(trim(w(nwords)).eq.'73') then + ir=0 + irpt=4 + endif + +! 1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg +! 2 PA3XYZ/P GM4ABC/P R JO22 28 1 28 1 1 15 74 EU VHF contest + +10 i1psuffix=index(w(1)//' ' ,'/P ') + i2psuffix=index(w(2)//' ','/P ') + if(nwords.eq.2 .or. nwords.eq.3 .or. (nwords.eq.4 .and. & + w(3)(1:2).eq.'R ')) then + n3=0 + i3=1 !Type 1: Standard message, possibly with "/R" + if (i1psuffix.ge.4.or.i2psuffix.ge.4) i3=2 !Type 2, with "/P" + endif + c13=bcall_1 + if(c13(1:3).eq.'CQ_' .or. w(1)(1:1).eq.'<') c13=w(1) + call pack28(c13,n28a) + c13=bcall_2 + if(w(2)(1:1).eq.'<') c13=w(2) + call pack28(c13,n28b) + ipa=0 + ipb=0 + if(i1psuffix.ge.4.or.index(w(1)//' ','/R ').ge.4) ipa=1 + if(i2psuffix.ge.4.or.index(w(2)//' ','/R ').ge.4) ipb=1 + + grid4=w(nwords)(1:4) + if(is_grid4(grid4)) then + ir=0 + if(w(3).eq.'R ') ir=1 + j1=(ichar(grid4(1:1))-ichar('A'))*18*10*10 + j2=(ichar(grid4(2:2))-ichar('A'))*10*10 + j3=(ichar(grid4(3:3))-ichar('0'))*10 + j4=(ichar(grid4(4:4))-ichar('0')) + igrid4=j1+j2+j3+j4 + else + igrid4=MAXGRID4 + irpt + endif + if(nwords.eq.2) then + ir=0 + irpt=1 + igrid4=MAXGRID4+irpt + endif + write(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3 +1000 format(2(b28.28,b1),b1,b15.15,b3.3) + return + +900 return +end subroutine pack77_1 + + +subroutine pack77_3(nwords,w,i3,n3,c77) + +! Check Type 3 (ARRL RTTY contest exchange) +! ARRL RTTY - US/Can: rpt state/prov R 579 MA +! - DX: rpt serial R 559 0013 +! Example message: TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 + + parameter (NUSCAN=171) !Number of US states and Canadian provinces/territories + character*13 w(19) + character*77 c77 + character*6 bcall_1,bcall_2 + character*3 cmult(NUSCAN),mult + character crpt*3 + logical ok1,ok2 + data cmult/ & + "AL ","AK ","AZ ","AR ","CA ","CO ","CT ","DE ","FL ","GA ", & + "HI ","ID ","IL ","IN ","IA ","KS ","KY ","LA ","ME ","MD ", & + "MA ","MI ","MN ","MS ","MO ","MT ","NE ","NV ","NH ","NJ ", & + "NM ","NY ","NC ","ND ","OH ","OK ","OR ","PA ","RI ","SC ", & + "SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ", & + "NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ", & + "LB ","NU ","YT ","PEI","DC ","DR ","FR ","GD ","GR ","OV ", & + "ZH ","ZL ","X01","X02","X03","X04","X05","X06","X07","X08", & + "X09","X10","X11","X12","X13","X14","X15","X16","X17","X18", & + "X19","X20","X21","X22","X23","X24","X25","X26","X27","X28", & + "X29","X30","X31","X32","X33","X34","X35","X36","X37","X38", & + "X39","X40","X41","X42","X43","X44","X45","X46","X47","X48", & + "X49","X50","X51","X52","X53","X54","X55","X56","X57","X58", & + "X59","X60","X61","X62","X63","X64","X65","X66","X67","X68", & + "X69","X70","X71","X72","X73","X74","X75","X76","X77","X78", & + "X79","X80","X81","X82","X83","X84","X85","X86","X87","X88", & + "X89","X90","X91","X92","X93","X94","X95","X96","X97","X98", & + "X99"/ + + if(w(1)(1:1).eq.'<' .and. w(2)(1:1).eq.'<') go to 900 + if(nwords.eq.4 .or. nwords.eq.5 .or. nwords.eq.6) then + i1=1 + if(trim(w(1)).eq.'TU;') i1=2 + call chkcall(w(i1),bcall_1,ok1) + call chkcall(w(i1+1),bcall_2,ok2) + if(.not.ok1 .or. .not.ok2) go to 900 + crpt=w(nwords-1)(1:3) + if(index(crpt,'-').ge.1 .or. index(crpt,'+').ge.1) go to 900 + if(crpt(1:1).eq.'5' .and. crpt(2:2).ge.'2' .and. crpt(2:2).le.'9' .and. & + crpt(3:3).eq.'9') then + nserial=0 + read(w(nwords),*,err=1) nserial + endif +1 mult=' ' + imult=-1 + do i=1,NUSCAN + if(cmult(i).eq.w(nwords)) then + imult=i + mult=cmult(i) + exit + endif + enddo + nexch=0 + if(nserial.gt.0) nexch=nserial + if(imult.gt.0) nexch=8000+imult + if(mult.ne.' ' .or. nserial.gt.0) then + i3=3 + n3=0 + itu=0 + if(trim(w(1)).eq.'TU;') itu=1 + call pack28(w(1+itu),n28a) + call pack28(w(2+itu),n28b) + ir=0 + if(w(3+itu)(1:2).eq.'R ') ir=1 + read(w(3+itu+ir),*,err=900) irpt + irpt=(irpt-509)/10 - 2 + if(irpt.lt.0) irpt=0 + if(irpt.gt.7) irpt=7 +! 3 TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY contest +! 3 TU; W9XYZ G8ABC R 559 0013 1 28 28 1 3 13 74 ARRL RTTY (DX) + write(c77,1010) itu,n28a,n28b,ir,irpt,nexch,i3 +1010 format(b1,2b28.28,b1,b3.3,b13.13,b3.3) + endif + endif + +900 return +end subroutine pack77_3 + + +subroutine pack77_4(nwords,w,i3,n3,c77) + +! Check Type 4 (One nonstandard call and one hashed call) +! Example message: PJ4/KA1ABC RR73 12 58 1 2 1 74 + + integer*8 n58 + logical ok1,ok2 + character*13 w(19) + character*77 c77 + character*13 call_1,call_2 + character*11 c11 + character*6 bcall_1,bcall_2 + character*38 c + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ + + iflip=0 + i3=-1 + if(nwords.eq.2 .or. nwords.eq.3) then + call_1=w(1) + if(call_1(1:1).eq.'<') call_1=w(1)(2:len(trim(w(1)))-1) + call_2=w(2) + if(call_2(1:1).eq.'<') call_2=w(2)(2:len(trim(w(2)))-1) + call chkcall(call_1,bcall_1,ok1) + call chkcall(call_2,bcall_2,ok2) + if(call_1.eq.bcall_1 .and. call_2.eq.bcall_2 .and. ok1 .and. ok2) go to 900 + icq=0 + if(trim(w(1)).eq.'CQ' .or. (ok1.and.ok2)) then + if(trim(w(1)).eq.'CQ' .and. len(trim(w(2))).le.4) go to 900 + i3=4 + n3=0 + if(trim(w(1)).eq.'CQ') icq=1 + endif + + if(icq.eq.1) then + iflip=0 + n12=0 + c11=adjustr(call_2(1:11)) + call save_hash_call(w(2),n10,n12,n22) + else if(w(1)(1:1).eq.'<') then + iflip=0 + i3=4 + call save_hash_call(w(1),n10,n12,n22) + c11=adjustr(call_2(1:11)) + else if(w(2)(1:1).eq.'<') then + iflip=1 + i3=4 + call save_hash_call(w(2),n10,n12,n22) + c11=adjustr(call_1(1:11)) + endif + n58=0 + do i=1,11 + n58=n58*38 + index(c,c11(i:i)) - 1 + enddo + nrpt=0 + if(trim(w(3)).eq.'RRR') nrpt=1 + if(trim(w(3)).eq.'RR73') nrpt=2 + if(trim(w(3)).eq.'73') nrpt=3 + if(icq.eq.1) then + iflip=0 + nrpt=0 + endif + write(c77,1010) n12,n58,iflip,nrpt,icq,i3 +1010 format(b12.12,b58.58,b1,b2.2,b1,b3.3) + do i=1,77 + if(c77(i:i).eq.'*') c77(i:i)='0' !### Clean up any illegal chars ### + enddo + endif + +900 return +end subroutine pack77_4 + +subroutine pack77_5(nwords,w,i3,n3,c77) + +! Pack a Type 0.2 message: EU VHF Contest mode +! Example message: PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 +! R 590003 IO91NP h10 h20 r1 s3 s12 g25 + + character*13 w(19),c13 + character*77 c77 + character*6 grid6 + logical is_grid6 + + is_grid6(grid6)=len(trim(grid6)).eq.6 .and. & + grid6(1:1).ge.'A' .and. grid6(1:1).le.'R' .and. & + grid6(2:2).ge.'A' .and. grid6(2:2).le.'R' .and. & + grid6(3:3).ge.'0' .and. grid6(3:3).le.'9' .and. & + grid6(4:4).ge.'0' .and. grid6(4:4).le.'9' .and. & + grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. & + grid6(6:6).ge.'A' .and. grid6(6:6).le.'X' + + if(nwords.lt.4 .or. nwords.gt.5) return !nwords must be 4 or 5 + if(w(1)(1:1).ne.'<' .or. w(2)(1:1).ne.'<') return !Both calls must be hashed + nx=-1 + read(w(nwords-1),*,err=2) nx +2 if(nx.lt.520001 .or. nx.gt.594095) return !Exchange between 520001 - 594095 + if(.not.is_grid6(w(nwords)(1:6))) return !Last word must be a valid grid6 + +! Type 0.2: R 590003 IO91NP h10 h20 r1 s3 s12 g25 + + i3=5 + n3=0 + + call save_hash_call(w(1),n10,n12,n22) + i2=index(w(1),'>') + c13=w(1)(2:i2-1) + n12=ihashcall(c13,12) + + call save_hash_call(w(2),n10a,n12a,n22) + i2=index(w(2),'>') + c13=w(2)(2:i2-1) + n22=ihashcall(c13,22) + + ir=0 + if(w(3)(1:2).eq.'R ') ir=1 + irpt=nx/10000 - 52 + iserial=mod(nx,10000) + if(iserial.gt.2047) iserial=2047 + grid6=w(nwords)(1:6) + j1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*24*24 + j2=(ichar(grid6(2:2))-ichar('A'))*10*10*24*24 + j3=(ichar(grid6(3:3))-ichar('0'))*10*24*24 + j4=(ichar(grid6(4:4))-ichar('0'))*24*24 + j5=(ichar(grid6(5:5))-ichar('A'))*24 + j6=(ichar(grid6(6:6))-ichar('A')) + igrid6=j1+j2+j3+j4+j5+j6 + + write(c77,1010) n12,n22,ir,irpt,iserial,igrid6,i3 +1010 format(b12.12,b22.22,b1,b3.3,b11.11,b25.25,b3.3) + + return +end subroutine pack77_5 + + +subroutine packtext77(c13,c71) + + character*13 c13,w + character*71 c71 + character*42 c + character*1 qa(10),qb(10) + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/ + + call mp_short_init + qa=char(0) + w=adjustr(c13) + do i=1,13 + j=index(c,w(i:i))-1 + if(j.lt.0) j=0 + call mp_short_mult(qb,qa(2:10),9,42) !qb(1:9)=42*qa(2:9) + call mp_short_add(qa,qb(2:10),9,j) !qa(1:9)=qb(2:9)+j + enddo + + write(c71,1010) qa(2:10) +1010 format(b7.7,8b8.8) + + return +end subroutine packtext77 + +subroutine unpacktext77(c71,c13) + + integer*1 ia(10) + character*1 qa(10),qb(10) + character*13 c13 + character*71 c71 + character*42 c + equivalence (qa,ia),(qb,ib) + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/ + + qa(1)=char(0) + read(c71,1010) qa(2:10) +1010 format(b7.7,8b8.8) + + do i=13,1,-1 + call mp_short_div(qb,qa(2:10),9,42,ir) + c13(i:i)=c(ir+1:ir+1) + qa(2:10)=qb(1:9) + enddo + + return +end subroutine unpacktext77 + +subroutine mp_short_ops(w,u) + character*1 w(*),u(*) + integer i,ireg,j,n,ir,iv,ii1,ii2 + character*1 creg(4) + save ii1,ii2 + equivalence (ireg,creg) + + entry mp_short_init + ireg=256*ichar('2')+ichar('1') + do j=1,4 + if (creg(j).eq.'1') ii1=j + if (creg(j).eq.'2') ii2=j + enddo + return + + entry mp_short_add(w,u,n,iv) + ireg=256*iv + do j=n,1,-1 + ireg=ichar(u(j))+ichar(creg(ii2)) + w(j+1)=creg(ii1) + enddo + w(1)=creg(ii2) + return + + entry mp_short_mult(w,u,n,iv) + ireg=0 + do j=n,1,-1 + ireg=ichar(u(j))*iv+ichar(creg(ii2)) + w(j+1)=creg(ii1) + enddo + w(1)=creg(ii2) + return + + entry mp_short_div(w,u,n,iv,ir) + ir=0 + do j=1,n + i=256*ir+ichar(u(j)) + w(j)=char(i/iv) + ir=mod(i,iv) + enddo + return + + return +end subroutine mp_short_ops + +subroutine add_call_to_recent_calls(callsign) + + character*13 callsign + logical ladd + +! only add if the callsign is not already on the list + ladd=.true. + do i=1,MAXRECENT-1 ! if callsign is at the end of the list add it again + if(recent_calls(i).eq.callsign) ladd=.false. + enddo + + if(ladd) then + do i=MAXRECENT,2,-1 + recent_calls(i)=recent_calls(i-1) + enddo + recent_calls(1)=callsign + endif + +! Make sure that callsign is hashed + call save_hash_call(callsign,n10,n12,n22) + + return +end subroutine add_call_to_recent_calls + +subroutine to_grid4(n,grid4,ok) + character*4 grid4 + logical ok + + ok=.false. + j1=n/(18*10*10) + if (j1.lt.0.or.j1.gt.17) goto 900 + n=n-j1*18*10*10 + j2=n/(10*10) + if (j2.lt.0.or.j2.gt.17) goto 900 + n=n-j2*10*10 + j3=n/10 + if (j3.lt.0.or.j3.gt.9) goto 900 + j4=n-j3*10 + if (j4.lt.0.or.j4.gt.9) goto 900 + grid4(1:1)=char(j1+ichar('A')) + grid4(2:2)=char(j2+ichar('A')) + grid4(3:3)=char(j3+ichar('0')) + grid4(4:4)=char(j4+ichar('0')) + ok=.true. + +900 return +end subroutine to_grid4 + +subroutine to_grid6(n,grid6,ok) + character*6 grid6 + logical ok + + ok=.false. + j1=n/(18*10*10*24*24) + if (j1.lt.0.or.j1.gt.17) goto 900 + n=n-j1*18*10*10*24*24 + j2=n/(10*10*24*24) + if (j2.lt.0.or.j2.gt.17) goto 900 + n=n-j2*10*10*24*24 + j3=n/(10*24*24) + if (j3.lt.0.or.j3.gt.9) goto 900 + n=n-j3*10*24*24 + j4=n/(24*24) + if (j4.lt.0.or.j4.gt.9) goto 900 + n=n-j4*24*24 + j5=n/24 + if (j5.lt.0.or.j5.gt.23) goto 900 + j6=n-j5*24 + if (j6.lt.0.or.j6.gt.23) goto 900 + grid6(1:1)=char(j1+ichar('A')) + grid6(2:2)=char(j2+ichar('A')) + grid6(3:3)=char(j3+ichar('0')) + grid6(4:4)=char(j4+ichar('0')) + grid6(5:5)=char(j5+ichar('A')) + grid6(6:6)=char(j6+ichar('A')) + ok=.true. + +900 return +end subroutine to_grid6 + +subroutine to_grid(n,grid6,ok) + ! 4-, or 6-character grid + character*6 grid6 + logical ok + + ok=.false. + j1=n/(18*10*10*25*25) + if (j1.lt.0.or.j1.gt.17) goto 900 + n=n-j1*18*10*10*25*25 + j2=n/(10*10*25*25) + if (j2.lt.0.or.j2.gt.17) goto 900 + n=n-j2*10*10*25*25 + j3=n/(10*25*25) + if (j3.lt.0.or.j3.gt.9) goto 900 + n=n-j3*10*25*25 + j4=n/(25*25) + if (j4.lt.0.or.j4.gt.9) goto 900 + n=n-j4*25*25 + j5=n/25 + if (j5.lt.0.or.j5.gt.24) goto 900 + j6=n-j5*25 + if (j6.lt.0.or.j6.gt.24) goto 900 + grid6='' + grid6(1:1)=char(j1+ichar('A')) + grid6(2:2)=char(j2+ichar('A')) + grid6(3:3)=char(j3+ichar('0')) + grid6(4:4)=char(j4+ichar('0')) + if (j5.ne.24.or.j6.ne.24) then + grid6(5:5)=char(j5+ichar('A')) + grid6(6:6)=char(j6+ichar('A')) + endif + ok=.true. + +900 return +end subroutine to_grid + +end module packjt77 diff --git a/wsjtx_lib/lib/77bit/parse77.f90 b/wsjtx_lib/lib/77bit/parse77.f90 new file mode 100644 index 0000000..a0a8b86 --- /dev/null +++ b/wsjtx_lib/lib/77bit/parse77.f90 @@ -0,0 +1,11 @@ +subroutine parse77(msg,i3,n3) + + use packjt77 + character msg*37,c77*77 + + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + + return +end subroutine parse77 diff --git a/wsjtx_lib/lib/77bit/test28.f90 b/wsjtx_lib/lib/77bit/test28.f90 new file mode 100644 index 0000000..30ce154 --- /dev/null +++ b/wsjtx_lib/lib/77bit/test28.f90 @@ -0,0 +1,63 @@ +program test28 + + use packjt77 + parameter (NTOKENS=2063592,MAX22=4194304) + character*13 arg,call_00,call_0,call_1 + character*1 cerr + logical unpk28_success + + nargs=iargc() + n28=-1 + if(nargs.eq.1) then + call getarg(1,arg) + read(arg,'(i13)',err=2) n28 + endif + if(n28.ge.0) go to 100 + +2 open(10,file='test28.txt',status='old') + + write(*,1000) +1000 format('Encoded text Recovered text n28 Err? Type'/60('-')) + + do iline=1,999999 + if(nargs.eq.0) then + read(10,'(a13)',end=999) call_0 + else + call_0=arg + endif + if(call_0.eq.' ') exit + if(call_0(1:3).eq.'CQ ' .and. call_0(4:4).ne.' ') call_0(3:3)='_' + call_1=' ' + call_00=call_0 + call pack28(call_00,n28) + call unpack28(n28,call_1,unpk28_success) + cerr=' ' + if(call_0.ne.call_1) cerr='*' + if(call_0(1:3).eq.'CQ_') call_0(3:3)=' ' + if(call_1(1:3).eq.'CQ_') call_1(3:3)=' ' + if(n28.lt.NTOKENS) write(*,1010) call_0,call_1,n28,cerr +1010 format(a13,2x,a13,i10,2x,a1,2x,'Special token') + if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) then + call_00=call_0 + call save_hash_call(call_00,n10,n12,n22) + write(*,1012) call_0,call_1,n28,cerr,n22 +1012 format(a13,2x,a13,i10,2x,a1,2x,'22-bit hash',i15) + endif + if(n28.ge.NTOKENS+MAX22) write(*,1014) call_0,call_1,n28,cerr +1014 format(a13,2x,a13,i10,2x,a1,2x,'Standard callsign') + if(nargs.gt.0) exit + enddo + go to 999 + +100 call unpack28(n28,call_1,unpk28_success) + cerr=' ' + if(.not.unpk28_success) cerr='*' + if(call_1(1:3).eq.'CQ_') call_1(3:3)=' ' + if(n28.lt.NTOKENS) write(*,2010) n28,call_1,cerr +2010 format(i10,2x,a13,2x,a1,2x,'Special token') + if(n28.ge.NTOKENS .and. n28.lt.NTOKENS+MAX22) write(*,2012) n28,call_1,cerr +2012 format(i10,2x,a13,2x,a1,2x,'22-bit hash') + if(n28.ge.NTOKENS+MAX22) write(*,2014) n28,call_1,cerr +2014 format(i10,2x,a13,2x,a1,2x,'Standard callsign') + +999 end program test28 diff --git a/wsjtx_lib/lib/77bit/test28.txt b/wsjtx_lib/lib/77bit/test28.txt new file mode 100644 index 0000000..b280112 --- /dev/null +++ b/wsjtx_lib/lib/77bit/test28.txt @@ -0,0 +1,35 @@ +DE +QRZ +CQ +CQ_000 +CQ_001 +CQ_999 +CQ_A +CQ_Z +CQ_AA +CQ_ZZ +CQ_AAA +CQ_ZZZ +CQ_AAAA +CQ_ZZZZ + + + + + + + + + + +A0 +A0A +K1ABC +K1JT +5B1ABC +9Y4AB +9Y4XYZ +KA1ABC +KA1JT +WB9XYZ +ZZ9ZZZ diff --git a/wsjtx_lib/lib/77bit/todo.txt b/wsjtx_lib/lib/77bit/todo.txt new file mode 100644 index 0000000..ceeab60 --- /dev/null +++ b/wsjtx_lib/lib/77bit/todo.txt @@ -0,0 +1,59 @@ + To Do for FT8++ + --------------- + +The following list is for informtion and general guidance. Everything +is subject to change, and not all ideas are necessarily good ones! + +1. Nomenclature and parameters for message types + - Old-style = classic 72-bit JT-style source-encoding + FT8: (174,87) code: 72-bit info, i3bit, CRC12, isync=1 + MSK144: (128,80) code: 72-bit info, CRC8 + - New-style + FT8: (174,91) code: 74+3+14, sync uses isync=2 + MSK144: (128,90) code: 74+3+13 + +2. (K1JT) For backward compatibility (good for, say, 6 months only?), +by default we'll generate old-style messages where possible, new-style +messages where they are needed. We'll decode both old and new types. + +3. (K1JT -- DONE) Two new checkboxes on Advanced tab to enable 77-bit +messages: + - "Always generate new-style (77-bit) messages." + - "Decode only 77-bit messages + +4. (K9AN -- MOSTLY DONE) New-style messages can be as long as 37 +characters. We'll need to allow for that in a number of places. + +5. (K9AN -- DONE) Subroutine genft8() will need to parse the message to be +transmitted, determine the effective message type i3 and possibly +subtype, n3. It will then generate itone, calling genft8_174_91(() if +needed. + +6. (K1JT) Code to generate the user-readable messages for each +specialized type of operating, e.g., NA VHF contest, EU VHF contest, +ARRL Field Day, ARRL RTTY Roundup, use of nonstandard calls. + +7. (??) Code to do the necessary auto-sequencing for each specialized +type of operating. + +8. (K9AN -- MOSTLY DONE) What's needed for MSK144 with LDPC(128,90) ? +Still need to work on Sh messages. How will genmsk_128_90 know when to +generate a Sh message? + +9. (K9AN) Work on the implementation of AP decoding. For which message types +should AP be implemented? For each message type/QSO state that will use +AP decoding, need to create an AP decoding table that defines the number and +type of AP decoding passes. + + ========================================================================== +The following are just ideas: + +- Options to sort/filter decoded signals + +- New Fox message type using constant-envelope waveform and higher + symbol rate to accommodate multiple simultaneous QSOs. RR73 sent to + 0-5 calls, report sent to 0-5 calls. Decoding uses AP for missing + calls, thereby effectively making lower-rate codes when not all + slots are used. + +- Hound should send spots of Fox to PSK Reporter. diff --git a/wsjtx_lib/lib/77bit/tokens.txt b/wsjtx_lib/lib/77bit/tokens.txt new file mode 100644 index 0000000..bb51420 --- /dev/null +++ b/wsjtx_lib/lib/77bit/tokens.txt @@ -0,0 +1,12 @@ +DE +QRZ +CQ +CQ_000 +CQ_313 +CQ_999 +CQ_A +CQ_AAAA +CQ_AB +CQ_ABC +CQ_ABCD +CQ_ZZZZ diff --git a/wsjtx_lib/lib/77bit/wsjt-x_v2.0.txt b/wsjtx_lib/lib/77bit/wsjt-x_v2.0.txt new file mode 100644 index 0000000..59464da --- /dev/null +++ b/wsjtx_lib/lib/77bit/wsjt-x_v2.0.txt @@ -0,0 +1,213 @@ + Plans for WSJT-X Version 2.0 + ---------------------------- + +This white paper describes a number of important enhancements planned +for WSJT-X Version 2.0. Most of them involve the FT8 and MSK144 +protocols, which will be upgraded to use use 77-bit information +payloads rather than the present 72 or 75 bits. This modest increase +in information content will make possible new message types that +support the following special types of QSOs and exchanged information: + +1. NA VHF Contest operation with full and transparent support of grid + locators and "/R" (Rover) callsigns + +2. EU VHF Contest operation with the exchange of 6-digit locators, QSO + serial numbers, and "/P" (portable) callsigns + +3. ARRL Field Day operation with standard Field Day exchanges + +4. ARRL RTTY Roundup operation with standard contest exchanges + +5. Better and more user-friendly support for compound and nonstandard + callsigns + +6. A special "telemetry" message format for exchange of arbitrary + information (up to 71 bits) + +Decoding sensitivity for the new messages will be essentially the same +as for the FT8 and MSK144 modes presently in WSJT-X v1.9.1. The +existing FT8 DXpedition mode will still be supported, and a more +powerful DXpedition mode may be offered as well. + +In this document we'll call the new FT8 protocol "FT8+". It will be a +superset of the FT8 implemented in v1.9.1, providing at least +temporary compatibility and inter-operability with older program +versions. We may decide to remove support for old-style 72- and +75-bit messages after a specified switchover interval. + +In contrast, the new MSK144 protocol will replace the old one without +backward compatibility. We believe the smaller and more specialized +group of MSK144 users will upgrade quickly and not find this +restriction to be a problem. + +Here are some examples of message formats that will be supported by +FT8+ and MSK144 in WSJT-X v2.0. The list is not exhaustive. +Parameters i3 and n3 (shown in column 1) are used in the software to +define major and minor 77-bit message types. + +---------------------------------------------------------------------------------- +i3.n3 Example Messages Comments +---------------------------------------------------------------------------------- + 0.0 TNX BOB 73 GL Free text + 0.1 K1ABC RR73; W9XYZ -08 DXpedition Mode (sent only by Fox) + 0.2 G4ABC/P R 570007 JO22DB EU VHF Contest + 0.2 PA9XYZ 590003 IO91NP EU VHF Contest + 0.3 K1ABC W9XYZ 6A WI ARRL Field Day + 0.3 W9XYZ K1ABC R 2B EMA ARRL Field Day + 0.5 123456789ABCD Telemetry (18 hex digits) + 1. W9XYZ Compound call + 1. W9XYZ 73 + 1. CQ FD K1ABC FN42 + 1. CQ K1ABC FN42 + 1. CQ TEST K1ABC FN42 NA VHF Contest ("TEST" is optional) + 1. CQ TEST K1ABC/R FN42 + 1. K1ABC W9XYZ EN37 + 1. K1ABC W9XYZ -09 + 1. K1ABC W9XYZ R-17 + 1. K1ABC W9XYZ RRR + 1. K1ABC W9XYZ 73 + 1. K1ABC W9XYZ RR73 + 1. K1ABC/R W9XYZ EN37 + 1. K1ABC W9XYZ/R RR73 + 1. W9XYZ -13 Nonstandard call + 1. W9XYZ R+02 + 1. W9XYZ RRR + 1. W9XYZ RR73 + 2. CQ G4ABC/P IO91 + 2. G4ABC/P PA9XYZ JO22 + 2. PA9XYZ G4ABC/P RR73 + 3. K1ABC KA0DEF 559 MO ARRL RTTY Roundup + 3. K1ABC W9XYZ 579 WI ARRL RTTY Roundup + 3. KA1ABC G3AAA 529 0013 ARRL RTTY Roundup + 3. TU; G3AAA K1ABC R 559 MA ARRL RTTY Roundup + 3. TU; KA0DEF K1ABC R 569 MA ARRL RTTY Roundup + 3. W9XYZ K1ABC R 589 MA ARRL RTTY Roundup + 4. CQ KH1/KH7Z Compound call + 4. CQ YW18FIFA Nonstandard call +---------------------------------------------------------------------------------- + + +Here are some examples of minimal QSO sequences that take advantage +(where necessary) of the new protocol capabilities. Model QSOs number +1 and 2 are supported already, with the present FT8 and MSK144 +protocols, and number 3 with the existing FT8 DXpedition Mode. Model +QSOs 4-8 (and others not illustrated here) require the new protocols +with 77-bit messages. + +---------------------------------------------------------------------------------- +1. Standard QSO +---------------------------------------------------------------------------------- +CQ K1ABC FN42 + K1ABC W9XYZ EN37 +W9XYZ K1ABC -11 + K1ABC W9XYZ R-09 +W9XYZ K1ABC RRR + K1ABC W9XYZ 73 + +---------------------------------------------------------------------------------- +2. Short-cycle QSO +---------------------------------------------------------------------------------- +CQ K1ABC FN42 + K1ABC W9XYZ -09 +W9XYZ K1ABC R-11 + K1ABC W9XYZ RR73 +W9XYZ K1ABC 73 + +---------------------------------------------------------------------------------- +3. FT8 DXpedition Mode +---------------------------------------------------------------------------------- +CQ KH1/KH7Z + KH7Z K1ABC FN42 +K1ABC KH7Z -12 + KH7Z K1ABC R-14 + KH7Z W9XYZ EN37 + ... possibly other callers ... +K1ABC RR73; W9XYZ -08 + +---------------------------------------------------------------------------------- +4. ARRL Field Day +---------------------------------------------------------------------------------- +CQ FD K1ABC FN42 + K1ABC W9XYZ 6A WI +W9XYZ K1ABC R 2B EMA + K1ABC W9XYZ RR73 + +---------------------------------------------------------------------------------- +5. ARRL VHF Contests +---------------------------------------------------------------------------------- +CQ TEST K1ABC/R FN42 + K1ABC/R W9XYZ EN37 +W9XYZ K1ABC/R R FN42 + K1ABC/R W9XYZ RR73 + +---------------------------------------------------------------------------------- +6. ARRL RTTY Contest +---------------------------------------------------------------------------------- +CQ TEST K1ABC FN42 + K1ABC W9XYZ 579 WI +W9XYZ K1ABC R 589 MA + K1ABC W9XYZ RR73 + +---------------------------------------------------------------------------------- +7. EU VHF Contest +---------------------------------------------------------------------------------- +CQ TEST G4ABC/P IO91 + G4ABC/P PA9XYZ JO22 +PA9XYZ 590003 IO91NP + G4ABC/P R 570007 JO22DB +PA9XYZ G4ABC/P RRR + G4ABC/P PA9XYZ 73 + +---------------------------------------------------------------------------------- +8. Compound call +---------------------------------------------------------------------------------- +CQ PJ4/K1ABC + W9XYZ +W9XYZ K1ABC -11 + K1ABC W9XYZ R-09 +W9XYZ RRR + W9XYZ 73 +---------------------------------------------------------------------------------- + + +To minimize confusion that's likely to arise during a switchover from +v1.9.1 to v2.0, we propose to follow a well advertised schedule: + +"RC1 Date" -- perhaps as early as September 15, 2018? +------------------------------------------------------- + +This will be the first chance for beta testers to try WSJT-X using the +77-bit messages. We may restrict this opportunity to specific +volunteer testers, and we'll probably include an "upgrade by +xxxx_date" message to remind people that they are using a release +intended only for testing. + +FT8+ will support the old (v1.9.1) protocol as well as the new message +types outlined above. To avoid QRMing legacy FT8 users with messages +they can't decode, we'll recommend testing FT8+ on frequencies +formerly used for JT9. + +MSK144 will be fully functional between any two stations using the RC1 +software, but it will not be backward compatible with earlier program +versions. + +"RC2, RC3,... Date" -- perhaps in October? +-------------------------------------------- + +As needed, depending on results of testing. + +GA Release Date -- perhaps in November? +--------------------------------------------- + +Official General Availability release of WSJT-X v2.0.0. The original +MSK144 protocol will be declared obsolete. + + +For reference: Dates of relevant upcoming ARRL contests +------------------------------------------------------- +VHF QSO Party: September 8-10, 2018 +RTTY Roundup: January 5-6, 2019 +VHF SS: January 19-21, 2019 + +Our proposed schedule should make WSJT-X Version 2.0 usable for +relevant ARRL operating events in 2019. diff --git a/wsjtx_lib/lib/CQnnnCAT.txt b/wsjtx_lib/lib/CQnnnCAT.txt new file mode 100644 index 0000000..d7e92d0 --- /dev/null +++ b/wsjtx_lib/lib/CQnnnCAT.txt @@ -0,0 +1,39 @@ +Before using the new "CQ nnn ..." feature in JTMSK mode, I suggest +performing the following tests of the necessary CAT control for your +radio. (I'm assuming that you already have some experience with +JTMSK.) + +TEST 1: +-------------------------------------------------------------------------- +1. Start WSJT-X +2. Settings: "Enable VHF/UHF/Microwave features, "Rx frequency offset + with 'CQ nnn ...'", Split=Rig, or Split="Fake it" +3. Main screen settings: Band=50.280, mode=JTMSK, T/R=15 s +4. Activate CQRx, set CQ Rx=265 + ==> Rx dial should now read 50.265 and Tx6 should be queued +5. Click "Enable Tx" + ==> Tx sequences should occur at 50.280, Rx at 50.265 + +With most rigs, this test should work with Split configured as either +"Rig" or "Fake it". + +TEST 2: +-------------------------------------------------------------------------- +1. Start WSJT-X +2. Settings: MyCall=K1JT, "Enable VHF/UHF/Microwave features, + "Rx frequency offset with 'CQ nnn ...'", Split=Rig or "Fake it" +4. Main screen settings: Band=50.280, mode=JTMSK, T/R=15 s +5. Open file 150826_120515.wav + ==> see decoded message "K1JT VE1SKY FN74" +6. Click "Monitor" to restart monitoring +7. Activate CQRx, set CQ Rx=265 + ==> Rx dial should now read 50.265; Tx6 should be queued +8. Click "Enable Tx" + ==> Tx sequences should occur at 50.280, Rx at 50.265 +9. After the start of a transmission, double-click on the decoded message + "K1JT VE1SKY FN74" + ==> Tx2 should be generated and queued; transmission will pause + briefly, Tx freq changed to 50.265, then Tx resumed. + +The test file is posted at +http://physics.princeton.edu/pulsar/K1JT/150826_120515.wav diff --git a/wsjtx_lib/lib/C_interface_module.f90 b/wsjtx_lib/lib/C_interface_module.f90 new file mode 100644 index 0000000..47fee9d --- /dev/null +++ b/wsjtx_lib/lib/C_interface_module.f90 @@ -0,0 +1,441 @@ +! FILE: c_interface_module.f90 +! PURPOSE: Supplement ISO-C-Binding to provide type aliases and interfaces +! to common ISO-C string functions to aid working with strings. +! AUTHOR: Joseph M. Krahn +! STATUS: Still in development. Reasonably complete, but somewhat limited testing. +! +! The idea is to provide type aliases for all ISO-C types, so that the +! Fortran interface code more explicitly defines the actual C interface. +! This should be updated to support F2008 variable-length allocatable +! strings. +! +! Entity names all have the "C_" prefix, as with ISO-C-Binding, with a +! few exceptions. +! +! Sourced from: http://fortranwiki.org/fortran/show/c_interface_module +! +! One FORALL statement reverted to a DO loop to avoid a gfortran 4.9.2 ICE +! +module C_interface_module + use, intrinsic :: ISO_C_Binding, & + ! C type aliases for pointer derived types: + C_ptr => C_ptr , & + C_char_ptr => C_ptr, & + C_const_char_ptr => C_ptr, & + C_void_ptr => C_ptr, & + C_const_void_ptr => C_ptr + + implicit none + public + + !---------------------------------------------------------------------------- + ! C type aliases for intrinsic type KIND parameters: + + ! NOTE: a C enum may not always be a standard C int + integer, parameter :: C_enum = C_int + + ! Defining off_t is difficult, because it may depend on "LARGEFILE" selection. + ! integer, parameter :: C_off_t = ?? + + ! C string terminator alais using the 3-letter ASCII name. + ! The C_ prefix is not used because it is just an ASCII character. + character(len=1,kind=C_char), parameter :: NUL = C_NULL_char + + ! NOTE: In C, "char" is distinct from "signed char", unlike integers. + ! The plain "char" type is specific for text/string values, whereas + ! "signed char" should indicate 1-byte integer data. + ! + ! Most ISO-C systems have wide chars "wchar_t", but Fortran compilers + ! have limited support for different character kinds. UTF encoding + ! adds more complexity. This should be updated as Fortran compilers + ! include support for more character types. + ! + + ! Fortran does not (yet) support unsigned types. + integer, parameter :: & + C_unsigned = C_int, & + C_unsigned_short = C_short, & + C_unsigned_long = C_long, & + C_unsigned_long_long = C_long_long, & + C_unsigned_char = C_signed_char, & + C_ssize_t = C_size_t, & + C_uint8_t = C_int8_t, & + C_uint16_t = C_int16_t, & + C_uint32_t = C_int32_t, & + C_uint64_t = C_int64_t, & + C_uint_least8_t = C_int_least8_t, & + C_uint_least16_t = C_int_least16_t, & + C_uint_least32_t = C_int_least32_t, & + C_uint_least64_t = C_int_least64_t, & + C_uint_fast8_t = C_int_fast8_t, & + C_uint_fast16_t = C_int_fast16_t, & + C_uint_fast32_t = C_int_fast32_t, & + C_uint_fast64_t = C_int_fast64_t, & + C_uintmax_t = C_intmax_t + ! Note: ptrdiff_t cannot be reliably defined from other types. + ! When practical, it is larger than a pointer because it benefits + ! from the full unsigned range in both positive and negative directions. + + ! Integer versions including 'int', where the 'int' is optional: + integer, parameter :: & + C_short_int = C_short, & + C_long_int = C_long, & + C_long_long_int = C_long_long, & + C_unsigned_int = C_unsigned, & + C_unsigned_short_int = C_short, & + C_unsigned_long_int = C_long, & + C_unsigned_long_long_int = C_long_long + + interface C_F_string + module procedure C_F_string_ptr + module procedure C_F_string_chars + end interface C_F_string + + interface F_C_string + module procedure F_C_string_ptr + module procedure F_C_string_chars + end interface F_C_string + + !======================================================================= + ! Some useful ISO C library string functions from + ! These are based on GCC header sections marked as NAMESPACE_STD + interface + + ! Copy N bytes of SRC to DEST, no aliasing or overlapping allowed. + ! extern void *memcpy (void *dest, const void *src, size_t n); + function C_memcpy(dest, src, n) result(result) bind(C,name="memcpy") + import C_void_ptr, C_size_t + type(C_void_ptr) :: result + type(C_void_ptr), value, intent(in) :: dest ! target=intent(out) + type(C_void_ptr), value, intent(in) :: src ! target=intent(in) + integer(C_size_t), value, intent(in) :: n + end function C_memcpy + + ! Copy N bytes of SRC to DEST, guaranteeing correct behavior for overlapping strings. + !extern void *memmove (void *dest, const void *src, size_t n) + function C_memmove(dest, src, n) result(result) bind(C,name="memmove") + import C_void_ptr, C_size_t + type(C_void_ptr) :: result + type(C_void_ptr), value, intent(in) :: dest ! target=intent(out) + type(C_void_ptr), value, intent(in) :: src + integer(C_size_t), value, intent(in) :: n + end function C_memmove + + ! Set N bytes of S to C. + !extern void *memset (void *s, int c, size_t n) + function C_memset(s, c, n) result(result) bind(C,name="memset") + import C_void_ptr, C_int, C_size_t + type(C_void_ptr) :: result + type(C_void_ptr), value, intent(in) :: s ! target=intent(out) + integer(C_int), value, intent(in) :: c + integer(C_size_t), value, intent(in) :: n + end function C_memset + + ! Compare N bytes of S1 and S2. + !extern int memcmp (const void *s1, const void *s2, size_t n) + pure function C_memcmp(s1, s2, n) result(result) bind(C,name="memcmp") + import C_int, C_void_ptr, C_size_t + integer(C_int) :: result + type(C_void_ptr), value, intent(in) :: s1 + type(C_void_ptr), value, intent(in) :: s2 + integer(C_size_t), value, intent(in) :: n + end function C_memcmp + + ! Search N bytes of S for C. + !extern void *memchr (const void *s, int c, size_t n) + pure function C_memchr(s, c, n) result(result) bind(C,name="memchr") + import C_void_ptr, C_int, C_size_t + type(C_void_ptr) :: result + type(C_void_ptr), value, intent(in) :: s + integer(C_int), value, intent(in) :: c + integer(C_size_t), value, intent(in) :: n + end function C_memchr + + ! Copy SRC to DEST. + !extern char *strcpy (char *dest, const char *src) + function C_strcpy(dest, src) result(result) bind(C,name="strcpy") + import C_char_ptr, C_size_t + type(C_char_ptr) :: result + type(C_char_ptr), value, intent(in) :: dest ! target=intent(out) + type(C_char_ptr), value, intent(in) :: src + end function C_strcpy + + ! Copy no more than N characters of SRC to DEST. + !extern char *strncpy (char *dest, const char *src, size_t n) + function C_strncpy(dest, src, n) result(result) bind(C,name="strncpy") + import C_char_ptr, C_size_t + type(C_char_ptr) :: result + type(C_char_ptr), value, intent(in) :: dest ! target=intent(out) + type(C_char_ptr), value, intent(in) :: src + integer(C_size_t), value, intent(in) :: n + end function C_strncpy + + ! Append SRC onto DEST. + !extern char *strcat (char *dest, const char *src) + function C_strcat(dest, src) result(result) bind(C,name="strcat") + import C_char_ptr, C_size_t + type(C_char_ptr) :: result + type(C_char_ptr), value, intent(in) :: dest ! target=intent(out) + type(C_char_ptr), value, intent(in) :: src + end function C_strcat + + ! Append no more than N characters from SRC onto DEST. + !extern char *strncat (char *dest, const char *src, size_t n) + function C_strncat(dest, src, n) result(result) bind(C,name="strncat") + import C_char_ptr, C_size_t + type(C_char_ptr) :: result + type(C_char_ptr), value, intent(in) :: dest ! target=intent(out) + type(C_char_ptr), value, intent(in) :: src + integer(C_size_t), value, intent(in) :: n + end function C_strncat + + ! Compare S1 and S2. + !extern int strcmp (const char *s1, const char *s2) + pure function C_strcmp(s1, s2) result(result) bind(C,name="strcmp") + import C_int, C_char_ptr, C_size_t + integer(C_int) :: result + type(C_char_ptr), value, intent(in) :: s1 + type(C_char_ptr), value, intent(in) :: s2 + end function C_strcmp + + ! Compare N characters of S1 and S2. + !extern int strncmp (const char *s1, const char *s2, size_t n) + pure function C_strncmp(s1, s2, n) result(result) bind(C,name="strncmp") + import C_int, C_char_ptr, C_size_t + integer(C_int) :: result + type(C_char_ptr), value, intent(in) :: s1 + type(C_char_ptr), value, intent(in) :: s2 + integer(C_size_t), value, intent(in) :: n + end function C_strncmp + + ! Return the length of S. + !extern size_t strlen (const char *s) + pure function C_strlen(s) result(result) bind(C,name="strlen") + import C_char_ptr, C_size_t + integer(C_size_t) :: result + type(C_char_ptr), value, intent(in) :: s !character(len=*), intent(in) + end function C_strlen + + end interface + + ! End of + !========================================================================= + ! Standard ISO-C malloc routines: + interface + + ! void *calloc(size_t nmemb, size_t size); + type(C_void_ptr) function C_calloc(nmemb, size) bind(C,name="calloc") + import C_void_ptr, C_size_t + integer(C_size_t), value, intent(in) :: nmemb, size + end function C_calloc + + ! void *malloc(size_t size); + type(C_void_ptr) function C_malloc(size) bind(C,name="malloc") + import C_void_ptr, C_size_t + integer(C_size_t), value, intent(in) :: size + end function C_malloc + + ! void free(void *ptr); + subroutine C_free(ptr) bind(C,name="free") + import C_void_ptr + type(C_void_ptr), value, intent(in) :: ptr + end subroutine C_free + + ! void *realloc(void *ptr, size_t size); + type(C_void_ptr) function C_realloc(ptr,size) bind(C,name="realloc") + import C_void_ptr, C_size_t + type(C_void_ptr), value, intent(in) :: ptr + integer(C_size_t), value, intent(in) :: size + end function C_realloc + + end interface + + interface assignment(=) + module procedure F_string_assign_C_string + end interface assignment(=) + + !========================================================================== + +contains + + ! HACK: For some reason, C_associated was not defined as pure. + pure logical function C_associated_pure(ptr) result(associated) + type(C_ptr), intent(in) :: ptr + integer(C_intptr_t) :: iptr + iptr = transfer(ptr,iptr) + associated = (iptr /= 0) + end function C_associated_pure + + ! Set a fixed-length Fortran string to the value of a C string. + subroutine F_string_assign_C_string(F_string, C_string) + character(len=*), intent(out) :: F_string + type(C_ptr), intent(in) :: C_string + character(len=1,kind=C_char), pointer :: p_chars(:) + integer :: i + if (.not. C_associated(C_string) ) then + F_string = ' ' + else + call C_F_pointer(C_string,p_chars,[huge(0)]) + i=1 + do while(p_chars(i)/=NUL .and. i<=len(F_string)) + F_string(i:i) = p_chars(i) + i=i+1 + end do + if (i -17 +6. ... no copy from W9XYZ ... +7. W9XYZ KH1DX -17 +8. ... no copy from W9XYZ ... +9. G4AAA KH1DX -11 +10. KH1DX G4AAA R-03 +11. G4AAA RR73; DL3BBB -12 +12. KH1DX DL3BBB R-09 +13. DL3BBB RR73; DE +14. ... +------------------------------------------------------------------------ + +All messages except those containing "<...>" are standard FT8 messages +(i3bit=0, iFreeText=0). Hounds transmit only standard messages. + +Fox transmits standard messages and also special messages with +i3bit=1. The special messages contain a callsign whose completed QSO +is being acknowledged; a callsign for the next station to be worked; a +hash code corresponding to the Fox callsign; and a signal report. +Users will see the Fox callsign enclosed in angle brackets, . +The 72-bit message payload contains two 28-bit callsigns, a 10-bit +hash code, and a 6-bit signal report. If no call has been queued up +by Fox for the next QSO, the acknowledgment message takes the +abbreviated form shown in line 13 above. + +When a Hound receives a message with i3bit=1, the decoder interprets +the remaining 72 bits as described above. If the 10-bit hash code +matches that for Fox's callsign, the message is displayed as in the +QSO exchanges shown above. Otherwise the message is considered a +false decode and is not displayed. + + +Station Setup and Operation for FOX +----------------------------------- + +A wide Rx bandwidth (up to 5 kHz) is selected. The basic dial +frequency is set 1 kHz above f0 (thus 14083 kHz in my example) and the +audio TxFreq somewhere between -200 and -800 Hz. (Yes, negative +numbers are OK. *Split Operation* will reset the Tx dial frequency as +needed and will keep the generated Tx audio frequency between 1500 and +2000 Hz.) Hounds with audio TxFreq set to N Hz will be received by Fox +at N-1000 Hz. + +WSJT-X at Fox will maintain and display a list of all decoded Hounds +calling Fox in the past 2 to 4 Rx cycles. The list might look +something like this (but typically will be much longer): + +---------------------------- +Call Grid Rpt Freq +---------------------------- +AA2UK FM29 -11 240 +AD9H EN61 +02 1260 +K0TPP EM48 -15 1980 +N2BJ EN61 +11 540 +N4NDR EL98 -17 4620 +NX4E EM70 +00 3780 +ON3LA JN29 -10 3300 +PD9BG JO21 -21 2100 +PJ4/KA1XYZ FK60 -07 1020 +VE1SKY FN74 +03 1620 +WB2REM EL97 -13 3060 +... +---------------------------- + +Fox can choose to have the list sorted on any column. + +Fox selects a Hound to call next by clicking on a line. Or he can hit +"F1" to have the program select a caller according to one of these +criteria (maybe others as well?): + + - Weakest caller + - Strongest caller + - Strongest one below -N dB (with N selectable) + - Choose a call at random + - Random choice with S/N between snrMin and snrMax dB. + +After a particular Hound has been called, Fox's Auto-Sequencer looks +for a response containing "R+rpt" originating from that same callsign. +If such a message is received, Fox's next transmission will be the +special "acknowledge-and-call-next" type, with i3bit=1. If the +expected message is not received, as in example line 6 above, the +report is sent to the same station again. If the second attempt fails +and another Hound callsign has been queued up, the QSO is aborted and +the next Hound is called. + + +Station Setup and Operation for Hounds +-------------------------------------- + +Dial frequency is set to f0, 14082 kHz in my example. Rx bandwidth and +displayed range on the Wide Graph can be anything convenient, say 200 +to 2600 Hz. (Signal from Fox will be expected between 200 and 800 +Hz.) Enter callsign and locator of Fox on WSJT-X main window as *DX +Call* and *DX Grid*. Choose a TxFreq offset of 1000 + 60*N for some N +in the range 1 to 80 (maybe even higher?). Move TxFreq as desired, +hoping to find a clear slot, by using Shift+F11 and Shift+F12. + + - Hit F1 to call Fox in your next Tx sequence. Yes, you must hit F1 + repeatedly, in order to keep calling. + + - The Auto-sequencer will watch for a decoded message that contains + "MyCall DXcall rpt" or "MyCall rpt". When one of these is + received, your next transmission will be "DXcall MyCall R+rpt", + sent automatically. + + - After you send the "R+rpt" message, AutoSeq will watch for a + message that starts with "MyCall RR73; ...". When that is + received, you're in his log, and you'll be prompted to log the QSO. + +Random thoughts +--------------- + +Fox's decoder has access to signals in a 4 kHz (maybe even 5 kHz?) +window. At 60 Hz intervals, that's enough for around 65 (or 80?) +non-overlapping Hound signals. If the pileup becomes too deep, more +spectrum might be used; but note that WSJT-X can't access more than 5 +kHz at one time. A better solution might be for Fox to call "CQ n +KH1DX AJ10", where n is a single digit indicating call area. The +decoder could then limit the list of eligible calls to those in the +specified call area. After decoding such a CQ, the software at Hound +could refuse to transmit unless MyCall falls in the specified call +area. (Other special CQ formats can be imagined that would limit the +eligible Hound callsigns even further.) + +We haven't thought much, yet, about logging issues for Fox. I imagine +we could do what's necessary to join a N1MM+ logging network, if that's +deemed desirable. + +A few questions: + +Q1: Should the Auto-Sequencer allow for other cases in which a QSO has +been initiated by Fox, but one of next two messages is not copied by +either Fox or Hound? For example, what if K1ABC does not copy message +#5? Should he keep sending his message "KH1DX K1ABC R-11" ? If Fox +receives this message again, should he acknowledge again? And poor +W9XYZ, who never received an acknowledgment, will probably keep +sending "KH1DX W9XYZ R-19", or whatever. If Fox eventually copies the +message, should the program remember that W9XYZ had been called, and +thus send him an acknowledgment? + +Q2: Should we provide a stack for several to-be-called callsigns, +rather than just one? Should re-ordering of calls in the stack be +permitted? + +Q3: Can we handle WSJT-X "Type 1" and "Type 2" compound callsigns, for +Hounds? diff --git a/wsjtx_lib/lib/DXped_pseudo_code.txt b/wsjtx_lib/lib/DXped_pseudo_code.txt new file mode 100644 index 0000000..e6a50e7 --- /dev/null +++ b/wsjtx_lib/lib/DXped_pseudo_code.txt @@ -0,0 +1,71 @@ +Auto-Sequencing algorithm for DXpedition station: + +Start: + CQMsg = "CQ KH1DX" (or "CQ UP KH1DX", "CQ 116 KH1DX", etc.) + TxMsg = CQMsg + Ntry = 0 + QCALL = "" # Callsign of current QSO partner + go to Transmit + +Transmit: + TX # (... takes 13.6 s) + go to Receive + +Receive: + RX # (... takes ~14 s) + N = number of decodes # RxMsg[i], i=1,N + if(N == 0) + go to Transmit + J = index of a reply from current QCALL # RxMsg[J] = "KH1DX QCALL R" + + if(QCALL == "") # No QSO in progress + Select new QCALL # Op chooses a caller + if(QCALL == "") + TxMsg = CQMsg # No callers, we'll CQ again + else # QSO in progress + if(J >= 1) # Expected message was received + log the QSO with QCALL + QCALL = "" + Select new QCALL # Op chooses a new caller + if(QCALL != "") + TxMsg = "73 NOW QCALL " # Start a new QSO + else + TxMsg = "73 " + CQMsg # No callers, we'll CQ again + else + Ntry = Ntry + 1 # Expected msg not received + if(Ntry <= NtryMax) + go to Transmit # Ask for a repeat + else + QCALL = "" # Max tries exceeded, abort this QSO + Select new QCALL # Choose a new caller + if(QCALL != "") + TxMsg = "NIL NOW QCALL " # Start a new QSO + else + TxMsg = "NIL " + CQMSG # No callers, we'll CQ again + go to Transmit + + +Auto-Sequencing algorithm for those calling the DXpedition: + +Start: + TxMsg = "KH1DX MyCall" + InQSO = false + +Transmit: + TX # (... takes 13.6 s) + go to Receive + +Receive: + RX # (... takes ~14 s) + if(RxMsg[i] contains "MyCall ") + InQSO = true + TxMsg = "KH1DX MyCall R" + go to Transmit + + if(RxMsg[i] contains "") + TxEnable = false + go to Receive + + if(RxMsg[i] contains "CQ KH1DX") + TxEnable = true + go to Transmit diff --git a/wsjtx_lib/lib/addit.f90 b/wsjtx_lib/lib/addit.f90 new file mode 100644 index 0000000..48fd8cd --- /dev/null +++ b/wsjtx_lib/lib/addit.f90 @@ -0,0 +1,79 @@ +subroutine addit(itone,nfsample,nsym,nsps,ifreq,sig,dat) + + integer itone(nsym) + real dat(60*12000) + real*8 f,dt,twopi,phi,dphi,baud,fsample,freq,tsym,t + + tsym=nsps*1.d0/nfsample !Symbol duration + baud=1.d0/tsym + fsample=12000.d0 !Sample rate (Hz) + dt=1.d0/fsample !Sample interval (s) + twopi=8.d0*atan(1.d0) + dphi=0. + + f=ifreq + phi=0. + ntot=nsym*tsym/dt + k=12000 !Start audio at t = 1.0 s + t=0. + isym0=-1 + do i=1,ntot + t=t+dt + isym=nint(t/tsym) + 1 + if(isym.gt.nsym) exit + if(isym.ne.isym0) then + freq=f + itone(isym)*baud + dphi=twopi*freq*dt + isym0=isym + endif + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + k=k+1 + dat(k)=dat(k) + sig*sin(xphi) + enddo + + return +end subroutine addit + +subroutine addcw(icw,ncw,ifreq,sig,dat) + + integer icw(ncw) + real dat(60*12000) + real s(60*12000) + real x(60*12000) + real y(60*12000) + real*8 dt,twopi,phi,dphi,fsample,tdit,t + + wpm=25.0 + nspd=nint(1.2*12000.0/wpm) + fsample=12000.d0 !Sample rate (Hz) + dt=1.d0/fsample !Sample interval (s) + tdit=nspd*dt + twopi=8.d0*atan(1.d0) + dphi=twopi*ifreq*dt + phi=0. + k=12000 !Start audio at t = 1.0 s + t=0. + npts=59*12000 + x=0. + do i=1,npts + t=t+dt + j=nint(t/tdit) + 1 + j=mod(j-1,ncw) + 1 + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + k=k+1 + x(k)=icw(j) + s(k)=sin(xphi) + if(t.ge.59.5) exit + enddo + + nadd=0.004/dt + call smo(x,npts,y,nadd) + y=y/nadd + dat=dat + sig*y*s + + return +end subroutine addcw diff --git a/wsjtx_lib/lib/afc65b.f90 b/wsjtx_lib/lib/afc65b.f90 new file mode 100644 index 0000000..18bbb69 --- /dev/null +++ b/wsjtx_lib/lib/afc65b.f90 @@ -0,0 +1,94 @@ +subroutine afc65b(cx,npts,fsample,nflip,mode65,a,ccfbest,dtbest) + +! Find delta f, f1, f2 ==> a(1:3) + + complex cx(npts) + real a(5),deltaa(5) + + a=0. + a1=0. + a2=0. + i2=8*mode65 + i1=-i2 + j2=8*mode65 + j1=-j2 + ccfmax=0. + istep=2*mode65 + do iter=1,2 + do i=i1,i2,istep + a(1)=i + do j=j1,j2,istep + a(2)=j + chisq=fchisq65(cx,npts,fsample,nflip,a,ccf,dtmax) + if(ccf.gt.ccfmax) then + a1=a(1) + a2=a(2) + ccfmax=ccf + endif +! write(81,3081) istep,i1,i2,j1,j2,i,j,ccf,ccfmax,dtmax,a1,a2 +!3081 format(7i4,5f8.2) + enddo + enddo + i1=int(a1)-istep + i2=int(a1)+istep + j1=int(a2)-istep + j2=int(a2)+istep + istep=1 + enddo + +! a(1)=0. +! a(2)=0. + a(1)=a1 + a(2)=a2 + a(3)=0. + a(4)=0. + deltaa(1)=2.0*mode65 + deltaa(2)=2.0*mode65 + deltaa(3)=1.0 + nterms=2 !Maybe 2 is enough? + +! Start the iteration + chisqr=0. + chisqr0=1.e6 + do iter=1,100 !How many iters is enough? + do j=1,nterms + chisq1=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) + fn=0. + delta=deltaa(j) +10 a(j)=a(j)+delta + chisq2=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) + if(chisq2.eq.chisq1) go to 10 + if(chisq2.gt.chisq1) then + delta=-delta !Reverse direction + a(j)=a(j)+delta + tmp=chisq1 + chisq1=chisq2 + chisq2=tmp + endif +20 fn=fn+1.0 + a(j)=a(j)+delta + chisq3=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) + if(chisq3.lt.chisq2) then + chisq1=chisq2 + chisq2=chisq3 + go to 20 + endif + +! Find minimum of parabola defined by last three points + delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5) + a(j)=a(j)-delta + deltaa(j)=deltaa(j)*fn/3. +! write(*,4000) iter,j,a(1:2),-chisq2 +!4000 format(2i2,4f9.4) + enddo + chisqr=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) + fdiff=chisqr/chisqr0-1.0 +! write(*,4000) 0,0,a(1:2),-chisqr,fdiff + if(abs(fdiff).lt.0.0001) exit + chisqr0=chisqr + enddo + ccfbest=ccfmax * (1378.125/fsample)**2 + dtbest=dtmax + + return +end subroutine afc65b diff --git a/wsjtx_lib/lib/afc9.f90 b/wsjtx_lib/lib/afc9.f90 new file mode 100644 index 0000000..dd106aa --- /dev/null +++ b/wsjtx_lib/lib/afc9.f90 @@ -0,0 +1,81 @@ +subroutine afc9(c3a,npts,fsample,a,syncpk) + + parameter (NZ2=1512) + complex c3a(0:NZ2-1) + complex c3(0:NZ2-1) + real a(3),deltaa(3) + + a(1)=0. !f0 + a(2)=0. !f1 + a(3)=0. !f2 + deltaa(1)=1.736 + deltaa(2)=1.736 + deltaa(3)=1.0 + nterms=3 + +! Start the iteration + chisqr=0. + chisqr0=1.e6 + c3=c3a + a3=a(3) + do iter=1,4 + do j=1,nterms + if(a(3).ne.a3) call shft(c3a,a(3),a3,c3) + chisq1=fchisq(c3,npts,fsample,a) + fn=0. + delta=deltaa(j) +10 a(j)=a(j)+delta + if(a(3).ne.a3) call shft(c3a,a(3),a3,c3) + chisq2=fchisq(c3,npts,fsample,a) + if(chisq2.eq.chisq1) go to 10 + if(chisq2.gt.chisq1) then + delta=-delta !Reverse direction + a(j)=a(j)+delta + tmp=chisq1 + chisq1=chisq2 + chisq2=tmp + endif +20 fn=fn+1.0 + a(j)=a(j)+delta + if(a(3).ne.a3) call shft(c3a,a(3),a3,c3) + chisq3=fchisq(c3,npts,fsample,a) + if(chisq3.lt.chisq2) then + chisq1=chisq2 + chisq2=chisq3 + go to 20 + endif + +! Find minimum of parabola defined by last three points + delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5) + a(j)=a(j)-delta + if(j.lt.3) deltaa(j)=deltaa(j)*fn/3. +! write(*,4000) iter,j,a,-chisq2 +!4000 format(i1,i2,3f10.4,f11.3) + enddo + if(a(3).ne.a3) call shft(c3a,a(3),a3,c3) + chisqr=fchisq(c3,npts,fsample,a) +! write(*,4000) 0,0,a,-chisqr + if(chisqr/chisqr0.gt.0.99) exit + chisqr0=chisqr + enddo + + syncpk=-chisqr + c3a=c3 +! write(*,4001) a,syncpk +!4001 format(3x,3f10.4,f11.3) + + return +end subroutine afc9 + +subroutine shft(c3a,a3a,a3,c3) + complex c3a(0:1359) + complex c3(0:1359) + + a3=a3a + n=nint(a3) + c3=cshift(c3a,n) + if(n.gt.0) c3(1360-n:)=0.0 + if(n.lt.0) c3(:n-1)=0.0 + + return +end subroutine shft diff --git a/wsjtx_lib/lib/all_fft.out b/wsjtx_lib/lib/all_fft.out new file mode 100644 index 0000000..fb628a8 --- /dev/null +++ b/wsjtx_lib/lib/all_fft.out @@ -0,0 +1,2069 @@ + NFFT Time rms MHz MFlops iters tplan +------------------------------------------------------------- + 8 0.0000002 0.00000007 32.00 480.0 1000000 0.0 + 9 0.0000002 0.00000011 37.16 589.0 1000000 0.0 + 10 0.0000003 0.00000008 37.65 625.3 1000000 0.0 + 12 0.0000003 0.00000008 43.89 786.6 1000000 0.0 + 14 0.0000003 0.00000009 42.67 812.2 1000000 0.0 + 15 0.0000003 0.00000011 51.89 1013.7 1000000 0.0 + 16 0.0000004 0.00000005 40.16 803.1 1000000 0.0 + 18 0.0000006 0.00000013 30.72 640.5 1000000 0.0 + 20 0.0000005 0.00000013 38.79 838.2 1000000 0.0 + 21 0.0000008 0.00000010 26.35 578.8 1000000 0.0 + 24 0.0000006 0.00000012 42.67 978.1 1000000 0.0 + 25 0.0000008 0.00000011 32.65 758.2 1000000 0.0 + 27 0.0000009 0.00000015 28.56 679.0 1000000 0.0 + 28 0.0000007 0.00000013 42.16 1013.5 1000000 0.0 + 30 0.0000007 0.00000013 43.64 1070.6 1000000 0.0 + 32 0.0000006 0.00000014 50.57 1264.2 1000000 0.0 + 35 0.0000011 0.00000012 30.48 781.6 1000000 0.0 + 36 0.0000008 0.00000015 47.51 1228.0 1000000 0.0 + 40 0.0000008 0.00000020 51.20 1362.4 1000000 0.0 + 42 0.0000010 0.00000014 40.42 1089.8 1000000 0.0 + 45 0.0000013 0.00000013 35.34 970.3 1000000 0.0 + 48 0.0000009 0.00000016 54.86 1531.9 1000000 0.0 + 49 0.0000015 0.00000015 32.84 921.9 1000000 0.0 + 50 0.0000011 0.00000015 46.38 1308.7 1000000 0.0 + 54 0.0000012 0.00000019 46.39 1334.8 1000000 0.0 + 56 0.0000010 0.00000016 58.28 1692.2 1000000 0.0 + 60 0.0000010 0.00000019 62.44 1844.1 1000000 0.0 + 63 0.0000019 0.00000016 33.05 987.7 1000000 0.0 + 64 0.0000010 0.00000019 62.53 1876.0 1000000 0.0 + 70 0.0000014 0.00000020 48.43 1484.3 1000000 0.0 + 72 0.0000010 0.00000021 69.82 2153.9 1000000 0.0 + 75 0.0000019 0.00000014 38.87 1210.5 1000000 0.0 + 80 0.0000012 0.00000018 68.27 2157.9 1000000 0.0 + 81 0.0000020 0.00000016 39.88 1264.1 1000000 0.0 + 84 0.0000012 0.00000019 68.05 2175.0 1000000 0.0 + 90 0.0000017 0.00000020 54.34 1763.8 1000000 0.0 + 96 0.0000013 0.00000019 75.85 2497.4 1000000 0.0 + 98 0.0000020 0.00000015 49.98 1652.9 1000000 0.0 + 100 0.0000015 0.00000022 67.72 2249.8 1000000 0.0 + 105 0.0000027 0.00000013 38.51 1292.8 1000000 0.0 + 108 0.0000016 0.00000020 65.52 2212.8 1000000 0.0 + 112 0.0000015 0.00000020 73.52 2502.3 1000000 0.0 + 120 0.0000014 0.00000020 88.79 3066.2 1000000 0.0 + 125 0.0000037 0.00000015 33.47 1165.8 1000000 0.0 + 126 0.0000025 0.00000021 50.40 1758.3 1000000 0.0 + 128 0.0000017 0.00000021 74.81 2618.4 1000000 0.0 + 135 0.0000032 0.00000017 41.54 1469.8 1000000 0.0 + 140 0.0000020 0.00000020 71.68 2555.1 1000000 0.0 + 144 0.0000018 0.00000019 82.29 2949.9 1000000 0.0 + 147 0.0000043 0.00000015 34.15 1229.3 1000000 0.0 + 150 0.0000024 0.00000023 63.37 2290.3 1000000 0.0 + 160 0.0000019 0.00000022 84.98 3111.1 1000000 0.0 + 162 0.0000033 0.00000023 49.49 1816.2 1000000 0.0 + 168 0.0000020 0.00000018 83.35 3080.7 1000000 0.0 + 175 0.0000048 0.00000015 36.72 1368.1 1000000 0.0 + 180 0.0000024 0.00000021 73.61 2757.4 1000000 0.0 + 189 0.0000051 0.00000018 37.25 1408.5 985442 0.0 + 192 0.0000020 0.00000021 97.91 3713.3 1000000 0.0 + 196 0.0000028 0.00000024 69.11 2631.4 1000000 0.0 + 200 0.0000024 0.00000022 83.12 3176.7 1000000 0.0 + 210 0.0000033 0.00000022 63.85 2462.7 1000000 0.0 + 216 0.0000029 0.00000022 75.75 2937.1 1000000 0.0 + 224 0.0000024 0.00000023 94.63 3693.9 1000000 0.0 + 225 0.0000051 0.00000014 43.87 1713.9 974881 0.0 + 240 0.0000029 0.00000021 82.36 3256.0 1000000 0.0 + 243 0.0000096 0.00000019 25.39 1005.9 522354 0.0 + 245 0.0000072 0.00000015 34.04 1350.9 694716 0.0 + 250 0.0000043 0.00000023 58.72 2338.6 1000000 0.0 + 252 0.0000033 0.00000023 77.17 3077.9 1000000 0.0 + 256 0.0000026 0.00000019 96.66 3866.4 1000000 0.0 + 270 0.0000046 0.00000024 58.68 2369.6 1000000 0.0 + 280 0.0000034 0.00000023 82.39 3348.9 1000000 0.0 + 288 0.0000029 0.00000021 97.78 3994.4 1000000 0.0 + 294 0.0000045 0.00000023 64.66 2650.9 1000000 0.0 + 300 0.0000039 0.00000023 76.19 3134.8 1000000 0.0 + 315 0.0000087 0.00000015 36.03 1495.2 571949 0.0 + 320 0.0000035 0.00000022 90.82 3779.0 1000000 0.0 + 324 0.0000047 0.00000025 69.00 2877.5 1000000 0.0 + 336 0.0000037 0.00000023 89.79 3767.6 1000000 0.0 + 343 0.0000107 0.00000016 32.08 1351.1 467702 0.0 + 350 0.0000059 0.00000022 59.39 2509.4 848381 0.0 + 360 0.0000044 0.00000023 82.73 3512.6 1000000 0.0 + 375 0.0000100 0.00000018 37.39 1598.5 498528 0.0 + 378 0.0000070 0.00000027 53.99 2311.5 714202 0.0 + 384 0.0000040 0.00000023 96.76 4153.2 1000000 0.0 + 392 0.0000049 0.00000024 79.39 3419.7 1000000 0.0 + 400 0.0000048 0.00000024 83.66 3615.7 1000000 0.0 + 405 0.0000111 0.00000017 36.58 1584.1 451556 0.0 + 420 0.0000052 0.00000022 80.62 3512.6 959733 0.0 + 432 0.0000052 0.00000024 82.69 3619.9 957101 0.0 + 441 0.0000143 0.00000019 30.86 1355.3 349835 0.0 + 448 0.0000047 0.00000024 94.94 4180.9 1000000 0.0 + 450 0.0000062 0.00000023 72.13 3178.5 801407 0.0 + 480 0.0000055 0.00000022 88.04 3920.8 917089 0.0 + 486 0.0000098 0.00000026 49.72 2218.8 511535 0.0 + 490 0.0000084 0.00000023 58.35 2607.1 595360 0.0 + 500 0.0000062 0.00000024 80.31 3600.0 803056 0.0 + 504 0.0000058 0.00000025 86.53 3883.9 858405 0.0 + 512 0.0000051 0.00000022 100.06 4502.6 977120 0.0 + 525 0.0000157 0.00000015 33.52 1514.5 319246 0.0 + 540 0.0000064 0.00000024 84.13 3818.0 778940 0.0 + 560 0.0000065 0.00000024 85.52 3903.6 763550 0.0 + 567 0.0000200 0.00000020 28.39 1298.4 250342 0.0 + 576 0.0000063 0.00000023 91.77 4207.4 796578 0.0 + 588 0.0000073 0.00000025 80.20 3689.2 681989 0.0 + 600 0.0000075 0.00000024 80.29 3705.0 669108 0.0 + 625 0.0000209 0.00000019 29.92 1389.4 239358 0.0 + 630 0.0000155 0.00000025 40.77 1895.5 323539 0.0 + 640 0.0000064 0.00000022 100.15 4667.9 782411 0.0 + 648 0.0000085 0.00000024 76.24 3560.6 588306 0.0 + 672 0.0000074 0.00000023 90.43 4246.7 672841 0.0 + 675 0.0000178 0.00000016 37.99 1785.5 281443 0.0 + 686 0.0000121 0.00000022 56.54 2663.5 412075 0.0 + 700 0.0000087 0.00000024 80.67 3812.1 576207 0.0 + 720 0.0000083 0.00000023 86.93 4125.4 603649 0.0 + 729 0.0000246 0.00000020 29.65 1409.9 203371 0.0 + 735 0.0000229 0.00000016 32.15 1530.6 218709 0.0 + 750 0.0000121 0.00000026 61.91 2956.3 412712 0.0 + 756 0.0000105 0.00000027 72.00 3442.5 476205 0.0 + 768 0.0000075 0.00000023 103.04 4938.1 670825 0.0 + 784 0.0000152 0.00000024 51.68 2484.7 329622 0.0 + 800 0.0000154 0.00000023 52.02 2508.3 325122 0.0 + 810 0.0000144 0.00000027 56.29 2719.1 347443 0.0 + 840 0.0000105 0.00000024 79.71 3871.4 474438 0.0 + 864 0.0000102 0.00000023 84.95 4143.4 491612 0.0 + 875 0.0000304 0.00000019 28.75 1405.1 164312 0.0 + 882 0.0000208 0.00000027 42.35 2071.9 240080 0.0 + 896 0.0000156 0.00000025 57.34 2812.0 320004 0.0 + 900 0.0000168 0.00000025 53.70 2635.2 298351 0.0 + 945 0.0000293 0.00000018 32.21 1591.7 170410 0.0 + 960 0.0000106 0.00000023 90.19 4467.6 469752 0.0 + 972 0.0000155 0.00000027 62.79 3116.1 323010 0.0 + 980 0.0000120 0.00000025 81.64 4056.1 416530 0.0 + 1000 0.0000174 0.00000026 57.41 2860.5 287032 0.0 + 1008 0.0000118 0.00000025 85.48 4264.2 423997 0.0 + 1024 0.0000099 0.00000024 103.50 5175.0 505373 0.0 + 1029 0.0000444 0.00000017 23.17 1159.4 112593 0.0 + 1050 0.0000239 0.00000025 43.89 2202.2 208978 0.0 + 1080 0.0000126 0.00000024 85.71 4318.2 396785 0.0 + 1120 0.0000205 0.00000024 54.63 2766.7 243874 0.0 + 1125 0.0000333 0.00000017 33.74 1709.7 149936 0.0 + 1134 0.0000286 0.00000027 39.60 2008.9 174586 0.0 + 1152 0.0000204 0.00000023 56.58 2876.9 245558 0.0 + 1176 0.0000146 0.00000025 80.45 4103.0 342062 0.0 + 1200 0.0000194 0.00000025 61.90 3166.0 257930 0.0 + 1215 0.0000406 0.00000018 29.91 1532.2 123073 0.0 + 1225 0.0000447 0.00000017 27.38 1404.1 111735 0.0 + 1250 0.0000303 0.00000027 41.28 2123.4 165125 0.0 + 1260 0.0000234 0.00000025 53.82 2771.4 213566 0.0 + 1280 0.0000242 0.00000023 52.98 2734.4 206960 0.0 + 1296 0.0000161 0.00000025 80.45 4159.0 310365 0.0 + 1323 0.0000512 0.00000020 25.82 1338.8 97586 0.0 + 1344 0.0000235 0.00000025 57.21 2972.5 212821 0.0 + 1350 0.0000276 0.00000026 48.91 2543.2 181165 0.0 + 1372 0.0000275 0.00000026 49.90 2600.3 181849 0.0 + 1400 0.0000247 0.00000025 56.60 2957.8 202147 0.0 + 1440 0.0000239 0.00000024 60.35 3166.1 209561 0.0 + 1458 0.0000385 0.00000028 37.87 1989.8 129858 0.0 + 1470 0.0000291 0.00000026 50.52 2657.6 171824 0.0 + 1500 0.0000179 0.00000026 83.78 4419.8 279271 0.0 + 1512 0.0000198 0.00000026 76.51 4040.7 253014 0.0 + 1536 0.0000329 0.00000024 46.74 2473.8 152156 0.0 + 1568 0.0000191 0.00000026 82.28 4366.9 262371 0.0 + 1575 0.0000486 0.00000016 32.39 1719.9 102814 0.0 + 1600 0.0000288 0.00000025 55.46 2951.5 173313 0.0 + 1620 0.0000316 0.00000026 51.34 2736.7 158447 0.0 + 1680 0.0000201 0.00000025 83.65 4481.4 248966 0.0 + 1701 0.0000574 0.00000021 29.61 1589.0 87045 0.0 + 1715 0.0000633 0.00000017 27.08 1454.9 78962 0.0 + 1728 0.0000192 0.00000024 90.09 4844.4 260672 0.0 + 1750 0.0000347 0.00000027 50.45 2717.3 144133 0.0 + 1764 0.0000356 0.00000028 49.62 2675.6 140641 0.0 + 1792 0.0000312 0.00000026 57.51 3107.6 160460 0.0 + 1800 0.0000333 0.00000025 54.09 2924.5 150245 0.0 + 1875 0.0000753 0.00000019 24.92 1354.5 66444 0.0 + 1890 0.0000424 0.00000028 44.62 2428.1 118037 0.0 + 1920 0.0000336 0.00000025 57.16 3117.0 148845 0.0 + 1944 0.0000383 0.00000028 50.82 2775.9 130706 0.0 + 1960 0.0000361 0.00000026 54.23 2965.5 138342 0.0 + 2000 0.0000362 0.00000026 55.20 3026.7 138005 0.0 + 2016 0.0000340 0.00000025 59.21 3250.0 146859 0.0 + 2025 0.0000666 0.00000018 30.42 1670.7 75114 0.0 + 2048 0.0000356 0.00000026 57.59 3167.3 140596 0.0 + 2058 0.0000452 0.00000027 45.52 2505.2 110594 0.0 + 2100 0.0000377 0.00000026 55.77 3077.4 132784 0.0 + 2160 0.0000365 0.00000025 59.19 3278.4 137021 0.0 + 2187 0.0001085 0.00000024 20.16 1118.4 46091 0.0 + 2205 0.0000874 0.00000017 25.22 1400.6 57189 0.0 + 2240 0.0000393 0.00000026 56.98 3171.0 127197 0.0 + 2250 0.0000359 0.00000027 62.60 3485.3 139104 0.0 + 2268 0.0000351 0.00000028 64.63 3602.1 142478 0.0 + 2304 0.0000391 0.00000026 58.92 3290.4 127856 0.0 + 2352 0.0000429 0.00000026 54.83 3070.4 116562 0.0 + 2400 0.0000435 0.00000026 55.14 3095.8 114876 0.0 + 2401 0.0001024 0.00000018 23.45 1316.4 48824 0.0 + 2430 0.0000477 0.00000028 50.94 2864.6 104817 0.0 + 2450 0.0000451 0.00000026 54.27 3054.9 110750 0.0 + 2500 0.0000359 0.00000028 69.62 3929.4 139245 0.0 + 2520 0.0000433 0.00000025 58.16 3285.6 115388 0.0 + 2560 0.0000302 0.00000025 84.90 4806.2 165822 0.0 + 2592 0.0000471 0.00000027 55.05 3121.1 106184 0.0 + 2625 0.0000961 0.00000019 27.32 1551.7 52045 0.0 + 2646 0.0000626 0.00000029 42.29 2404.2 79918 0.0 + 2688 0.0000312 0.00000026 86.27 4914.2 160478 0.0 + 2700 0.0000367 0.00000027 73.63 4196.5 136355 0.0 + 2744 0.0000550 0.00000027 49.91 2850.3 90942 0.0 + 2800 0.0000498 0.00000026 56.20 3218.0 100365 0.0 + 2835 0.0001106 0.00000019 25.62 1469.3 45188 0.0 + 2880 0.0000323 0.00000026 89.11 5120.0 154699 0.1 + 2916 0.0000654 0.00000030 44.56 2564.5 76411 0.0 + 2940 0.0000568 0.00000026 51.73 2980.3 87982 0.0 + 3000 0.0000544 0.00000027 55.17 3186.4 91953 0.0 + 3024 0.0000554 0.00000027 54.60 3156.7 90284 0.0 + 3072 0.0000571 0.00000026 53.82 3117.6 87601 0.0 + 3087 0.0001333 0.00000020 23.16 1342.2 37507 0.0 + 3125 0.0001327 0.00000022 23.56 1367.4 37689 0.0 + 3136 0.0000396 0.00000027 79.21 4600.2 126298 0.0 + 3150 0.0000672 0.00000026 46.89 2724.3 74422 0.0 + 3200 0.0000608 0.00000025 52.60 3062.5 82192 0.0 + 3240 0.0000599 0.00000026 54.10 3154.7 83493 0.0 + 3360 0.0000556 0.00000026 60.41 3538.1 89891 0.0 + 3375 0.0001065 0.00000017 31.70 1857.5 46956 0.0 + 3402 0.0000755 0.00000030 45.06 2643.5 66233 0.0 + 3430 0.0000629 0.00000026 54.52 3201.3 79472 0.0 + 3456 0.0000436 0.00000025 79.29 4660.2 114712 0.0 + 3500 0.0000509 0.00000028 68.70 4044.0 98142 0.0 + 3528 0.0000487 0.00000027 72.44 4268.6 102669 0.0 + 3584 0.0000437 0.00000027 81.96 4838.4 114336 0.0 + 3600 0.0000463 0.00000026 77.73 4591.2 107953 0.1 + 3645 0.0001266 0.00000020 28.79 1703.2 39493 0.0 + 3675 0.0001391 0.00000018 26.43 1565.0 35957 0.0 + 3750 0.0000726 0.00000030 51.65 3065.8 68860 0.0 + 3780 0.0000535 0.00000027 70.66 4198.6 93464 0.0 + 3840 0.0000455 0.00000025 84.43 5026.2 109929 0.0 + 3888 0.0000583 0.00000028 66.73 3978.7 85816 0.0 + 3920 0.0000562 0.00000026 69.77 4164.3 88996 0.0 + 3969 0.0001694 0.00000022 23.43 1400.3 29513 0.0 + 4000 0.0000554 0.00000027 72.17 4317.8 90212 0.0 + 4032 0.0000533 0.00000026 75.65 4530.4 93811 0.0 + 4050 0.0000871 0.00000027 46.49 2785.4 57391 0.0 + 4096 0.0000437 0.00000026 93.79 5627.5 114491 0.0 + 4116 0.0000621 0.00000028 66.31 3980.8 80549 0.0 + 4200 0.0000742 0.00000026 56.63 3408.3 67422 0.0 + 4320 0.0000714 0.00000026 60.48 3652.3 70005 0.1 + 4374 0.0001229 0.00000030 35.59 2152.1 40681 0.0 + 4375 0.0001865 0.00000021 23.46 1418.9 26815 0.0 + 4410 0.0001021 0.00000028 43.18 2613.8 48957 0.0 + 4480 0.0000760 0.00000026 58.91 3572.9 65752 0.0 + 4500 0.0000841 0.00000027 53.54 3248.6 59486 0.0 + 4536 0.0000895 0.00000028 50.66 3076.7 55839 0.0 + 4608 0.0000523 0.00000026 88.14 5363.1 95635 0.0 + 4704 0.0000883 0.00000027 53.29 3250.7 56645 0.0 + 4725 0.0001885 0.00000017 25.07 1530.0 26529 0.0 + 4800 0.0000875 0.00000026 54.88 3355.3 57162 0.1 + 4802 0.0000955 0.00000026 50.28 3074.3 52350 0.0 + 4860 0.0000809 0.00000028 60.10 3680.2 61833 0.0 + 4900 0.0000913 0.00000028 53.67 3289.8 54769 0.0 + 5000 0.0000911 0.00000029 54.86 3370.3 54856 0.0 + 5040 0.0000872 0.00000026 57.82 3555.9 57365 0.1 + 5103 0.0002313 0.00000023 22.06 1358.7 21616 0.0 + 5120 0.0000915 0.00000026 55.97 3448.1 54655 0.0 + 5145 0.0002207 0.00000018 23.31 1437.2 22657 0.0 + 5184 0.0000896 0.00000026 57.86 3570.0 55807 0.1 + 5250 0.0001237 0.00000029 42.44 2622.3 40417 0.0 + 5292 0.0001086 0.00000030 48.74 3014.2 46047 0.0 + 5376 0.0000925 0.00000027 58.13 3601.7 54063 0.0 + 5400 0.0001014 0.00000026 53.27 3302.5 49326 0.1 + 5488 0.0001039 0.00000028 52.84 3282.0 48143 0.0 + 5600 0.0001036 0.00000027 54.07 3366.3 48279 0.0 + 5625 0.0002091 0.00000019 26.90 1675.4 23909 0.0 + 5670 0.0001190 0.00000029 47.67 2971.8 42034 0.0 + 5760 0.0001060 0.00000027 54.35 3394.8 47181 0.1 + 5832 0.0001294 0.00000030 45.08 2819.5 38646 0.0 + 5880 0.0000863 0.00000028 68.12 4264.6 57922 0.0 + 6000 0.0001117 0.00000027 53.70 3369.8 44749 0.0 + 6048 0.0001099 0.00000028 55.03 3456.6 45496 0.1 + 6075 0.0002366 0.00000019 25.68 1613.5 21132 0.0 + 6125 0.0002655 0.00000019 23.07 1451.3 18835 0.0 + 6144 0.0001157 0.00000026 53.11 3342.2 43224 0.0 + 6174 0.0001560 0.00000030 39.59 2492.3 32058 0.0 + 6250 0.0001565 0.00000030 39.94 2518.2 31953 0.0 + 6272 0.0001148 0.00000028 54.64 3446.4 43560 0.0 + 6300 0.0001222 0.00000027 51.56 3253.5 40918 0.0 + 6400 0.0001180 0.00000026 54.23 3428.3 42366 0.0 + 6480 0.0001182 0.00000026 54.81 3469.8 42290 0.1 + 6561 0.0002934 0.00000025 22.37 1417.9 17044 0.0 + 6615 0.0002858 0.00000019 23.15 1469.0 17497 0.0 + 6720 0.0001179 0.00000027 57.00 3623.2 42407 0.1 + 6750 0.0001184 0.00000028 57.03 3627.5 42247 0.0 + 6804 0.0001505 0.00000031 45.21 2878.0 33222 0.0 + 6860 0.0001322 0.00000028 51.90 3307.1 37828 0.0 + 6912 0.0001279 0.00000026 54.04 3446.5 39093 0.1 + 7000 0.0001380 0.00000028 50.71 3238.4 36219 0.0 + 7056 0.0001340 0.00000028 52.64 3364.8 37300 0.0 + 7168 0.0001256 0.00000028 57.06 3654.2 39805 0.0 + 7200 0.0001333 0.00000027 54.02 3460.9 37513 0.1 + 7203 0.0003197 0.00000019 22.53 1443.4 15638 0.0 + 7290 0.0001970 0.00000030 37.00 2374.1 25380 0.0 + 7350 0.0001705 0.00000029 43.10 2767.6 29318 0.0 + 7500 0.0001120 0.00000029 66.97 4310.7 44650 0.0 + 7560 0.0001398 0.00000028 54.09 3484.3 35771 0.1 + 7680 0.0000947 0.00000026 81.10 5233.7 52799 0.1 + 7776 0.0001192 0.00000029 65.22 4214.6 41935 0.1 + 7840 0.0001480 0.00000027 52.96 3425.6 33775 0.0 + 7875 0.0003302 0.00000018 23.85 1543.3 15141 0.0 + 7938 0.0002099 0.00000031 37.82 2449.5 23820 0.0 + 8000 0.0001197 0.00000028 66.83 4332.3 41767 0.0 + 8064 0.0001486 0.00000027 54.26 3520.6 33642 0.1 + 8100 0.0001253 0.00000027 64.63 4195.7 39895 0.0 + 8192 0.0001520 0.00000027 53.89 3503.0 32893 0.0 + 8232 0.0001578 0.00000028 52.18 3393.7 31695 0.0 + 8400 0.0001557 0.00000027 53.97 3517.6 32123 0.1 + 8505 0.0003652 0.00000021 23.29 1520.2 13692 0.0 + 8575 0.0004191 0.00000019 20.46 1336.6 11930 0.0 + 8640 0.0001517 0.00000027 56.96 3724.5 32965 0.1 + 8748 0.0002103 0.00000032 41.59 2723.0 23771 0.0 + 8750 0.0002150 0.00000029 40.70 2664.9 23258 0.0 + 8820 0.0001679 0.00000028 52.52 3441.8 29773 0.0 + 8960 0.0001595 0.00000027 56.16 3686.7 31339 0.0 + 9000 0.0001729 0.00000028 52.05 3418.8 28919 0.1 + 9072 0.0001877 0.00000029 48.34 3177.7 26643 0.1 + 9216 0.0001671 0.00000027 55.15 3631.5 29920 0.1 + 9261 0.0004381 0.00000021 21.14 1392.7 11413 0.0 + 9375 0.0003846 0.00000021 24.38 1608.1 13000 0.0 + 9408 0.0001389 0.00000028 67.73 4469.8 35994 0.0 + 9450 0.0001876 0.00000029 50.38 3326.9 26658 0.0 + 9600 0.0001217 0.00000027 78.88 5217.4 41083 0.1 + 9604 0.0001722 0.00000030 55.76 3688.5 29031 0.0 + 9720 0.0001591 0.00000028 61.09 4046.1 31424 0.1 + 9800 0.0001503 0.00000029 65.19 4321.6 33260 0.0 + 10000 0.0001520 0.00000030 65.79 4371.0 32895 0.0 + 10080 0.0001453 0.00000027 69.37 4613.1 34412 0.1 + 10125 0.0003706 0.00000018 27.32 1817.4 13490 0.0 + 10206 0.0002497 0.00000032 40.88 2721.7 20025 0.0 + 10240 0.0001329 0.00000027 77.04 5131.3 37615 0.0 + 10290 0.0002037 0.00000029 50.51 3366.2 24543 0.0 + 10368 0.0001458 0.00000028 71.13 4744.1 34301 0.1 + 10500 0.0001582 0.00000029 66.38 4433.5 31609 0.0 + 10584 0.0001759 0.00000030 60.17 4022.4 28426 0.0 + 10752 0.0001429 0.00000028 75.27 5039.9 35001 0.1 + 10800 0.0001600 0.00000028 67.50 4522.2 31251 0.1 + 10935 0.0004906 0.00000022 22.29 1495.3 10192 0.0 + 10976 0.0001666 0.00000030 65.89 4422.0 30016 0.0 + 11025 0.0004408 0.00000018 25.01 1679.3 11343 0.0 + 11200 0.0002225 0.00000028 50.34 3385.5 22472 0.0 + 11250 0.0002747 0.00000031 40.96 2755.9 18203 0.0 + 11340 0.0002344 0.00000029 48.37 3257.5 21327 0.1 + 11520 0.0002043 0.00000027 56.38 3803.4 24471 0.1 + 11664 0.0002511 0.00000031 46.45 3137.4 19910 0.1 + 11760 0.0002230 0.00000028 52.73 3564.8 22418 0.0 + 11907 0.0005564 0.00000023 21.40 1448.7 8986 0.0 + 12000 0.0001828 0.00000028 65.65 4448.3 27356 0.1 + 12005 0.0005669 0.00000019 21.18 1434.9 8820 0.0 + 12096 0.0001818 0.00000028 66.54 4511.8 27503 0.1 + 12150 0.0003172 0.00000030 38.31 2598.8 15764 0.0 + 12250 0.0002984 0.00000029 41.05 2787.7 16757 0.0 + 12288 0.0002265 0.00000028 54.25 3685.2 22076 0.0 + 12348 0.0002598 0.00000031 47.53 3230.1 19246 0.0 + 12500 0.0002676 0.00000032 46.71 3178.5 18684 0.0 + 12544 0.0002392 0.00000029 52.44 3569.7 20902 0.0 + 12600 0.0002404 0.00000028 52.40 3569.0 20795 0.1 + 12800 0.0002560 0.00000027 50.00 3410.7 19530 0.1 + 12960 0.0002621 0.00000028 49.44 3377.2 19074 0.1 + 13122 0.0004087 0.00000033 32.11 2196.2 12235 0.0 + 13125 0.0006187 0.00000020 21.21 1450.9 8081 0.0 + 13230 0.0003438 0.00000031 38.48 2634.3 14543 0.0 + 13440 0.0002683 0.00000028 50.10 3435.3 18638 0.1 + 13500 0.0002695 0.00000029 50.10 3437.1 18556 0.1 + 13608 0.0003012 0.00000032 45.17 3101.6 16598 0.1 + 13720 0.0002828 0.00000030 48.52 3334.4 17683 0.0 + 13824 0.0002561 0.00000028 53.98 3712.3 19523 0.1 + 14000 0.0002831 0.00000030 49.45 3405.7 17662 0.0 + 14112 0.0002866 0.00000029 49.23 3393.4 17444 0.1 + 14175 0.0006101 0.00000020 23.23 1602.0 8195 0.0 + 14336 0.0002476 0.00000030 57.90 3997.0 20193 0.0 + 14400 0.0002809 0.00000028 51.27 3541.1 17802 0.1 + 14406 0.0003519 0.00000031 40.93 2827.3 14207 0.0 + 14580 0.0003342 0.00000031 43.62 3016.7 14959 0.0 + 14700 0.0002949 0.00000029 49.84 3449.9 16953 0.0 + 15000 0.0002934 0.00000030 51.13 3546.7 17044 0.0 + 15120 0.0002805 0.00000029 53.91 3742.6 17828 0.1 + 15309 0.0007220 0.00000025 21.20 1473.8 6925 0.0 + 15360 0.0002958 0.00000028 51.93 3611.1 16905 0.1 + 15435 0.0007356 0.00000019 20.98 1459.7 6797 0.0 + 15552 0.0003195 0.00000030 48.67 3388.7 15648 0.1 + 15625 0.0007816 0.00000025 19.99 1392.5 6397 0.0 + 15680 0.0002990 0.00000030 52.44 3654.2 16722 0.0 + 15750 0.0003775 0.00000030 41.72 2908.4 13244 0.0 + 15876 0.0003823 0.00000032 41.53 2897.3 13078 0.0 + 16000 0.0003197 0.00000029 50.05 3495.2 15642 0.1 + 16128 0.0003075 0.00000028 52.45 3665.6 16261 0.1 + 16200 0.0003190 0.00000028 50.78 3550.7 15674 0.1 + 16384 0.0003121 0.00000029 52.49 3674.4 16019 0.0 + 16464 0.0004225 0.00000030 38.97 2729.3 11835 0.0 + 16800 0.0004064 0.00000029 41.34 2901.1 12303 0.0 + 16807 0.0008811 0.00000020 19.08 1338.8 5675 0.0 + 16875 0.0007395 0.00000020 22.82 1602.1 6761 0.0 + 17010 0.0005292 0.00000029 32.15 2258.9 9449 0.0 + 17150 0.0005862 0.00000025 29.25 2057.5 8529 0.0 + 17280 0.0004072 0.00000028 42.43 2986.6 12278 0.1 + 17496 0.0005508 0.00000032 31.77 2238.6 9078 0.0 + 17500 0.0006523 0.00000028 26.83 1890.7 7665 0.0 + 17640 0.0004459 0.00000030 39.56 2790.5 11214 0.0 + 17920 0.0003422 0.00000028 52.37 3699.7 14612 0.0 + 18000 0.0004923 0.00000029 36.56 2584.1 10156 0.1 + 18144 0.0004081 0.00000031 44.46 3144.7 12251 0.1 + 18225 0.0008109 0.00000022 22.48 1590.5 6166 0.0 + 18375 0.0008784 0.00000020 20.92 1481.6 5692 0.0 + 18432 0.0004809 0.00000028 38.33 2715.5 10397 0.1 + 18522 0.0005449 0.00000030 33.99 2409.5 9176 0.0 + 18750 0.0006266 0.00000030 29.92 2123.6 7979 0.0 + 18816 0.0004812 0.00000029 39.10 2776.0 10390 0.0 + 18900 0.0004548 0.00000028 41.55 2951.6 10993 0.0 + 19200 0.0004522 0.00000028 42.46 3020.4 11056 0.1 + 19208 0.0005821 0.00000029 33.00 2347.8 8590 0.0 + 19440 0.0005187 0.00000030 37.48 2669.9 9640 0.1 + 19600 0.0005130 0.00000030 38.21 2724.0 9747 0.0 + 19683 0.0012080 0.00000027 16.29 1162.1 4139 0.0 + 19845 0.0009337 0.00000021 21.25 1517.2 5355 0.0 + 20000 0.0005164 0.00000031 38.73 2767.0 9683 0.0 + 20160 0.0005004 0.00000028 40.29 2880.7 9993 0.1 + 20250 0.0005921 0.00000028 34.20 2446.4 8445 0.0 + 20412 0.0005655 0.00000032 36.10 2584.0 8842 0.0 + 20480 0.0005245 0.00000028 39.05 2796.2 9533 0.0 + 20580 0.0010638 0.00000020 19.35 1386.0 4700 0.0 + 20736 0.0005076 0.00000028 40.85 2929.2 9851 0.1 + 21000 0.0006244 0.00000031 33.63 2414.6 8008 0.0 + 21168 0.0005705 0.00000031 37.11 2666.1 8765 0.0 + 21504 0.0004951 0.00000029 43.43 3125.3 10098 0.0 + 21600 0.0005391 0.00000028 40.07 2884.6 9275 0.1 + 21609 0.0010951 0.00000022 19.73 1420.7 4566 0.0 + 21870 0.0007083 0.00000030 30.88 2225.6 7059 0.0 + 21875 0.0011351 0.00000024 19.27 1389.2 4405 0.0 + 21952 0.0005677 0.00000030 38.67 2788.6 8808 0.0 + 22050 0.0006672 0.00000028 33.05 2384.2 7494 0.0 + 22400 0.0006109 0.00000029 36.66 2649.2 8184 0.0 + 22500 0.0007044 0.00000029 31.94 2309.0 7098 0.0 + 22680 0.0006210 0.00000031 36.52 2642.0 8051 0.1 + 23040 0.0004213 0.00000028 54.69 3963.0 11869 0.1 + 23328 0.0005473 0.00000031 42.62 3092.1 9135 0.1 + 23520 0.0005104 0.00000029 46.09 3346.1 9797 0.0 + 23625 0.0011030 0.00000020 21.42 1555.8 4533 0.0 + 23814 0.0007635 0.00000031 31.19 2267.6 6549 0.0 + 24000 0.0004985 0.00000029 48.14 3502.7 10030 0.1 + 24010 0.0005144 0.00000030 46.68 3396.0 9720 0.1 + 24192 0.0004989 0.00000029 48.50 3531.0 10023 0.1 + 24300 0.0007742 0.00000028 31.39 2286.3 6458 0.0 + 24500 0.0007221 0.00000028 33.93 2473.4 6924 0.0 + 24576 0.0004608 0.00000028 53.33 3889.1 10850 0.0 + 24696 0.0006932 0.00000031 35.63 2599.3 7213 0.0 + 25000 0.0006889 0.00000032 36.29 2650.9 7258 0.0 + 25088 0.0005925 0.00000030 42.34 3094.2 8439 0.0 + 25200 0.0006510 0.00000029 38.71 2829.7 7680 0.1 + 25515 0.0012960 0.00000022 19.69 1441.0 3858 0.0 + 25600 0.0004787 0.00000028 53.48 3915.6 10445 0.1 + 25725 0.0013441 0.00000020 19.14 1402.0 3720 0.0 + 25920 0.0006472 0.00000029 40.05 2935.8 7725 0.1 + 26244 0.0008798 0.00000033 29.83 2189.4 5683 0.0 + 26250 0.0008887 0.00000029 29.54 2168.0 5626 0.0 + 26460 0.0008240 0.00000029 32.11 2358.9 6068 0.0 + 26880 0.0005164 0.00000029 52.06 3829.8 9683 0.1 + 27000 0.0006492 0.00000030 41.59 3061.2 7702 0.1 + 27216 0.0007853 0.00000032 34.66 2552.9 6367 0.1 + 27440 0.0007086 0.00000030 38.72 2854.7 7056 0.0 + 27648 0.0006702 0.00000028 41.26 3043.7 7461 0.1 + 27783 0.0015337 0.00000024 18.11 1337.0 3260 0.0 + 28000 0.0006075 0.00000030 46.09 3404.3 8230 0.0 + 28125 0.0012990 0.00000022 21.65 1599.9 3849 0.0 + 28224 0.0005987 0.00000030 47.15 3485.1 8352 0.1 + 28350 0.0008318 0.00000029 34.08 2520.6 6011 0.0 + 28672 0.0006654 0.00000030 43.09 3190.1 7514 0.0 + 28800 0.0007367 0.00000029 39.09 2895.6 6787 0.1 + 28812 0.0016287 0.00000022 17.69 1310.4 3070 0.0 + 29160 0.0009764 0.00000032 29.87 2214.8 5121 0.1 + 29400 0.0008798 0.00000031 33.42 2480.1 5683 0.0 + 30000 0.0007664 0.00000031 39.14 2910.9 6524 0.0 + 30240 0.0006426 0.00000030 47.06 3502.2 7781 0.1 + 30375 0.0013189 0.00000020 23.03 1714.7 3791 0.0 + 30618 0.0010489 0.00000033 29.19 2175.0 4767 0.0 + 30625 0.0016113 0.00000021 19.01 1416.2 3103 0.0 + 30720 0.0007343 0.00000028 41.83 3118.1 6809 0.1 + 30870 0.0009430 0.00000029 32.73 2441.0 5302 0.0 + 31104 0.0008159 0.00000030 38.12 2844.7 6128 0.1 + 31250 0.0011114 0.00000031 28.12 2099.3 4499 0.0 + 31360 0.0008001 0.00000029 39.19 2927.1 6249 0.0 + 31500 0.0008381 0.00000029 37.59 2808.2 5966 0.0 + 31752 0.0010593 0.00000033 29.97 2241.2 4720 0.0 + 32000 0.0008046 0.00000030 39.77 2975.9 6214 0.0 + 32256 0.0008121 0.00000029 39.72 2974.5 6157 0.1 + 32400 0.0008281 0.00000029 39.13 2931.3 6038 0.1 + 32768 0.0007732 0.00000029 42.38 3178.7 6467 0.0 + 32805 0.0015305 0.00000024 21.43 1607.8 3267 0.0 + 32928 0.0008331 0.00000031 39.53 2965.9 6002 0.0 + 33075 0.0016739 0.00000021 19.76 1483.3 2987 0.0 + 33600 0.0008495 0.00000029 39.55 2973.7 5886 0.1 + 33614 0.0008898 0.00000030 37.78 2840.1 5619 0.0 + 33750 0.0010598 0.00000030 31.85 2395.3 4718 0.0 + 34020 0.0010389 0.00000029 32.75 2464.9 4813 0.0 + 34300 0.0010916 0.00000028 31.42 2367.0 4584 0.0 + 34560 0.0008384 0.00000028 41.22 3107.6 5964 0.1 + 34992 0.0010432 0.00000034 33.54 2531.6 4793 0.1 + 35000 0.0010816 0.00000031 32.36 2442.3 4630 0.0 + 35280 0.0008968 0.00000030 39.34 2971.4 5584 0.1 + 35721 0.0019615 0.00000026 18.21 1377.1 2553 0.0 + 35840 0.0009223 0.00000029 38.86 2939.4 5421 0.1 + 36000 0.0009244 0.00000030 38.94 2947.2 5413 0.1 + 36015 0.0018748 0.00000020 19.21 1453.9 2667 0.1 + 36288 0.0009638 0.00000031 37.65 2851.6 5192 0.1 + 36450 0.0011163 0.00000030 32.65 2474.0 4479 0.0 + 36750 0.0012352 0.00000029 29.75 2256.0 4051 0.0 + 36864 0.0008856 0.00000029 41.63 3157.4 5646 0.1 + 37044 0.0009972 0.00000031 37.15 2818.9 5014 0.0 + 37500 0.0010960 0.00000030 34.22 2599.4 4562 0.0 + 37632 0.0009541 0.00000030 39.44 2997.7 5249 0.1 + 37800 0.0011325 0.00000030 33.38 2537.7 4415 0.1 + 38400 0.0009429 0.00000029 40.73 3101.0 5307 0.1 + 38416 0.0011698 0.00000032 32.84 2500.7 4281 0.0 + 38880 0.0010404 0.00000030 37.37 2849.0 4806 0.1 + 39200 0.0010168 0.00000030 38.55 2941.2 4925 0.0 + 39366 0.0016252 0.00000034 24.22 1848.8 3079 0.0 + 39375 0.0019142 0.00000021 20.57 1570.0 2612 0.0 + 39690 0.0014152 0.00000031 28.04 2142.1 3533 0.0 + 40000 0.0010433 0.00000031 38.34 2930.5 4796 0.0 + 40320 0.0010277 0.00000029 39.23 3001.2 4869 0.1 + 40500 0.0012463 0.00000029 32.50 2486.9 4015 0.1 + 40824 0.0014432 0.00000034 28.29 2166.4 3470 0.0 + 40960 0.0011654 0.00000029 35.15 2692.5 4297 0.0 + 41160 0.0013354 0.00000031 30.82 2362.3 3750 0.0 + 41472 0.0010252 0.00000029 40.45 3102.6 4877 0.2 + 42000 0.0010832 0.00000031 38.77 2977.5 4616 0.1 + 42336 0.0011563 0.00000032 36.61 2813.6 4324 0.1 + 42525 0.0020333 0.00000021 20.91 1607.9 2459 0.0 + 42875 0.0026028 0.00000020 16.47 1267.4 1921 0.0 + 43008 0.0010410 0.00000030 41.32 3179.7 4807 0.1 + 43200 0.0011353 0.00000029 38.05 2929.7 4404 0.2 + 43218 0.0014055 0.00000030 30.75 2367.6 3563 0.0 + 43740 0.0012444 0.00000031 35.15 2709.4 4018 0.0 + 43750 0.0015738 0.00000030 27.80 2142.9 3177 0.0 + 43904 0.0011157 0.00000031 39.35 3034.4 4485 0.0 + 44100 0.0011872 0.00000030 37.15 2865.6 4215 0.0 + 44800 0.0011518 0.00000030 38.90 3005.1 4348 0.1 + 45000 0.0013660 0.00000032 32.94 2546.1 3666 0.1 + 45360 0.0012385 0.00000031 36.62 2832.7 4037 0.1 + 45927 0.0027248 0.00000028 16.86 1305.2 1835 0.0 + 46080 0.0008662 0.00000029 53.20 4120.8 5777 0.2 + 46305 0.0025569 0.00000021 18.11 1403.4 1957 0.0 + 46656 0.0011044 0.00000032 42.25 3276.2 4531 0.1 + 46875 0.0026137 0.00000024 17.93 1391.4 1916 0.0 + 47040 0.0010208 0.00000030 46.08 3576.3 4902 0.1 + 47250 0.0017082 0.00000030 27.66 2147.5 2927 0.0 + 47628 0.0016238 0.00000032 29.33 2279.0 3084 0.0 + 48000 0.0012318 0.00000030 38.97 3029.8 4059 0.1 + 48020 0.0028891 0.00000021 16.62 1292.4 1732 0.0 + 48384 0.0012116 0.00000030 39.93 3107.3 4130 0.1 + 48600 0.0015216 0.00000031 31.94 2486.3 3286 0.1 + 49000 0.0015031 0.00000031 32.60 2539.5 3329 0.0 + 49152 0.0012307 0.00000030 39.94 3112.3 4066 0.1 + 49392 0.0013549 0.00000032 36.45 2841.9 3696 0.0 + 50000 0.0014265 0.00000034 35.05 2735.6 3505 0.0 + 50176 0.0012880 0.00000031 38.96 3041.5 3882 0.0 + 50400 0.0012794 0.00000030 39.39 3076.7 3911 0.2 + 50421 0.0029360 0.00000022 17.17 1341.4 1703 0.1 + 50625 0.0025445 0.00000021 19.90 1554.6 1965 0.0 + 51030 0.0016756 0.00000032 30.45 2381.4 2984 0.0 + 51200 0.0013245 0.00000029 38.66 3023.7 3778 0.1 + 51450 0.0018038 0.00000028 28.52 2232.1 2772 0.0 + 51840 0.0013362 0.00000029 38.80 3038.2 3742 0.2 + 52488 0.0019562 0.00000035 26.83 2103.6 2556 0.1 + 52500 0.0015499 0.00000029 33.87 2655.6 3231 0.0 + 52920 0.0015397 0.00000032 34.37 2696.7 3250 0.1 + 53760 0.0014634 0.00000029 36.74 2886.4 3422 0.1 + 54000 0.0014017 0.00000031 38.53 3028.3 3570 0.1 + 54432 0.0015610 0.00000033 34.87 2742.8 3208 0.1 + 54675 0.0027917 0.00000023 19.58 1541.2 1791 0.0 + 54880 0.0014944 0.00000031 36.72 2890.8 3351 0.0 + 55125 0.0028399 0.00000020 19.41 1528.6 1762 0.0 + 55296 0.0014184 0.00000029 38.98 3070.9 3525 0.1 + 55566 0.0020964 0.00000033 26.50 2088.8 2385 0.0 + 56000 0.0014802 0.00000031 37.83 2983.8 3378 0.1 + 56250 0.0019731 0.00000030 28.51 2249.2 2536 0.0 + 56448 0.0015432 0.00000031 36.58 2886.8 3245 0.1 + 56700 0.0017502 0.00000029 32.40 2557.8 2859 0.1 + 57344 0.0011284 0.00000031 50.82 4016.6 4438 0.0 + 57600 0.0012002 0.00000029 47.99 3794.7 4166 0.2 + 57624 0.0015939 0.00000032 36.15 2858.7 3137 0.0 + 58320 0.0021851 0.00000032 26.69 2112.8 2299 0.1 + 58800 0.0016303 0.00000031 36.07 2857.2 3067 0.1 + 59049 0.0034626 0.00000029 17.05 1351.4 1444 0.0 + 59535 0.0032787 0.00000023 18.16 1440.1 1525 0.0 + 60000 0.0013038 0.00000032 46.02 3652.3 3835 0.1 + 60025 0.0034037 0.00000020 17.64 1399.7 1469 0.0 + 60480 0.0015528 0.00000030 38.95 3093.4 3220 0.2 + 60750 0.0017775 0.00000030 34.18 2715.5 2813 0.0 + 61236 0.0018149 0.00000034 33.74 2682.8 2755 0.1 + 61250 0.0021701 0.00000029 28.22 2244.1 2304 0.0 + 61440 0.0015625 0.00000030 39.32 3127.4 3200 0.1 + 61740 0.0016678 0.00000031 37.02 2945.6 2998 0.0 + 62208 0.0017065 0.00000031 36.45 2902.6 2930 0.2 + 62500 0.0019952 0.00000033 31.33 2495.3 2506 0.0 + 62720 0.0016573 0.00000031 37.85 3015.6 3017 0.1 + 63000 0.0019128 0.00000032 32.94 2625.5 2614 0.1 + 63504 0.0018268 0.00000034 34.76 2773.1 2737 0.1 + 64000 0.0013816 0.00000030 46.32 3697.9 3619 0.1 + 64512 0.0015995 0.00000030 40.33 3222.1 3126 0.1 + 64800 0.0016335 0.00000030 39.67 3170.4 3061 0.2 + 64827 0.0039124 0.00000024 16.57 1324.3 1278 0.0 + 65536 0.0012953 0.00000031 50.59 4047.5 3860 0.0 + 65610 0.0025189 0.00000032 26.05 2084.0 1985 0.0 + 65625 0.0037651 0.00000023 17.43 1394.6 1328 0.0 + 65856 0.0016518 0.00000031 39.87 3190.9 3027 0.0 + 66150 0.0024667 0.00000031 26.82 2147.2 2027 0.0 + 67200 0.0019433 0.00000030 34.58 2772.7 2573 0.1 + 67228 0.0016250 0.00000033 41.37 3317.4 3077 0.1 + 67500 0.0021106 0.00000030 31.98 2565.3 2369 0.1 + 68040 0.0020825 0.00000030 32.67 2622.7 2401 0.1 + 68600 0.0021768 0.00000029 31.51 2531.6 2297 0.0 + 69120 0.0020342 0.00000029 33.98 2731.4 2458 0.2 + 69984 0.0027071 0.00000033 25.85 2080.4 1847 0.1 + 70000 0.0024925 0.00000030 28.08 2260.1 2006 0.0 + 70560 0.0023256 0.00000031 30.34 2443.4 2150 0.1 + 70875 0.0035336 0.00000021 20.06 1615.9 1415 0.0 + 71442 0.0024522 0.00000034 29.13 2348.9 2039 0.0 + 71680 0.0018954 0.00000029 37.82 3049.9 2638 0.1 + 72000 0.0020868 0.00000030 34.50 2783.6 2396 0.2 + 72030 0.0019216 0.00000033 37.48 3024.3 2602 0.2 + 72576 0.0022114 0.00000031 32.82 2649.7 2261 0.2 + 72900 0.0022272 0.00000030 32.73 2643.7 2245 0.1 + 73500 0.0023540 0.00000029 31.22 2523.7 2124 0.0 + 73728 0.0015738 0.00000029 46.85 3787.5 3177 0.2 + 74088 0.0023170 0.00000031 31.98 2586.4 2158 0.0 + 75000 0.0023202 0.00000031 32.33 2617.5 2155 0.0 + 75264 0.0021968 0.00000030 34.26 2775.0 2276 0.1 + 75600 0.0022292 0.00000029 33.91 2748.1 2243 0.1 + 76545 0.0042337 0.00000025 18.08 1466.6 1181 0.0 + 76800 0.0021106 0.00000029 36.39 2952.7 2369 0.2 + 76832 0.0026539 0.00000029 28.95 2349.2 1884 0.0 + 77175 0.0043328 0.00000021 17.81 1446.0 1154 0.0 + 77760 0.0024027 0.00000031 32.36 2629.0 2081 0.2 + 78125 0.0046253 0.00000027 16.89 1372.7 1081 0.0 + 78400 0.0023116 0.00000031 33.92 2757.1 2163 0.1 + 78732 0.0025240 0.00000035 31.19 2536.8 1981 0.0 + 78750 0.0030694 0.00000030 25.66 2086.5 1629 0.0 + 79380 0.0021450 0.00000031 37.01 3011.7 2331 0.1 + 80000 0.0019936 0.00000032 40.13 3268.0 2508 0.1 + 80640 0.0019223 0.00000029 41.95 3418.7 2601 0.2 + 81000 0.0021730 0.00000030 37.28 3039.1 2301 0.1 + 81648 0.0026441 0.00000032 30.88 2519.3 1891 0.1 + 81920 0.0022894 0.00000029 35.78 2920.2 2184 0.1 + 82320 0.0048733 0.00000022 16.89 1379.1 1026 0.0 + 82944 0.0023923 0.00000030 34.67 2832.6 2090 0.2 + 83349 0.0046685 0.00000025 17.85 1459.2 1071 0.0 + 84000 0.0028506 0.00000032 29.47 2410.1 1754 0.1 + 84035 0.0051921 0.00000021 16.19 1323.8 963 0.1 + 84375 0.0043860 0.00000022 19.24 1574.1 1140 0.0 + 84672 0.0026302 0.00000032 32.19 2634.9 1901 0.1 + 85050 0.0032031 0.00000031 26.55 2174.1 1561 0.1 + 85750 0.0034435 0.00000029 24.90 2040.4 1452 0.0 + 86016 0.0022831 0.00000030 37.68 3087.9 2190 0.1 + 86400 0.0024402 0.00000029 35.41 2903.1 2049 0.3 + 86436 0.0029189 0.00000033 29.61 2428.2 1713 0.0 + 87480 0.0029019 0.00000031 30.15 2474.5 1723 0.1 + 87500 0.0032154 0.00000032 27.21 2233.7 1555 0.0 + 87808 0.0025602 0.00000031 34.30 2816.2 1953 0.0 + 88200 0.0027563 0.00000030 32.00 2628.5 1814 0.1 + 89600 0.0025934 0.00000030 34.55 2841.9 1928 0.1 + 90000 0.0029053 0.00000030 30.98 2549.1 1721 0.1 + 90720 0.0027624 0.00000032 32.84 2704.3 1810 0.2 + 91125 0.0045086 0.00000021 20.21 1665.0 1109 0.0 + 91854 0.0037037 0.00000035 24.80 2044.4 1350 0.0 + 91875 0.0050352 0.00000022 18.25 1504.2 993 0.0 + 92160 0.0019486 0.00000030 47.30 3900.0 2566 0.1 + 92610 0.0034083 0.00000032 27.17 2241.5 1467 0.0 + 93312 0.0025368 0.00000032 36.78 3036.4 1971 0.1 + 93750 0.0034602 0.00000033 27.09 2237.5 1445 0.0 + 94080 0.0027594 0.00000030 34.09 2816.5 1812 0.1 + 94500 0.0030048 0.00000030 31.45 2599.0 1664 0.1 + 95256 0.0031706 0.00000033 30.04 2484.5 1577 0.1 + 96000 0.0027042 0.00000030 35.50 2937.8 1849 0.1 + 96040 0.0025176 0.00000032 38.15 3156.9 1986 0.2 + 96768 0.0029586 0.00000030 32.71 2708.6 1690 0.1 + 97200 0.0025988 0.00000030 37.40 3098.6 1924 0.2 + 98000 0.0035361 0.00000029 27.71 2297.6 1414 0.0 + 98304 0.0021240 0.00000030 46.28 3837.9 2354 0.1 + 98415 0.0058207 0.00000026 16.91 1402.2 859 0.0 + 98784 0.0031387 0.00000032 31.47 2611.0 1593 0.1 + 99225 0.0051975 0.00000022 19.09 1584.4 962 0.0 + 100000 0.0031095 0.00000033 32.16 2670.8 1608 0.1 + 100352 0.0026954 0.00000031 37.23 3092.9 1855 0.0 + 100800 0.0029377 0.00000030 34.31 2851.5 1702 0.2 + 100842 0.0028969 0.00000034 34.81 2893.1 1726 0.1 + 101250 0.0036523 0.00000032 27.72 2304.8 1369 0.1 + 102060 0.0033852 0.00000032 30.15 2508.2 1477 0.1 + 102400 0.0022202 0.00000029 46.12 3838.2 2252 0.1 + 102900 0.0033003 0.00000030 31.18 2595.8 1515 0.0 + 103680 0.0031726 0.00000030 32.68 2722.5 1576 0.3 + 104976 0.0036684 0.00000033 28.62 2386.6 1363 0.1 + 105000 0.0032744 0.00000030 32.07 2674.4 1527 0.1 + 105840 0.0033445 0.00000031 31.65 2641.1 1495 0.1 + 107163 0.0064433 0.00000027 16.63 1389.5 776 0.0 + 107520 0.0028539 0.00000030 37.68 3148.5 1752 0.1 + 108000 0.0029815 0.00000031 36.22 3028.4 1677 0.3 + 108045 0.0068681 0.00000023 15.73 1315.2 728 0.0 + 108864 0.0035511 0.00000033 30.66 2564.7 1408 0.2 + 109350 0.0040064 0.00000032 27.29 2284.3 1248 0.1 + 109375 0.0065531 0.00000026 16.69 1396.9 763 0.0 + 109760 0.0033670 0.00000031 32.60 2729.2 1485 0.0 + 110250 0.0041528 0.00000031 26.55 2223.5 1204 0.1 + 110592 0.0025214 0.00000029 43.86 3674.4 1983 0.2 + 111132 0.0037764 0.00000033 29.43 2466.3 1324 0.1 + 112000 0.0033422 0.00000031 33.51 2810.4 1496 0.1 + 112500 0.0038880 0.00000033 28.93 2427.6 1286 0.1 + 112896 0.0032701 0.00000031 34.52 2897.3 1529 0.1 + 113400 0.0036179 0.00000030 31.34 2631.5 1382 0.2 + 114688 0.0032489 0.00000031 35.30 2966.6 1539 0.1 + 115200 0.0033852 0.00000030 34.03 2860.9 1477 0.3 + 115248 0.0073855 0.00000024 15.60 1311.9 677 0.0 + 116640 0.0037850 0.00000032 30.82 2593.5 1321 0.2 + 117600 0.0041220 0.00000032 28.53 2402.7 1213 0.1 + 117649 0.0077640 0.00000022 15.15 1276.2 644 0.0 + 118098 0.0047755 0.00000036 24.73 2083.4 1047 0.0 + 118125 0.0068120 0.00000021 17.34 1461.0 734 0.1 + 119070 0.0044643 0.00000033 26.67 2248.6 1120 0.1 + 120000 0.0035765 0.00000032 33.55 2830.6 1398 0.2 + 120050 0.0051600 0.00000028 23.27 1962.8 969 0.0 + 120960 0.0040420 0.00000030 29.93 2526.3 1237 0.2 + 121500 0.0055371 0.00000030 21.94 1853.1 903 0.2 + 122472 0.0036982 0.00000034 33.12 2798.7 1352 0.1 + 122500 0.0046642 0.00000031 26.26 2219.6 1072 0.1 + 122880 0.0034916 0.00000029 35.19 2975.0 1432 0.1 + 123480 0.0040883 0.00000032 30.20 2554.3 1223 0.0 + 124416 0.0037509 0.00000031 33.17 2806.9 1333 0.2 + 125000 0.0046598 0.00000033 26.82 2270.9 1073 0.1 + 125440 0.0038197 0.00000030 32.84 2781.0 1309 0.1 + 126000 0.0040917 0.00000030 30.79 2608.8 1222 0.2 + 127008 0.0047214 0.00000033 26.90 2280.4 1059 0.1 + 127575 0.0069252 0.00000023 18.42 1562.3 722 0.1 + 128000 0.0041017 0.00000031 31.21 2647.2 1219 0.1 + 128625 0.0079618 0.00000021 16.16 1371.0 628 0.0 + 129024 0.0038521 0.00000030 33.49 2843.2 1298 0.1 + 129600 0.0038790 0.00000031 33.41 2837.2 1289 0.3 + 129654 0.0048733 0.00000033 26.61 2259.3 1026 0.0 + 131072 0.0036232 0.00000030 36.18 3074.9 1380 0.1 + 131220 0.0046083 0.00000033 28.47 2420.6 1085 0.1 + 131250 0.0055249 0.00000032 23.76 2019.5 905 0.1 + 131712 0.0034247 0.00000031 38.46 3270.4 1460 0.1 + 132300 0.0043215 0.00000031 30.61 2604.3 1157 0.1 + 134400 0.0034176 0.00000030 39.33 3349.8 1463 0.2 + 134456 0.0038551 0.00000034 34.88 2971.0 1297 0.1 + 135000 0.0045413 0.00000031 29.73 2533.1 1101 0.2 + 136080 0.0044366 0.00000031 30.67 2615.5 1127 0.2 + 137200 0.0045126 0.00000030 30.40 2594.3 1108 0.1 + 137781 0.0084459 0.00000029 16.31 1392.5 592 0.1 + 138240 0.0035186 0.00000029 39.29 3354.6 1421 0.3 + 138915 0.0086059 0.00000023 16.14 1378.8 581 0.0 + 139968 0.0044563 0.00000034 31.41 2684.6 1122 0.2 + 140000 0.0045496 0.00000032 30.77 2630.2 1099 0.1 + 140625 0.0077640 0.00000024 18.11 1548.8 644 0.1 + 141120 0.0036525 0.00000031 38.64 3304.7 1370 0.1 + 141750 0.0051440 0.00000032 27.56 2357.8 972 0.1 + 142884 0.0050865 0.00000035 28.09 2405.2 983 0.1 + 143360 0.0035088 0.00000030 40.86 3499.3 1425 0.1 + 144000 0.0037258 0.00000031 38.65 3311.4 1342 0.2 + 144060 0.0040617 0.00000033 35.47 3038.9 1231 0.4 + 145152 0.0038850 0.00000032 37.36 3203.3 1287 0.2 + 145800 0.0047574 0.00000030 30.65 2628.6 1051 0.2 + 147000 0.0054466 0.00000030 26.99 2316.4 918 0.1 + 147456 0.0034200 0.00000030 43.12 3701.5 1462 0.2 + 148176 0.0046729 0.00000032 31.71 2723.4 1070 0.0 + 150000 0.0055804 0.00000031 26.88 2311.0 896 0.1 + 150528 0.0038314 0.00000031 39.29 3378.7 1305 0.1 + 151200 0.0046339 0.00000032 32.63 2807.1 1079 0.2 + 151263 0.0100558 0.00000024 15.04 1294.1 498 0.1 + 151875 0.0080128 0.00000021 18.95 1631.2 624 0.1 + 153090 0.0069541 0.00000032 22.01 1895.9 719 0.1 + 153125 0.0095057 0.00000023 16.11 1387.3 526 0.1 + 153600 0.0036258 0.00000030 42.36 3649.3 1379 0.2 + 153664 0.0044484 0.00000032 34.54 2975.8 1124 0.0 + 154350 0.0060241 0.00000031 25.62 2208.1 830 0.0 + 155520 0.0042845 0.00000031 36.30 3130.1 1167 0.2 + 156250 0.0060606 0.00000035 25.78 2224.1 825 0.0 + 156800 0.0041391 0.00000031 37.88 3269.0 1208 0.1 + 157464 0.0065445 0.00000034 24.06 2077.0 764 0.1 + 157500 0.0051600 0.00000030 30.52 2634.9 969 0.1 + 158760 0.0065274 0.00000031 24.32 2101.0 766 0.1 + 160000 0.0042808 0.00000032 37.38 3230.7 1168 0.1 + 161280 0.0039185 0.00000030 41.16 3560.1 1276 0.2 + 162000 0.0059453 0.00000029 27.25 2357.8 841 0.2 + 163296 0.0059382 0.00000035 27.50 2381.0 842 0.1 + 163840 0.0039809 0.00000030 41.16 3564.6 1256 0.1 + 164025 0.0098039 0.00000025 16.73 1449.2 510 0.1 + 164640 0.0051230 0.00000032 32.14 2784.6 976 0.0 + 165375 0.0094877 0.00000022 17.43 1510.8 527 0.1 + 165888 0.0041597 0.00000030 39.88 3457.5 1202 0.2 + 166698 0.0075075 0.00000033 22.20 1925.9 666 0.0 + 168000 0.0044444 0.00000032 37.80 3280.7 1125 0.2 + 168070 0.0058343 0.00000033 28.81 2500.3 857 0.1 + 168750 0.0067024 0.00000031 25.18 2186.0 746 0.1 + 169344 0.0046041 0.00000032 36.78 3194.4 1086 0.1 + 170100 0.0068399 0.00000032 24.87 2160.6 731 0.1 + 171500 0.0065445 0.00000031 26.21 2278.3 764 0.1 + 172032 0.0041771 0.00000031 41.18 3581.5 1197 0.1 + 172800 0.0045496 0.00000030 37.98 3304.1 1099 0.2 + 172872 0.0064020 0.00000030 27.00 2349.1 781 0.0 + 174960 0.0057737 0.00000031 30.30 2638.9 866 0.1 + 175000 0.0057604 0.00000032 30.38 2645.6 868 0.1 + 175616 0.0044053 0.00000032 39.86 3472.6 1135 0.1 + 176400 0.0066667 0.00000030 26.46 2305.8 750 0.1 + 177147 0.0136612 0.00000031 12.97 1130.4 366 0.1 + 178605 0.0109649 0.00000024 16.29 1420.9 456 0.1 + 179200 0.0046904 0.00000030 38.21 3333.7 1066 0.2 + 180000 0.0055494 0.00000033 32.44 2831.3 901 0.2 + 180075 0.0120380 0.00000022 14.96 1305.8 416 0.1 + 181440 0.0050659 0.00000032 35.82 3128.4 987 0.2 + 182250 0.0081699 0.00000031 22.31 1949.2 612 0.1 + 183708 0.0076103 0.00000035 24.14 2110.6 657 0.1 + 183750 0.0076805 0.00000032 23.92 2091.9 651 0.1 + 184320 0.0043554 0.00000030 42.32 3701.3 1148 0.3 + 185220 0.0113895 0.00000022 16.26 1422.9 439 0.1 + 186624 0.0053135 0.00000033 35.12 3074.9 941 0.2 + 187500 0.0072359 0.00000033 25.91 2269.5 691 0.1 + 188160 0.0050454 0.00000031 37.29 3267.2 991 0.1 + 189000 0.0071023 0.00000030 26.61 2332.2 704 0.1 + 190512 0.0074627 0.00000033 25.53 2238.8 670 0.1 + 192000 0.0047985 0.00000031 40.01 3511.3 1042 0.2 + 192080 0.0129534 0.00000023 14.83 1301.3 386 0.1 + 193536 0.0050352 0.00000031 38.44 3375.1 993 0.2 + 194400 0.0062657 0.00000032 31.03 2725.4 798 0.2 + 194481 0.0127877 0.00000026 15.21 1336.0 391 0.1 + 196000 0.0068399 0.00000031 28.66 2518.9 731 0.1 + 196608 0.0049407 0.00000031 39.79 3498.8 1012 0.1 + 196830 0.0091743 0.00000033 21.45 1886.6 545 0.1 + 196875 0.0119048 0.00000023 16.54 1454.2 420 0.1 + 197568 0.0055804 0.00000033 35.40 3114.2 896 0.1 + 198450 0.0089928 0.00000032 22.07 1941.8 556 0.1 + 200000 0.0058411 0.00000035 34.24 3014.8 856 0.1 + 200704 0.0052301 0.00000032 38.37 3379.8 956 0.1 + 201600 0.0054645 0.00000031 36.89 3250.5 915 0.3 + 201684 0.0061728 0.00000035 32.67 2878.8 810 0.2 + 202500 0.0066756 0.00000030 30.33 2673.6 749 0.1 + 204120 0.0092593 0.00000032 22.04 1944.3 540 0.1 + 204800 0.0053248 0.00000030 38.46 3393.0 939 0.2 + 205800 0.0078864 0.00000030 26.10 2303.0 634 0.1 + 207360 0.0052521 0.00000030 39.48 3486.6 952 0.3 + 209952 0.0082031 0.00000035 25.59 2262.5 610 0.1 + 210000 0.0078493 0.00000031 26.75 2365.1 637 0.1 + 211680 0.0069156 0.00000033 30.61 2707.6 723 0.1 + 212625 0.0130752 0.00000022 16.26 1439.0 383 0.1 + 214326 0.0100000 0.00000034 21.43 1897.8 500 0.1 + 214375 0.0147059 0.00000022 14.58 1290.8 340 0.1 + 215040 0.0056117 0.00000030 38.32 3394.1 891 0.2 + 216000 0.0055804 0.00000031 38.71 3429.6 896 0.2 + 216090 0.0077760 0.00000035 27.79 2462.3 643 0.4 + 217728 0.0063857 0.00000034 34.10 3023.0 783 0.2 + 218700 0.0094340 0.00000033 23.18 2056.1 530 0.1 + 218750 0.0095602 0.00000033 22.88 2029.4 523 0.1 + 219520 0.0060753 0.00000032 36.13 3205.7 823 0.1 + 220500 0.0083612 0.00000030 26.37 2340.6 598 0.1 + 221184 0.0055804 0.00000030 39.64 3518.7 896 0.2 + 222264 0.0097466 0.00000033 22.80 2025.2 513 0.1 + 224000 0.0061652 0.00000032 36.33 3228.7 811 0.2 + 225000 0.0086059 0.00000032 26.15 2324.2 581 0.1 + 225792 0.0060386 0.00000032 37.39 3324.9 828 0.2 + 226800 0.0073314 0.00000030 30.94 2751.9 682 0.2 + 229376 0.0055556 0.00000032 41.29 3676.1 900 0.1 + 229635 0.0140449 0.00000026 16.35 1455.9 356 0.1 + 230400 0.0059737 0.00000030 38.57 3435.3 837 0.3 + 230496 0.0076687 0.00000033 30.06 2677.2 652 0.1 + 231525 0.0155763 0.00000023 14.86 1324.4 321 0.1 + 233280 0.0070621 0.00000033 33.03 2945.1 708 0.2 + 234375 0.0140275 0.00000027 16.71 1490.2 357 0.1 + 235200 0.0062972 0.00000032 37.35 3332.3 794 0.1 + 235298 0.0088810 0.00000034 26.49 2363.9 563 0.1 + 236196 0.0102459 0.00000036 23.05 2057.4 488 0.1 + 236250 0.0098232 0.00000032 24.05 2146.5 509 0.1 + 238140 0.0109890 0.00000032 21.67 1935.4 455 0.1 + 240000 0.0066050 0.00000032 36.34 3247.1 757 0.2 + 240100 0.0097656 0.00000031 24.59 2197.2 512 0.1 + 241920 0.0064851 0.00000031 37.30 3335.8 771 0.2 + 243000 0.0083056 0.00000030 29.26 2617.1 602 0.2 + 244944 0.0098232 0.00000034 24.94 2232.0 509 0.1 + 245000 0.0096154 0.00000031 25.48 2280.8 520 0.1 + 245760 0.0063211 0.00000031 38.88 3481.0 791 0.2 + 246960 0.0095238 0.00000031 25.93 2322.6 525 0.1 + 248832 0.0068681 0.00000032 36.23 3247.1 728 0.2 + 250000 0.0082645 0.00000034 30.25 2712.1 605 0.1 + 250047 0.0163934 0.00000027 15.25 1367.6 305 0.6 + 250880 0.0064516 0.00000032 38.89 3487.5 775 0.1 + 252000 0.0079872 0.00000033 31.55 2830.6 626 0.2 + 252105 0.0182482 0.00000022 13.82 1239.5 274 0.2 + 253125 0.0140845 0.00000022 17.97 1612.9 355 0.1 + 254016 0.0077160 0.00000034 32.92 2955.4 648 0.2 + 255150 0.0108394 0.00000033 23.54 2113.9 462 0.1 + 256000 0.0066756 0.00000031 38.35 3444.8 749 0.1 + 257250 0.0097809 0.00000032 26.30 2363.5 512 0.1 + 258048 0.0067024 0.00000031 38.50 3460.7 746 0.2 + 259200 0.0071531 0.00000031 36.24 3258.3 699 0.3 + 259308 0.0173281 0.00000024 14.96 1345.6 289 0.1 + 262144 0.0067476 0.00000032 38.85 3496.5 741 0.1 + 262440 0.0119904 0.00000033 21.89 1970.1 417 0.1 + 262500 0.0101626 0.00000032 25.83 2325.0 492 0.1 + 263424 0.0080000 0.00000033 32.93 2964.7 625 0.1 + 264600 0.0106610 0.00000031 24.82 2235.4 469 0.1 + 268800 0.0095602 0.00000031 28.12 2535.6 523 0.2 + 268912 0.0090909 0.00000035 29.58 2667.7 550 0.2 + 270000 0.0103734 0.00000031 26.03 2348.1 482 0.2 + 272160 0.0102041 0.00000031 26.67 2407.7 490 0.2 + 273375 0.0158228 0.00000023 17.28 1560.2 316 0.1 + 274400 0.0105263 0.00000031 26.07 2354.7 475 0.1 + 275562 0.0144509 0.00000036 19.07 1723.1 346 0.1 + 275625 0.0174216 0.00000022 15.82 1429.6 287 0.1 + 276480 0.0096712 0.00000030 28.59 2583.9 517 0.2 + 277830 0.0138337 0.00000031 20.08 1815.9 362 0.1 + 279936 0.0129067 0.00000035 21.69 1962.3 388 0.2 + 280000 0.0107066 0.00000031 26.15 2366.1 467 0.1 + 281250 0.0119332 0.00000034 23.57 2133.1 419 0.1 + 282240 0.0099404 0.00000032 28.39 2570.5 503 0.1 + 283500 0.0113636 0.00000031 24.95 2259.4 440 0.2 + 285768 0.0129067 0.00000034 22.14 2006.5 388 0.1 + 286720 0.0096154 0.00000031 29.82 2703.0 520 0.1 + 288000 0.0111607 0.00000031 25.80 2339.9 448 0.2 + 288120 0.0100806 0.00000034 28.58 2591.8 496 0.7 + 290304 0.0109580 0.00000033 26.49 2403.8 457 0.2 + 291600 0.0109890 0.00000031 26.54 2408.6 455 0.2 + 294000 0.0114073 0.00000030 25.77 2340.9 439 0.1 + 294912 0.0102459 0.00000032 28.78 2615.0 488 0.2 + 295245 0.0193352 0.00000028 15.27 1387.4 259 0.1 + 296352 0.0096899 0.00000032 30.58 2779.6 516 0.1 + 297675 0.0204401 0.00000024 14.56 1324.1 245 0.1 + 300000 0.0116370 0.00000032 25.78 2345.3 430 0.2 + 300125 0.0212195 0.00000022 14.14 1286.7 236 0.1 + 301056 0.0107527 0.00000032 28.00 2547.8 465 0.1 + 302400 0.0100604 0.00000030 30.06 2736.2 497 0.2 + 302526 0.0130208 0.00000036 23.23 2115.1 384 0.2 + 303750 0.0134258 0.00000032 22.62 2060.2 373 0.1 + 306180 0.0124069 0.00000032 24.68 2248.7 403 0.1 + 306250 0.0125195 0.00000032 24.46 2229.0 400 0.1 + 307200 0.0106383 0.00000031 28.88 2631.9 470 0.2 + 307328 0.0111359 0.00000031 27.60 2515.5 449 0.1 + 308700 0.0125824 0.00000032 24.53 2237.0 398 0.1 + 311040 0.0115207 0.00000033 27.00 2463.2 434 0.2 + 312500 0.0129199 0.00000036 24.19 2207.5 387 0.1 + 313600 0.0122440 0.00000032 25.61 2338.2 409 0.1 + 314928 0.0123345 0.00000036 25.53 2331.7 406 0.1 + 315000 0.0121255 0.00000031 25.98 2372.5 413 0.2 + 317520 0.0107296 0.00000032 29.59 2704.3 466 0.1 + 320000 0.0097809 0.00000032 32.72 2991.6 512 0.1 + 321489 0.0224916 0.00000030 14.29 1307.5 223 0.1 + 322560 0.0096154 0.00000031 33.55 3069.3 520 0.2 + 324000 0.0108225 0.00000030 29.94 2740.1 462 0.3 + 324135 0.0245481 0.00000023 13.20 1208.6 204 0.4 + 326592 0.0113122 0.00000033 28.87 2644.1 442 0.2 + 327680 0.0113814 0.00000031 28.79 2637.5 440 0.1 + 328050 0.0167224 0.00000034 19.62 1797.3 299 0.1 + 328125 0.0237337 0.00000025 13.83 1266.7 211 0.1 + 329280 0.0215517 0.00000024 15.28 1400.2 232 0.1 + 330750 0.0147493 0.00000032 22.42 2055.8 339 0.1 + 331776 0.0117925 0.00000032 28.13 2579.9 424 0.2 + 333396 0.0153846 0.00000034 21.67 1988.0 325 0.1 + 336000 0.0138122 0.00000032 24.33 2232.9 362 0.2 + 336140 0.0124883 0.00000035 26.92 2470.7 401 0.3 + 337500 0.0131785 0.00000032 25.61 2351.6 380 0.2 + 338688 0.0109649 0.00000034 30.89 2837.0 456 0.2 + 340200 0.0129870 0.00000031 26.20 2406.8 385 0.2 + 343000 0.0139106 0.00000032 24.66 2267.0 360 0.1 + 344064 0.0114943 0.00000032 29.93 2752.7 435 0.1 + 345600 0.0107234 0.00000031 32.23 2964.8 467 0.3 + 345744 0.0125824 0.00000033 27.48 2527.9 398 0.1 + 349920 0.0120962 0.00000032 28.93 2663.8 414 0.2 + 350000 0.0137363 0.00000033 25.48 2346.3 364 0.1 + 351232 0.0128405 0.00000033 27.35 2519.5 390 0.1 + 352800 0.0120962 0.00000031 29.17 2687.5 414 0.2 + 352947 0.0293311 0.00000024 12.03 1108.8 171 0.2 + 354294 0.0180787 0.00000037 19.60 1806.3 277 0.1 + 354375 0.0214009 0.00000022 16.56 1526.3 234 0.1 + 357210 0.0180418 0.00000033 19.80 1826.1 278 0.1 + 358400 0.0108225 0.00000031 33.12 3055.2 462 0.2 + 360000 0.0122440 0.00000031 29.40 2713.5 409 0.3 + 360150 0.0158978 0.00000032 22.65 2090.8 315 0.1 + 362880 0.0152905 0.00000033 23.73 2191.6 327 0.2 + 364500 0.0154562 0.00000032 23.58 2178.5 324 0.2 + 367416 0.0156007 0.00000036 23.55 2177.0 321 0.1 + 367500 0.0146857 0.00000032 25.02 2313.2 341 0.1 + 368640 0.0131234 0.00000031 28.09 2597.2 381 0.2 + 370440 0.0143903 0.00000032 25.74 2381.0 348 0.1 + 373248 0.0145154 0.00000034 25.71 2379.8 345 0.2 + 375000 0.0151752 0.00000034 24.71 2287.8 330 0.1 + 376320 0.0137200 0.00000032 27.43 2540.1 365 0.1 + 378000 0.0130548 0.00000031 28.95 2682.4 383 0.2 + 381024 0.0135713 0.00000033 28.08 2602.6 369 0.2 + 382725 0.0257212 0.00000024 14.88 1379.8 195 0.1 + 384000 0.0141464 0.00000031 27.14 2517.8 354 0.2 + 384160 0.0149935 0.00000034 25.62 2376.6 334 0.6 + 385875 0.0262189 0.00000022 14.72 1365.6 191 0.1 + 387072 0.0139883 0.00000032 27.67 2568.2 358 0.2 + 388800 0.0130073 0.00000030 29.89 2775.2 385 0.3 + 388962 0.0199033 0.00000032 19.54 1814.5 252 0.1 + 390625 0.0273651 0.00000030 14.27 1325.8 183 0.1 + 392000 0.0155763 0.00000031 25.17 2338.0 321 0.2 + 393216 0.0109890 0.00000032 35.78 3325.1 455 0.1 + 393660 0.0191870 0.00000034 20.52 1906.7 261 0.1 + 393750 0.0171821 0.00000033 22.92 2129.7 291 0.1 + 395136 0.0148600 0.00000034 26.59 2471.9 337 0.1 + 396900 0.0170068 0.00000033 23.34 2170.2 294 0.2 + 400000 0.0149935 0.00000033 26.68 2482.4 334 0.2 + 401408 0.0116279 0.00000033 34.52 3213.0 430 0.1 + 403200 0.0146427 0.00000031 27.54 2563.7 342 0.3 + 403368 0.0161023 0.00000036 25.05 2332.4 311 0.4 + 405000 0.0160256 0.00000031 25.27 2353.8 312 0.2 + 408240 0.0147723 0.00000033 27.64 2575.5 339 0.2 + 409600 0.0115473 0.00000031 35.47 3306.6 433 0.2 + 411600 0.0192909 0.00000031 21.34 1989.7 260 0.1 + 413343 0.0309124 0.00000032 13.37 1247.4 162 0.1 + 414720 0.0151057 0.00000031 27.45 2561.7 331 0.3 + 416745 0.0298317 0.00000025 13.97 1304.0 168 0.1 + 419904 0.0154207 0.00000034 27.23 2543.2 325 0.2 + 420000 0.0191287 0.00000031 21.96 2050.7 262 0.2 + 420175 0.0373717 0.00000022 11.24 1050.1 134 0.2 + 421875 0.0264186 0.00000024 15.97 1492.0 190 0.1 + 423360 0.0146313 0.00000031 28.94 2704.2 342 0.2 + 425250 0.0219470 0.00000032 19.38 1811.5 228 0.1 + 428652 0.0207631 0.00000035 20.64 1931.3 241 0.1 + 428750 0.0233827 0.00000028 18.34 1715.3 214 0.1 + 430080 0.0149275 0.00000032 28.81 2695.9 336 0.2 + 432000 0.0168613 0.00000032 25.62 2398.2 297 0.3 + 432180 0.0289017 0.00000023 14.95 1399.7 173 0.1 + 435456 0.0174825 0.00000035 24.91 2332.9 286 0.3 + 437400 0.0175576 0.00000032 24.91 2334.1 285 0.2 + 437500 0.0216450 0.00000032 20.21 1893.8 231 0.1 + 439040 0.0163399 0.00000032 26.87 2518.2 306 0.1 + 441000 0.0178571 0.00000031 24.70 2315.3 280 0.2 + 442368 0.0156862 0.00000031 28.20 2644.5 319 0.2 + 444528 0.0162444 0.00000034 27.36 2567.1 309 0.2 + 448000 0.0142267 0.00000032 31.49 2955.8 352 0.2 + 450000 0.0161416 0.00000033 27.88 2617.7 310 0.2 + 451584 0.0166502 0.00000033 27.12 2547.4 301 0.2 + 453600 0.0157356 0.00000031 28.83 2708.4 318 0.3 + 453789 0.0401562 0.00000026 11.30 1061.8 125 0.3 + 455625 0.0288703 0.00000024 15.78 1483.3 174 0.2 + 458752 0.0160256 0.00000033 28.63 2691.9 312 0.1 + 459270 0.0217901 0.00000034 21.08 1982.2 230 0.1 + 459375 0.0306307 0.00000024 15.00 1410.4 164 0.1 + 460800 0.0165532 0.00000031 27.84 2618.6 303 0.3 + 460992 0.0318471 0.00000025 14.48 1361.7 157 0.2 + 463050 0.0229537 0.00000031 20.17 1898.4 218 0.1 + 466560 0.0207631 0.00000034 22.47 2115.8 241 0.3 + 468750 0.0252920 0.00000034 18.53 1745.7 198 0.1 + 470400 0.0197158 0.00000033 23.86 2247.9 254 0.2 + 470596 0.0204879 0.00000036 22.97 2164.2 245 0.2 + 472392 0.0218852 0.00000037 21.58 2034.3 229 0.2 + 472500 0.0209859 0.00000030 22.52 2122.0 239 0.2 + 476280 0.0193950 0.00000033 24.56 2315.9 258 0.2 + 480000 0.0183579 0.00000033 26.15 2467.3 273 0.2 + 480200 0.0221585 0.00000030 21.67 2045.0 226 0.1 + 483840 0.0182528 0.00000032 26.51 2502.9 275 0.3 + 486000 0.0169447 0.00000031 28.68 2709.1 296 0.3 + 489888 0.0183150 0.00000035 26.75 2528.0 273 0.2 + 490000 0.0238281 0.00000032 20.56 1943.5 210 0.2 + 491520 0.0177721 0.00000031 27.66 2614.5 282 0.2 + 492075 0.0307467 0.00000026 16.00 1513.1 163 0.1 + 493920 0.0179491 0.00000032 27.52 2602.3 279 0.2 + 496125 0.0345905 0.00000023 14.34 1356.9 145 0.2 + 497664 0.0183866 0.00000033 27.07 2561.2 273 0.3 + 500000 0.0241546 0.00000035 20.70 1959.4 207 0.2 + 500094 0.0266373 0.00000035 18.77 1777.2 188 0.1 + 501760 0.0185874 0.00000032 26.99 2555.9 269 0.2 + 504000 0.0176955 0.00000031 28.48 2697.7 283 0.3 + 504210 0.0262189 0.00000036 19.23 1821.5 191 0.4 + 506250 0.0245672 0.00000031 20.61 1952.4 204 0.2 + 508032 0.0225929 0.00000035 22.49 2131.1 222 0.2 + 510300 0.0240169 0.00000032 21.25 2014.4 209 0.2 + 512000 0.0161542 0.00000031 31.69 3005.6 310 0.2 + 514500 0.0384615 0.00000023 13.38 1269.0 130 0.2 + 516096 0.0184646 0.00000032 27.95 2652.1 271 0.2 + 518400 0.0194253 0.00000032 26.69 2533.1 258 0.4 + 518616 0.0212526 0.00000034 24.40 2316.3 236 0.1 + 524288 0.0213597 0.00000032 24.55 2331.8 235 0.1 + 524880 0.0200781 0.00000034 26.14 2483.7 250 0.2 + 525000 0.0277754 0.00000034 18.90 1795.8 181 0.2 + 526848 0.0172683 0.00000033 30.51 2899.5 290 0.1 + 529200 0.0187970 0.00000031 28.15 2676.5 266 0.2 + 531441 0.0398996 0.00000033 13.32 1266.7 126 0.2 + 535815 0.0384916 0.00000026 13.92 1324.6 130 0.2 + 537600 0.0173551 0.00000031 30.98 2948.4 289 0.2 + 537824 0.0252723 0.00000037 21.28 2025.6 198 0.4 + 540000 0.0190989 0.00000031 28.27 2692.0 262 0.3 + 540225 0.0390019 0.00000023 13.85 1318.9 129 0.2 + 544320 0.0189416 0.00000031 28.74 2737.8 265 0.3 + 546750 0.0274291 0.00000031 19.93 1899.7 183 0.2 + 546875 0.0399616 0.00000029 13.69 1304.2 126 0.2 + 548800 0.0265790 0.00000031 20.65 1968.4 189 0.2 + 551124 0.0279548 0.00000037 19.71 1880.0 179 0.2 + 551250 0.0279984 0.00000030 19.69 1877.5 179 0.2 + 552960 0.0172683 0.00000031 32.02 3054.4 290 0.3 + 555660 0.0266581 0.00000033 20.84 1988.9 188 0.2 + 559872 0.0213098 0.00000036 26.27 2508.4 235 0.3 + 560000 0.0216788 0.00000033 25.83 2466.3 231 0.2 + 562500 0.0293768 0.00000033 19.15 1828.8 171 0.2 + 564480 0.0186309 0.00000033 30.30 2894.5 269 0.2 + 567000 0.0213675 0.00000032 26.54 2535.9 234 0.2 + 571536 0.0222569 0.00000035 25.68 2455.5 225 0.2 + 573440 0.0178850 0.00000032 32.06 3066.7 280 0.2 + 576000 0.0191870 0.00000032 30.02 2872.3 261 0.3 + 576240 0.0255899 0.00000035 22.52 2154.6 196 1.1 + 580608 0.0190114 0.00000034 30.54 2923.8 263 0.3 + 583200 0.0202429 0.00000031 28.81 2759.1 247 0.4 + 583443 0.0449916 0.00000028 12.97 1241.9 112 0.2 + 588000 0.0284535 0.00000031 20.67 1980.3 176 0.2 + 588245 0.0574713 0.00000023 10.24 980.9 87 0.3 + 589824 0.0178214 0.00000032 33.10 3172.3 281 0.2 + 590490 0.0329975 0.00000035 17.89 1715.4 152 0.2 + 590625 0.0409836 0.00000024 14.41 1381.5 122 0.2 + 592704 0.0274505 0.00000034 21.59 2070.3 183 0.2 + 595350 0.0309124 0.00000033 19.26 1847.3 162 0.2 + 600000 0.0289469 0.00000033 20.73 1989.3 173 0.2 + 600250 0.0336095 0.00000035 17.86 1714.1 149 0.3 + 602112 0.0196691 0.00000033 30.61 2938.7 255 0.2 + 604800 0.0226244 0.00000033 26.73 2567.1 221 0.4 + 605052 0.0295858 0.00000037 20.45 1964.0 169 0.5 + 607500 0.0293768 0.00000032 20.68 1986.5 171 0.2 + 612360 0.0291152 0.00000033 21.03 2021.6 172 0.2 + 612500 0.0304451 0.00000031 20.12 1933.8 165 0.2 + 614400 0.0186859 0.00000031 32.88 3161.3 268 0.3 + 614656 0.0220264 0.00000034 27.91 2683.0 227 0.2 + 617400 0.0339421 0.00000033 18.19 1749.5 148 0.2 + 622080 0.0213098 0.00000033 29.19 2809.3 235 0.4 + 625000 0.0341199 0.00000036 18.32 1763.4 147 0.2 + 627200 0.0211300 0.00000032 29.68 2858.3 237 0.2 + 629856 0.0315939 0.00000036 19.94 1920.3 159 0.2 + 630000 0.0307228 0.00000032 20.51 1975.2 163 0.3 + 635040 0.0284979 0.00000033 22.28 2147.8 176 0.2 + 637875 0.0453266 0.00000024 14.07 1356.8 111 0.2 + 640000 0.0217731 0.00000033 29.39 2834.7 230 0.2 + 642978 0.0378289 0.00000037 17.00 1639.7 133 0.2 + 643125 0.0468020 0.00000023 13.74 1325.7 107 0.2 + 645120 0.0209205 0.00000032 30.84 2975.6 239 0.3 + 648000 0.0270077 0.00000032 23.99 2316.0 186 0.4 + 648270 0.0388808 0.00000037 16.67 1609.5 129 0.8 + 653184 0.0281777 0.00000037 23.18 2238.9 178 0.3 + 655360 0.0204918 0.00000032 31.98 3089.7 244 0.2 + 656100 0.0315939 0.00000033 20.77 2006.4 159 0.2 + 656250 0.0360836 0.00000033 18.19 1757.2 139 0.2 + 658560 0.0255899 0.00000034 25.74 2487.2 196 0.2 + 661500 0.0315448 0.00000031 20.97 2027.3 159 0.2 + 663552 0.0212195 0.00000032 31.27 3023.9 236 0.4 + 666792 0.0323589 0.00000034 20.61 1993.3 155 0.2 + 672000 0.0225225 0.00000033 29.84 2887.9 222 0.3 + 672280 0.0332161 0.00000036 20.24 1959.1 151 0.5 + 675000 0.0346444 0.00000033 19.48 1886.5 145 0.2 + 677376 0.0244284 0.00000034 27.73 2685.5 205 0.3 + 680400 0.0357143 0.00000033 19.05 1845.7 140 0.3 + 686000 0.0298084 0.00000032 23.01 2230.9 168 0.2 + 688128 0.0216191 0.00000033 31.83 3086.3 232 0.2 + 688905 0.0501563 0.00000028 13.74 1331.9 100 0.2 + 691200 0.0231843 0.00000032 29.81 2891.7 216 0.5 + 691488 0.0319467 0.00000032 21.65 2099.5 157 0.2 + 694575 0.0544327 0.00000024 12.76 1238.1 92 0.2 + 699840 0.0338894 0.00000033 20.65 2004.8 148 0.4 + 700000 0.0307707 0.00000034 22.75 2208.6 163 0.2 + 702464 0.0231843 0.00000034 30.30 2942.4 216 0.2 + 703125 0.0520296 0.00000026 13.51 1312.4 97 0.2 + 705600 0.0331126 0.00000032 21.31 2070.0 151 0.3 + 705894 0.0453266 0.00000037 15.57 1512.9 111 0.3 + 708588 0.0379380 0.00000038 18.68 1815.0 132 0.2 + 708750 0.0356272 0.00000031 19.89 1933.1 141 0.2 + 714420 0.0351289 0.00000034 20.34 1977.4 143 0.2 + 716800 0.0239608 0.00000032 29.92 2909.5 209 0.2 + 720000 0.0277106 0.00000034 25.98 2527.8 181 0.4 + 720300 0.0577407 0.00000023 12.47 1213.7 87 0.2 + 725760 0.0255102 0.00000034 28.45 2769.5 196 0.4 + 729000 0.0354610 0.00000031 20.56 2001.9 141 0.3 + 734832 0.0368222 0.00000035 19.96 1944.4 136 0.3 + 735000 0.0396161 0.00000033 18.55 1807.8 127 0.2 + 737280 0.0229358 0.00000032 32.15 3132.9 218 0.4 + 740880 0.0538474 0.00000024 13.76 1341.4 93 0.2 + 746496 0.0266789 0.00000035 27.98 2729.5 188 0.4 + 750000 0.0378788 0.00000035 19.80 1932.1 132 0.2 + 750141 0.0622106 0.00000029 12.06 1176.7 81 0.2 + 752640 0.0260417 0.00000033 28.90 2821.0 192 0.2 + 756000 0.0393066 0.00000033 19.23 1878.0 128 0.3 + 756315 0.0744485 0.00000023 10.16 991.9 68 0.5 + 759375 0.0493643 0.00000023 15.38 1502.5 102 0.2 + 762048 0.0364963 0.00000035 20.88 2039.9 137 0.3 + 765450 0.0408410 0.00000033 18.74 1831.7 123 0.2 + 765625 0.0563553 0.00000026 13.59 1327.7 89 0.2 + 768000 0.0258940 0.00000032 29.66 2899.3 194 0.3 + 768320 0.0587754 0.00000025 13.07 1277.9 86 0.2 + 771750 0.0453266 0.00000030 17.03 1665.0 111 0.2 + 774144 0.0254600 0.00000033 30.41 2974.1 197 0.4 + 777600 0.0308186 0.00000034 25.23 2468.7 163 0.5 + 777924 0.0400000 0.00000035 19.45 1902.9 125 0.2 + 781250 0.0438596 0.00000035 17.81 1743.4 114 0.2 + 784000 0.0314957 0.00000033 24.89 2437.0 159 0.2 + 786432 0.0300337 0.00000033 26.18 2564.2 167 0.2 + 787320 0.0403226 0.00000034 19.53 1912.2 124 0.3 + 787500 0.0436821 0.00000032 18.03 1765.6 115 0.3 + 790272 0.0283810 0.00000035 27.85 2727.7 177 0.2 + 793800 0.0398065 0.00000032 19.94 1954.1 126 0.3 + 800000 0.0292060 0.00000035 27.39 2685.7 172 0.2 + 802816 0.0270693 0.00000034 29.66 2908.7 185 0.2 + 806400 0.0275155 0.00000032 29.31 2875.2 182 0.4 + 806736 0.0413869 0.00000036 19.49 1912.4 121 0.7 + 810000 0.0407139 0.00000032 19.89 1952.4 123 0.3 + 816480 0.0389414 0.00000034 20.97 2058.9 129 0.3 + 819200 0.0272164 0.00000032 30.10 2956.4 184 0.3 + 820125 0.0546026 0.00000024 15.02 1475.4 92 0.3 + 823200 0.0415806 0.00000032 19.80 1945.2 121 0.2 + 823543 0.0892857 0.00000024 9.22 906.3 56 0.3 + 826686 0.0486195 0.00000038 17.00 1671.2 103 0.2 + 826875 0.0644030 0.00000024 12.84 1261.9 78 0.3 + 829440 0.0276709 0.00000032 29.98 2946.8 181 0.4 + 833490 0.0473868 0.00000034 17.59 1729.8 106 0.2 + 839808 0.0391172 0.00000037 21.47 2112.5 128 0.3 + 840000 0.0424364 0.00000032 19.79 1947.8 118 0.3 + 840350 0.0500900 0.00000035 16.78 1650.9 100 0.4 + 843750 0.0458045 0.00000034 18.42 1813.2 110 0.2 + 846720 0.0341940 0.00000034 24.76 2438.0 147 0.3 + 850500 0.0430086 0.00000032 19.78 1947.6 117 0.3 + 857304 0.0444602 0.00000036 19.28 1900.2 113 0.3 + 857500 0.0456000 0.00000030 18.80 1853.2 110 0.2 + 860160 0.0290752 0.00000032 29.58 2916.1 173 0.3 + 864000 0.0300330 0.00000032 28.77 2836.7 167 0.4 + 864360 0.0412459 0.00000036 20.96 2066.4 122 1.3 + 870912 0.0327255 0.00000036 26.61 2625.6 153 0.4 + 874800 0.0491714 0.00000034 17.79 1755.8 102 0.4 + 875000 0.0500444 0.00000035 17.48 1725.6 101 0.2 + 878080 0.0314497 0.00000033 27.92 2756.3 159 0.2 + 882000 0.0452523 0.00000032 19.49 1924.8 111 0.3 + 884736 0.0292205 0.00000032 30.28 2990.7 172 0.3 + 885735 0.0672935 0.00000029 13.16 1300.2 75 0.3 + 889056 0.0489224 0.00000035 18.17 1795.6 103 0.3 + 893025 0.0674002 0.00000025 13.25 1309.6 75 0.3 + 896000 0.0315064 0.00000033 28.44 2811.6 159 0.3 + 900000 0.0460826 0.00000034 19.53 1931.5 109 0.4 + 900375 0.0914726 0.00000023 9.84 973.5 55 0.5 + 903168 0.0306766 0.00000033 29.44 2912.5 164 0.3 + 907200 0.0446429 0.00000032 20.32 2010.9 112 0.5 + 907578 0.0609877 0.00000039 14.88 1472.6 83 0.5 + 911250 0.0501500 0.00000033 18.17 1798.7 100 0.3 + 917504 0.0288708 0.00000034 31.78 3147.4 174 0.3 + 918540 0.0487868 0.00000035 18.83 1864.8 103 0.3 + 918750 0.0512549 0.00000032 17.93 1775.4 98 0.2 + 921600 0.0307272 0.00000032 29.99 2971.4 163 0.5 + 921984 0.0382753 0.00000035 24.09 2386.5 131 0.2 + 926100 0.0465280 0.00000032 19.90 1972.6 108 0.3 + 933120 0.0357253 0.00000035 26.12 2590.0 140 0.5 + 937500 0.0476904 0.00000034 19.66 1949.9 105 0.3 + 940800 0.0330953 0.00000033 28.43 2820.5 152 0.3 + 941192 0.0480544 0.00000037 19.59 1943.3 105 0.4 + 944784 0.0509693 0.00000036 18.54 1839.7 99 0.3 + 945000 0.0526370 0.00000033 17.95 1781.8 95 0.4 + 952560 0.0429445 0.00000033 22.18 2202.8 117 0.3 + 960000 0.0322533 0.00000033 29.76 2957.5 156 0.4 + 960400 0.0463657 0.00000033 20.71 2058.2 108 0.3 + 964467 0.0705210 0.00000031 13.68 1359.4 71 0.3 + 967680 0.0327388 0.00000033 29.56 2938.6 153 0.4 + 972000 0.0442629 0.00000032 21.96 2184.0 114 0.5 + 972405 0.0756713 0.00000026 12.85 1278.0 67 0.3 + 979776 0.0452567 0.00000036 21.65 2154.3 111 0.4 + 980000 0.0452664 0.00000033 21.65 2154.4 111 0.3 + 983040 0.0324984 0.00000033 30.25 3010.8 154 0.3 + 984150 0.0556390 0.00000034 17.69 1760.7 90 0.3 + 984375 0.0738754 0.00000025 13.32 1326.4 68 0.3 + 987840 0.0429187 0.00000033 23.02 2291.7 117 0.3 + 992250 0.0567078 0.00000032 17.50 1742.8 89 0.3 + 995328 0.0354978 0.00000034 28.04 2793.4 141 0.5 + 1000000 0.0483748 0.00000035 20.67 2060.1 104 0.3 + 1000188 0.0535947 0.00000036 18.66 1859.8 94 0.3 + 1003520 0.0349308 0.00000033 28.73 2863.8 144 0.3 + 1008000 0.0402524 0.00000034 25.04 2497.1 125 0.5 + 1008420 0.0520833 0.00000037 19.36 1930.7 96 0.8 + 1012500 0.0549508 0.00000034 18.43 1837.9 91 0.4 + 1016064 0.0389466 0.00000036 26.09 2602.9 129 0.4 + 1020600 0.0529580 0.00000032 19.27 1923.4 95 0.5 + 1024000 0.0348110 0.00000032 29.42 2936.6 144 0.3 + 1029000 0.0584004 0.00000033 17.62 1759.6 86 0.3 + 1032192 0.0361868 0.00000033 28.52 2849.2 139 0.4 + 1036800 0.0360867 0.00000032 28.73 2870.7 139 0.7 + 1037232 0.0837087 0.00000026 12.39 1238.1 60 0.3 + 1048576 0.0403831 0.00000034 25.97 2596.6 124 0.3 + 1049760 0.0540099 0.00000035 19.44 1943.8 93 0.5 + 1050000 0.0552033 0.00000034 19.02 1902.2 91 0.3 + 1053696 0.0498854 0.00000033 21.12 2113.0 101 0.3 + 1058400 0.0588239 0.00000033 17.99 1800.5 85 0.4 + 1058841 0.1140130 0.00000026 9.29 929.4 44 0.5 + 1062882 0.0642051 0.00000039 16.55 1657.1 78 0.3 + 1063125 0.0825971 0.00000023 12.87 1288.4 61 0.4 + 1071630 0.0653369 0.00000035 16.40 1642.7 77 0.4 + 1071875 0.0827552 0.00000024 12.95 1297.3 61 0.3 + 1075200 0.0503101 0.00000032 21.37 2141.0 100 0.4 + 1075648 0.0565275 0.00000038 19.03 1906.4 89 0.7 + 1080000 0.0554729 0.00000033 19.47 1951.0 91 0.5 + 1080450 0.0602454 0.00000031 17.93 1797.3 83 0.3 + 1088640 0.0552911 0.00000033 19.69 1974.2 91 0.4 + 1093500 0.0503897 0.00000032 21.70 2176.7 100 0.4 + 1093750 0.0703057 0.00000034 15.56 1560.4 72 0.3 + 1097600 0.0512493 0.00000033 21.42 2148.7 98 0.3 + 1102248 0.0552086 0.00000037 19.97 2003.7 91 0.3 + 1102500 0.0634804 0.00000032 17.37 1743.0 79 0.4 + 1105920 0.0513421 0.00000031 21.54 2162.3 98 0.4 + 1111320 0.0524057 0.00000034 21.21 2129.5 96 0.3 + 1119744 0.0566122 0.00000035 19.78 1987.3 89 0.5 + 1120000 0.0600164 0.00000033 18.66 1875.0 84 0.4 + 1125000 0.0641984 0.00000035 17.52 1761.3 78 0.4 + 1128960 0.0509092 0.00000033 22.18 2229.4 99 0.3 + 1134000 0.0615607 0.00000033 18.42 1852.5 82 0.5 + 1143072 0.0649038 0.00000036 17.61 1772.1 78 0.4 + 1146880 0.0445222 0.00000032 25.76 2592.6 113 0.3 + 1148175 0.0867499 0.00000027 13.24 1332.2 58 0.4 + 1152000 0.0554669 0.00000033 20.77 2091.0 91 0.5 + 1152480 0.0581566 0.00000037 19.82 1995.2 86 1.7 + 1157625 0.0952079 0.00000024 12.16 1224.6 53 0.4 + 1161216 0.0575632 0.00000034 20.17 2032.1 87 0.4 + 1166400 0.0529734 0.00000033 22.02 2218.8 95 0.6 + 1166886 0.0695623 0.00000036 16.77 1690.4 72 0.3 + 1171875 0.0871466 0.00000029 13.45 1355.5 58 0.4 + 1176000 0.0631813 0.00000032 18.61 1876.7 80 0.4 + 1176490 0.0736470 0.00000036 15.97 1610.7 68 0.5 + 1179648 0.0453288 0.00000032 26.02 2624.5 111 0.4 + 1180980 0.0671932 0.00000036 17.58 1772.7 75 0.4 + 1181250 0.0656429 0.00000033 18.00 1815.0 77 0.4 + 1185408 0.0531967 0.00000034 22.28 2248.1 94 0.3 + 1190700 0.0648076 0.00000033 18.37 1854.1 78 0.4 + 1200000 0.0645063 0.00000033 18.60 1878.4 78 0.4 + 1200500 0.1039491 0.00000024 11.55 1166.2 49 0.4 + 1204224 0.0486847 0.00000032 24.74 2498.2 103 0.3 + 1209600 0.0538284 0.00000032 22.47 2270.3 93 0.6 + 1210104 0.0651364 0.00000038 18.58 1877.0 77 0.9 + 1215000 0.0711971 0.00000033 17.07 1724.7 71 0.5 + 1224720 0.0660858 0.00000034 18.53 1874.0 76 0.5 + 1225000 0.0698683 0.00000034 17.53 1773.0 72 0.3 + 1228800 0.0590117 0.00000032 20.82 2106.1 85 0.4 + 1229312 0.0658088 0.00000032 18.68 1889.4 76 0.3 + 1234800 0.0687122 0.00000033 17.97 1818.3 73 0.4 + 1240029 0.0955281 0.00000033 12.98 1313.8 53 0.4 + 1244160 0.0615487 0.00000033 20.21 2046.4 82 0.6 + 1250000 0.0706546 0.00000038 17.69 1791.6 71 0.4 + 1250235 0.1051356 0.00000026 11.89 1204.3 48 0.4 + 1254400 0.0525881 0.00000033 23.85 2416.2 96 0.4 + 1259712 0.0667603 0.00000037 18.87 1911.9 75 0.5 + 1260000 0.0672998 0.00000032 18.72 1897.0 75 0.5 + 1260525 0.1389193 0.00000023 9.07 919.4 37 0.7 + 1265625 0.0944721 0.00000025 13.40 1357.9 53 0.4 + 1270080 0.0607050 0.00000034 20.92 2121.1 83 0.4 + 1275750 0.0753283 0.00000033 16.94 1717.5 67 0.4 + 1280000 0.0535324 0.00000034 23.91 2425.5 94 0.4 + 1285956 0.0729184 0.00000038 17.64 1789.5 69 0.4 + 1286250 0.0742152 0.00000031 17.33 1758.7 68 0.4 + 1290240 0.0518711 0.00000032 24.87 2524.6 97 0.5 + 1296000 0.0624005 0.00000032 20.77 2108.6 81 0.6 + 1296540 0.0698963 0.00000037 18.55 1883.4 72 1.5 + 1306368 0.0638799 0.00000035 20.45 2077.5 79 0.5 + 1310720 0.0511039 0.00000032 25.65 2606.1 98 0.4 + 1312200 0.0630798 0.00000033 20.80 2113.9 80 0.5 + 1312500 0.0685642 0.00000033 19.14 1945.3 73 0.4 + 1317120 0.0982056 0.00000026 13.41 1363.2 51 0.4 + 1323000 0.0797875 0.00000034 16.58 1686.0 63 0.4 + 1327104 0.0658363 0.00000032 20.16 2050.0 77 0.5 + 1333584 0.0783997 0.00000035 17.01 1730.5 64 0.4 + 1344000 0.0723214 0.00000034 18.58 1891.6 70 0.5 + 1344560 0.0717564 0.00000036 18.74 1907.4 70 0.8 + 1350000 0.0733634 0.00000034 18.40 1873.7 69 0.5 + 1354752 0.0691286 0.00000034 19.60 1996.0 73 0.4 + 1360800 0.0764530 0.00000033 17.80 1813.4 66 0.6 + 1361367 0.1546261 0.00000027 8.80 897.0 33 0.7 + 1366875 0.1105771 0.00000024 12.36 1259.8 46 0.4 + 1372000 0.0776367 0.00000033 17.67 1801.5 65 0.4 + 1376256 0.0557217 0.00000033 24.70 2518.3 90 0.4 + 1377810 0.0895636 0.00000035 15.38 1568.7 56 0.4 + 1378125 0.1041896 0.00000024 13.23 1348.8 48 0.4 + 1382400 0.0625000 0.00000032 22.12 2255.9 80 0.6 + 1382976 0.0697784 0.00000035 19.82 2021.5 72 0.4 + 1389150 0.0919201 0.00000033 15.11 1541.9 55 0.4 + 1399680 0.0684979 0.00000034 20.43 2086.0 74 0.5 + 1400000 0.0765751 0.00000034 18.28 1866.4 66 0.5 + 1404928 0.0702150 0.00000034 20.01 2043.1 72 0.4 + 1406250 0.0804744 0.00000034 17.47 1784.4 63 0.4 + 1411200 0.0705274 0.00000033 20.01 2043.8 71 0.5 + 1411788 0.0749712 0.00000038 18.83 1923.5 67 0.6 + 1417176 0.0867583 0.00000037 16.33 1669.0 58 0.4 + 1417500 0.0858134 0.00000031 16.52 1687.8 59 0.5 + 1428840 0.0801256 0.00000034 17.83 1823.1 63 0.4 + 1433600 0.0616396 0.00000032 23.26 2378.3 82 0.4 + 1440000 0.0719788 0.00000033 20.01 2046.4 70 0.6 + 1440600 0.0901293 0.00000033 15.98 1635.0 56 0.4 + 1451520 0.0855609 0.00000034 16.96 1736.3 59 0.6 + 1458000 0.0854068 0.00000033 17.07 1747.7 59 0.6 + 1469664 0.0877289 0.00000037 16.75 1716.0 57 0.5 + 1470000 0.0819062 0.00000033 17.95 1838.5 62 0.5 + 1474560 0.0781250 0.00000032 18.87 1933.9 64 0.5 + 1476225 0.1186538 0.00000028 12.44 1274.8 43 0.5 + 1481760 0.0859313 0.00000034 17.24 1767.4 59 0.4 + 1488375 0.1182790 0.00000024 12.58 1290.2 43 0.5 + 1492992 0.0691453 0.00000035 21.59 2214.2 73 0.6 + 1500000 0.0835958 0.00000035 17.94 1840.7 60 0.5 + 1500282 0.0961621 0.00000036 15.60 1600.5 52 0.4 + 1500625 0.1213190 0.00000024 12.37 1268.9 42 0.5 + 1505280 0.0776461 0.00000033 19.39 1989.2 65 0.4 + 1512000 0.0769400 0.00000033 19.65 2017.1 65 0.6 + 1512630 0.1301457 0.00000038 11.62 1193.0 39 1.0 + 1518750 0.0959588 0.00000032 15.83 1625.0 53 0.5 + 1524096 0.0771597 0.00000035 19.75 2028.5 65 0.5 + 1530900 0.0985107 0.00000034 15.54 1596.5 51 0.5 + 1531250 0.1004468 0.00000032 15.24 1566.1 50 0.5 + 1536000 0.0671875 0.00000033 22.86 2349.1 75 0.5 + 1536640 0.0826096 0.00000037 18.60 1911.4 61 1.5 + 1543500 0.0979990 0.00000032 15.75 1618.9 52 0.5 + 1548288 0.0862237 0.00000033 17.96 1846.1 58 0.5 + 1555200 0.0773982 0.00000032 20.09 2066.5 65 0.7 + 1555848 0.0910645 0.00000033 17.09 1757.1 55 0.4 + 1562500 0.0876696 0.00000037 17.82 1833.5 58 0.4 + 1568000 0.0890685 0.00000032 17.60 1811.5 57 0.5 + 1572864 0.0659935 0.00000032 23.83 2453.1 76 0.4 + 1574640 0.0878585 0.00000034 17.92 1844.8 57 0.5 + 1575000 0.0964402 0.00000035 16.33 1681.1 52 0.5 + 1580544 0.0924627 0.00000035 17.09 1760.0 55 0.5 + 1587600 0.0945008 0.00000034 16.80 1730.3 53 0.5 + 1594323 0.1589394 0.00000035 10.03 1033.4 32 0.6 + 1600000 0.0939015 0.00000035 17.04 1755.9 54 0.5 + 1605632 0.0827257 0.00000033 19.41 2000.6 61 0.5 + 1607445 0.1336477 0.00000028 12.03 1239.8 38 0.5 + 1612800 0.0855403 0.00000033 18.85 1944.0 59 0.7 + 1613472 0.0894383 0.00000037 18.04 1860.1 56 1.1 + 1620000 0.0919079 0.00000034 17.63 1817.9 55 0.7 + 1620675 0.1382958 0.00000025 11.72 1208.7 37 0.5 + 1632960 0.0878628 0.00000035 18.59 1917.9 57 0.6 + 1638400 0.0864658 0.00000032 18.95 1955.9 58 0.5 + 1640250 0.1143494 0.00000033 14.34 1480.7 44 0.5 + 1640625 0.1281128 0.00000028 12.81 1322.0 40 0.5 + 1646400 0.0862237 0.00000032 19.09 1971.6 58 0.5 + 1647086 0.1131972 0.00000037 14.55 1502.5 45 0.6 + 1653372 0.1061350 0.00000038 15.58 1609.0 48 0.5 + 1653750 0.1093803 0.00000033 15.12 1561.6 46 0.5 + 1658880 0.0718558 0.00000032 23.09 2385.0 70 0.7 + 1666980 0.1322246 0.00000026 12.61 1302.9 38 0.5 + 1679616 0.0931758 0.00000036 18.03 1863.9 54 0.6 + 1680000 0.0867246 0.00000032 19.37 2003.0 58 0.6 + 1680700 0.0914617 0.00000037 18.38 1900.1 55 0.8 + 1687500 0.1088549 0.00000034 15.50 1603.4 46 0.5 + 1693440 0.0890728 0.00000033 19.01 1966.9 57 0.5 + 1701000 0.1063934 0.00000032 15.99 1654.6 47 0.5 + 1714608 0.0963088 0.00000036 17.80 1843.5 52 0.5 + 1715000 0.0969215 0.00000031 17.69 1832.3 52 0.5 + 1720320 0.0761201 0.00000033 22.60 2340.7 66 0.5 + 1728000 0.0842468 0.00000033 20.51 2125.0 60 0.8 + 1728720 0.1441860 0.00000025 11.99 1242.2 35 0.6 + 1741824 0.0863521 0.00000036 20.17 2091.0 58 0.7 + 1749600 0.1041819 0.00000034 16.79 1741.4 48 0.7 + 1750000 0.0974990 0.00000034 17.95 1861.2 52 0.5 + 1750329 0.1576843 0.00000030 11.10 1151.0 32 0.6 + 1756160 0.0830078 0.00000033 21.16 2194.4 61 0.5 + 1764000 0.1080530 0.00000033 16.33 1693.8 47 0.6 + 1764735 0.1968431 0.00000024 8.97 930.2 26 0.9 + 1769472 0.0964520 0.00000032 18.35 1903.8 52 0.6 + 1771470 0.1374611 0.00000035 12.89 1337.5 37 0.6 + 1771875 0.1534128 0.00000024 11.55 1198.7 33 0.6 + 1778112 0.0967689 0.00000036 18.37 1907.5 52 0.5 + 1786050 0.1154092 0.00000034 15.48 1607.0 44 0.5 + 1792000 0.0860637 0.00000034 20.82 2162.7 59 0.6 + 1800000 0.0994993 0.00000035 18.09 1879.6 51 0.7 + 1800750 0.1328189 0.00000038 13.56 1408.7 38 1.0 + 1806336 0.0868762 0.00000033 20.79 2160.8 58 0.6 + 1814400 0.0986544 0.00000033 18.39 1911.9 51 0.8 + 1815156 0.1054713 0.00000039 17.21 1789.1 48 1.0 + 1822500 0.1170001 0.00000032 15.58 1619.8 43 0.6 + 1835008 0.1006201 0.00000033 18.24 1897.3 50 0.5 + 1837080 0.1252014 0.00000035 14.67 1526.7 40 0.6 + 1837500 0.1203497 0.00000032 15.27 1588.6 42 0.5 + 1843200 0.1044769 0.00000032 17.64 1836.0 48 0.8 + 1843968 0.1413439 0.00000027 13.05 1357.7 36 0.6 + 1852200 0.1049132 0.00000032 17.65 1837.9 49 0.5 + 1866240 0.1236185 0.00000035 15.10 1572.5 41 0.8 + 1875000 0.1073803 0.00000035 17.46 1819.3 47 0.5 + 1881600 0.1161360 0.00000034 16.20 1688.5 44 0.6 + 1882384 0.1016797 0.00000038 18.51 1929.4 50 0.7 + 1889568 0.1314416 0.00000038 14.38 1498.6 39 0.6 + 1890000 0.1058070 0.00000032 17.86 1862.2 48 0.6 + 1905120 0.1190883 0.00000035 16.00 1668.7 42 0.6 + 1913625 0.1572495 0.00000025 12.17 1269.7 32 0.6 + 1920000 0.1125000 0.00000034 17.07 1781.1 45 0.7 + 1920800 0.1164551 0.00000031 16.49 1721.4 43 0.6 + 1928934 0.1398926 0.00000037 13.79 1439.5 36 0.6 + 1929375 0.1604233 0.00000024 12.03 1255.6 32 0.6 + 1935360 0.0949799 0.00000033 20.38 2127.7 53 0.7 + 1944000 0.1061147 0.00000033 18.32 1913.6 48 0.8 + 1944810 0.1417236 0.00000039 13.72 1433.4 36 1.4 + 1953125 0.1660826 0.00000033 11.76 1228.8 31 0.6 + 1959552 0.1171989 0.00000037 16.72 1747.4 43 0.7 + 1960000 0.1107390 0.00000033 17.70 1849.8 46 0.6 + 1966080 0.1124919 0.00000032 17.48 1827.0 45 0.6 + 1968300 0.1189675 0.00000035 16.54 1729.6 43 0.6 + 1968750 0.1186353 0.00000033 16.59 1734.9 43 0.6 + 1975680 0.1152510 0.00000034 17.14 1792.6 44 0.6 + 1984500 0.1143632 0.00000032 17.35 1815.1 44 0.6 + 1990656 0.1181130 0.00000034 16.85 1763.3 43 0.7 + 2000000 0.1285995 0.00000036 15.55 1627.7 39 0.6 + 2000376 0.1404487 0.00000036 14.24 1490.6 36 0.6 + 2007040 0.1196115 0.00000033 16.78 1756.5 42 0.6 + 2016000 0.1148654 0.00000033 17.55 1837.9 44 0.8 + 2016840 0.1112766 0.00000037 18.12 1898.0 45 1.4 + 2025000 0.1195650 0.00000033 16.94 1774.0 42 0.6 + 2032128 0.1337377 0.00000036 15.19 1592.0 38 0.7 + 2041200 0.1338629 0.00000032 15.25 1598.1 38 0.7 + 2048000 0.1070635 0.00000033 19.13 2005.3 47 0.6 + 2058000 0.2154999 0.00000025 9.55 1001.4 24 0.8 + 2064384 0.1214774 0.00000032 16.99 1782.4 42 0.7 + 2066715 0.1999089 0.00000030 10.34 1084.4 26 0.7 + 2073600 0.1092397 0.00000033 18.98 1991.6 46 1.0 + 2074464 0.1368276 0.00000036 15.16 1590.7 37 0.6 + 2083725 0.1851852 0.00000026 11.25 1181.0 27 0.7 + 2097152 0.1031619 0.00000033 20.33 2134.5 49 0.5 + 2099520 0.1297858 0.00000036 16.18 1698.7 39 0.7 + 2100000 0.1310096 0.00000035 16.03 1683.2 39 0.7 + 2100875 0.2577776 0.00000023 8.15 855.8 21 0.9 + 2107392 0.1137945 0.00000034 18.52 1945.2 44 0.6 + 2109375 0.1633064 0.00000026 12.92 1356.8 31 0.7 + 2116800 0.1263733 0.00000033 16.75 1759.9 40 0.8 + 2117682 0.1574860 0.00000039 13.45 1412.9 32 0.9 + 2125764 0.1524695 0.00000039 13.94 1465.3 33 0.7 + 2126250 0.1292005 0.00000033 16.46 1729.6 39 0.6 + 2143260 0.1650706 0.00000034 12.98 1365.3 31 0.7 + 2143750 0.1572189 0.00000032 13.64 1433.9 32 0.6 + 2150400 0.1188624 0.00000033 18.09 1902.9 43 0.8 + 2151296 0.1196434 0.00000038 17.98 1891.3 42 1.2 + 2160000 0.1301739 0.00000033 16.59 1745.8 39 1.0 + 2160900 0.1376656 0.00000033 15.70 1651.5 37 0.7 + 2177280 0.1279480 0.00000033 17.02 1791.4 40 0.8 + 2187000 0.1457275 0.00000032 15.01 1580.3 35 0.7 + 2187500 0.1363888 0.00000036 16.04 1688.9 37 0.6 + 2195200 0.1309752 0.00000032 16.76 1765.4 39 0.6 + 2204496 0.1376788 0.00000038 16.01 1687.0 37 0.7 + 2205000 0.1355475 0.00000033 16.27 1714.0 37 0.7 + 2211840 0.1238508 0.00000032 17.86 1882.0 41 0.8 + 2222640 0.1330085 0.00000034 16.71 1761.6 38 0.6 + 2239488 0.1412625 0.00000037 15.85 1672.1 36 0.8 + 2240000 0.1453299 0.00000034 15.41 1625.7 35 0.7 + 2250000 0.1405029 0.00000034 16.01 1689.6 36 0.7 + 2250423 0.2164612 0.00000031 10.40 1096.9 24 0.8 + 2257920 0.1223412 0.00000034 18.46 1947.7 41 0.7 + 2268000 0.1482328 0.00000034 15.30 1615.2 34 0.8 + 2268945 0.2566284 0.00000025 8.84 933.4 20 1.2 + 2278125 0.1924190 0.00000024 11.84 1250.2 27 0.8 + 2286144 0.1457589 0.00000037 15.68 1656.6 35 0.8 + 2293760 0.1214629 0.00000033 18.88 1995.1 42 0.7 + 2296350 0.1653383 0.00000035 13.89 1467.4 31 0.7 + 2296875 0.2280162 0.00000026 10.07 1064.3 22 0.8 + 2304000 0.1283835 0.00000034 17.95 1896.5 39 0.9 + 2304960 0.1232791 0.00000038 18.70 1975.9 41 2.6 + 2315250 0.1548480 0.00000033 14.95 1580.6 33 0.7 + 2322432 0.1376557 0.00000035 16.87 1783.9 37 0.8 + 2332800 0.1397739 0.00000033 16.69 1765.3 36 1.0 + 2333772 0.2109375 0.00000028 11.06 1170.2 24 0.8 + 2343750 0.1767241 0.00000037 13.26 1403.2 29 0.7 + 2352000 0.1616132 0.00000032 14.55 1540.1 31 0.8 + 2352980 0.1308312 0.00000038 17.98 1903.3 39 0.9 + 2359296 0.1292005 0.00000033 18.26 1932.9 39 0.8 + 2361960 0.1614400 0.00000035 14.63 1548.8 31 1.3 + 2362500 0.1412557 0.00000033 16.72 1770.5 36 0.7 + 2370816 0.1527137 0.00000036 15.52 1643.8 33 0.7 + 2381400 0.1459856 0.00000033 16.31 1727.8 35 0.7 + 2400000 0.1455183 0.00000034 16.49 1747.8 35 0.8 + 2401000 0.1353397 0.00000037 17.74 1880.1 37 1.2 + 2408448 0.1410522 0.00000034 17.07 1809.9 36 0.7 + 2419200 0.1548517 0.00000034 15.62 1656.5 33 0.9 + 2420208 0.1342645 0.00000038 18.03 1911.3 38 1.6 + 2430000 0.1669474 0.00000032 14.56 1543.8 30 0.8 + 2449440 0.1687256 0.00000033 14.52 1540.6 30 0.8 + 2450000 0.1572380 0.00000032 15.58 1653.5 32 0.7 + 2457600 0.1427680 0.00000033 17.21 1827.2 36 0.8 + 2458624 0.1524584 0.00000035 16.13 1711.8 33 0.7 + 2460375 0.2226828 0.00000026 11.05 1172.9 23 0.9 + 2469600 0.1877939 0.00000034 13.15 1396.3 27 0.8 + 2470629 0.2856039 0.00000026 8.65 918.5 18 1.0 + 2480058 0.1983173 0.00000039 12.51 1328.2 26 0.8 + 2480625 0.2272312 0.00000024 10.92 1159.5 23 0.9 + 2488320 0.1520071 0.00000034 16.37 1739.0 33 0.9 + 2500000 0.1740386 0.00000037 14.36 1526.5 29 0.8 + 2500470 0.1929087 0.00000034 12.96 1377.5 26 0.8 + 2508800 0.1514139 0.00000034 16.57 1761.2 34 0.8 + 2519424 0.1764632 0.00000038 14.28 1518.0 29 0.8 + 2520000 0.1769935 0.00000033 14.24 1513.8 29 0.9 + 2521050 0.1833147 0.00000038 13.75 1462.3 28 1.3 + 2531250 0.1799491 0.00000034 14.07 1496.1 28 0.8 + 2540160 0.1645508 0.00000035 15.44 1642.2 31 0.8 + 2551500 0.1718669 0.00000033 14.85 1579.8 30 0.8 + 2560000 0.1575165 0.00000035 16.25 1729.9 32 0.8 + 2571912 0.1958196 0.00000037 13.13 1398.4 26 0.8 + 2572500 0.1721517 0.00000032 14.94 1591.1 30 0.8 + 2580480 0.1579666 0.00000033 16.34 1739.7 32 0.9 + 2592000 0.1737439 0.00000033 14.92 1589.2 29 1.0 + 2593080 0.1498090 0.00000038 17.31 1844.0 34 2.6 + 2612736 0.1892632 0.00000037 13.80 1471.4 27 0.9 + 2621440 0.1596756 0.00000033 16.42 1750.2 32 0.8 + 2624400 0.1814837 0.00000033 14.46 1541.8 28 1.0 + 2625000 0.2021582 0.00000034 12.98 1384.4 25 0.9 + 2634240 0.1740386 0.00000035 15.14 1614.2 29 0.8 + 2646000 0.1796352 0.00000032 14.73 1571.3 28 0.9 + 2654208 0.1603241 0.00000033 16.56 1766.4 32 0.9 + 2657205 0.2519531 0.00000032 10.55 1125.4 20 0.9 + 2667168 0.1671631 0.00000035 15.96 1703.0 30 0.8 + 2679075 0.2834473 0.00000027 9.45 1009.1 18 1.0 + 2688000 0.1683187 0.00000034 15.97 1705.4 30 0.9 + 2689120 0.1486673 0.00000037 18.09 1931.7 34 1.4 + 2700000 0.2010352 0.00000034 13.43 1434.7 25 1.1 + 2701125 0.2684647 0.00000024 10.06 1074.8 19 1.0 + 2709504 0.1713298 0.00000035 15.81 1689.8 30 0.9 + 2721600 0.2062695 0.00000034 13.19 1410.2 25 1.1 + 2722734 0.2165324 0.00000041 12.57 1344.0 24 1.3 + 2733750 0.2006445 0.00000033 13.62 1456.7 25 0.9 + 2734375 0.2576904 0.00000031 10.61 1134.5 20 1.0 + 2744000 0.1791382 0.00000033 15.32 1638.1 28 0.8 + 2752512 0.1663543 0.00000033 16.55 1769.8 31 0.8 + 2755620 0.2089844 0.00000035 13.19 1410.5 24 0.9 + 2756250 0.1989183 0.00000033 13.86 1482.2 26 0.9 + 2764800 0.1740302 0.00000033 15.89 1699.8 29 1.1 + 2765952 0.1844046 0.00000034 15.00 1604.9 28 0.8 + 2778300 0.1983643 0.00000034 14.01 1499.1 26 0.9 + 2799360 0.1811175 0.00000035 15.46 1655.1 28 1.0 + 2800000 0.1844221 0.00000035 15.18 1625.8 28 0.9 + 2809856 0.1818935 0.00000035 15.45 1654.6 28 0.8 + 2812500 0.1950120 0.00000036 14.42 1544.9 26 0.9 + 2822400 0.1754024 0.00000034 16.09 1724.0 29 0.9 + 2823576 0.1587067 0.00000039 17.79 1906.2 32 1.2 + 2834352 0.1988995 0.00000039 14.25 1527.2 26 0.9 + 2835000 0.1986178 0.00000032 14.27 1529.8 26 1.0 + 2857680 0.1836112 0.00000034 15.56 1668.9 28 0.9 + 2867200 0.1860532 0.00000033 15.41 1652.9 27 0.9 + 2880000 0.2020898 0.00000035 14.25 1529.0 25 1.2 + 2881200 0.3655134 0.00000025 7.88 845.7 14 1.1 + 2893401 0.3088379 0.00000033 9.37 1005.5 17 1.1 + 2903040 0.1929650 0.00000034 15.04 1614.9 26 1.0 + 2916000 0.2375710 0.00000034 12.27 1318.0 22 1.2 + 2917215 0.3295746 0.00000027 8.85 950.5 16 1.5 + 2939328 0.1926551 0.00000036 15.26 1639.1 26 0.9 + 2940000 0.2312012 0.00000034 12.72 1366.2 22 1.0 + 2941225 0.3437337 0.00000024 8.56 919.3 15 1.2 + 2949120 0.1889377 0.00000033 15.61 1677.3 27 1.0 + 2952450 0.2504517 0.00000036 11.79 1266.9 20 1.0 + 2953125 0.2775750 0.00000025 10.64 1143.4 19 1.0 + 2963520 0.2643915 0.00000025 11.21 1204.9 19 1.0 + 2976750 0.2329656 0.00000034 12.78 1373.9 22 1.0 + 2985984 0.2062402 0.00000035 14.48 1557.1 25 1.1 + 3000000 0.2259044 0.00000036 13.28 1428.7 23 1.1 + 3000564 0.2343639 0.00000037 12.80 1377.4 22 0.9 + 3001250 0.2315119 0.00000031 12.96 1394.7 22 0.9 + 3010560 0.1953313 0.00000034 15.41 1658.5 26 0.9 + 3024000 0.2177204 0.00000034 13.89 1495.1 23 1.1 + 3025260 0.1677002 0.00000038 18.04 1941.8 30 1.8 + 3037500 0.2257876 0.00000033 13.45 1448.5 23 1.0 + 3048192 0.2287265 0.00000037 13.33 1435.3 22 1.0 + 3061800 0.2241848 0.00000034 13.66 1471.3 23 1.1 + 3062500 0.2507812 0.00000034 12.21 1315.6 20 1.0 + 3072000 0.2065430 0.00000034 14.87 1602.7 25 1.0 + 3073280 0.2713173 0.00000027 11.33 1220.6 19 1.0 + 3087000 0.2280495 0.00000033 13.54 1459.1 22 1.0 + 3096576 0.2034082 0.00000033 15.22 1641.3 25 1.0 + 3110400 0.2266686 0.00000035 13.72 1479.9 23 1.3 + 3111696 0.2086283 0.00000036 14.92 1608.5 24 0.9 + 3125000 0.2605347 0.00000038 11.99 1293.9 20 1.0 + 3136000 0.2462449 0.00000034 12.74 1374.2 21 1.0 + 3145728 0.2086792 0.00000033 15.07 1626.9 24 1.0 + 3149280 0.2080762 0.00000034 15.14 1633.6 25 1.0 + 3150000 0.2360729 0.00000033 13.34 1440.2 22 1.2 + 3161088 0.2201087 0.00000036 14.36 1550.5 23 1.0 + 3175200 0.2685804 0.00000035 11.82 1276.7 19 1.2 + 3176523 0.3822545 0.00000028 8.31 897.4 14 1.4 + 3188646 0.2877468 0.00000040 11.08 1197.0 18 1.1 + 3189375 0.2954963 0.00000025 10.79 1165.9 17 1.1 + 3200000 0.2268809 0.00000037 14.10 1523.9 23 1.1 + 3211264 0.2173665 0.00000034 14.77 1596.6 24 1.0 + 3214890 0.2750694 0.00000036 11.69 1263.2 19 1.1 + 3215625 0.3232727 0.00000025 9.95 1075.1 16 1.2 + 3225600 0.2198539 0.00000033 14.67 1586.1 23 1.2 + 3226944 0.1796962 0.00000039 17.96 1941.4 28 1.9 + 3240000 0.2500000 0.00000033 12.96 1401.5 20 1.4 + 3241350 0.2721140 0.00000034 11.91 1288.1 19 1.1 + 3265920 0.2272838 0.00000036 14.37 1554.7 22 1.1 + 3276800 0.2225820 0.00000033 14.72 1593.2 23 1.0 + 3280500 0.2666787 0.00000034 12.30 1331.3 19 1.1 + 3281250 0.2735531 0.00000036 11.99 1298.2 19 1.1 + 3292800 0.2503174 0.00000033 13.15 1424.0 20 1.1 + 3294172 0.1987868 0.00000040 16.57 1794.0 26 1.1 + 3306744 0.2636590 0.00000039 12.54 1358.1 19 1.1 + 3307500 0.2537476 0.00000033 13.03 1411.5 20 1.1 + 3317760 0.2272838 0.00000033 14.60 1581.0 22 1.2 + 3333960 0.2372048 0.00000035 14.06 1522.8 22 1.0 + 3359232 0.2755320 0.00000038 12.19 1321.6 19 1.2 + 3360000 0.2511841 0.00000033 13.38 1450.0 20 1.2 + 3361400 0.1956036 0.00000037 17.18 1862.9 26 1.5 + 3375000 0.2690173 0.00000034 12.55 1360.4 19 1.2 + 3386880 0.2632478 0.00000035 12.87 1395.4 19 1.1 + 3402000 0.2266368 0.00000033 15.01 1628.5 23 1.2 + 3429216 0.2308017 0.00000036 14.86 1612.8 22 1.1 + 3430000 0.2643915 0.00000032 12.97 1408.2 19 1.1 + 3440640 0.2419434 0.00000033 14.22 1544.0 21 1.1 + 3444525 0.3615723 0.00000028 9.53 1034.4 14 1.3 + 3456000 0.2425595 0.00000034 14.25 1547.4 21 1.4 + 3457440 0.2028223 0.00000037 17.05 1851.4 25 3.6 + 3472875 0.3828125 0.00000025 9.07 985.6 14 1.3 + 3483648 0.2639032 0.00000036 13.20 1434.4 19 1.2 + 3499200 0.2959415 0.00000035 11.82 1285.2 17 1.4 + 3500000 0.2987132 0.00000036 11.72 1273.6 17 1.2 + 3500658 0.3416829 0.00000036 10.25 1113.6 15 1.2 + 3512320 0.2462449 0.00000034 14.26 1550.7 21 1.1 + 3515625 0.3535644 0.00000029 9.94 1081.1 15 1.3 + 3528000 0.2701480 0.00000033 13.06 1420.2 19 1.2 + 3529470 0.2606079 0.00000039 13.54 1472.9 20 1.5 + 3538944 0.2425130 0.00000033 14.59 1587.3 21 1.2 + 3542940 0.3396322 0.00000037 10.43 1134.8 15 1.2 + 3543750 0.3079906 0.00000034 11.51 1251.7 17 1.2 + 3556224 0.2740157 0.00000037 12.98 1412.1 19 1.7 + 3572100 0.2945916 0.00000035 12.13 1319.8 17 1.2 + 3584000 0.2597656 0.00000034 13.80 1502.0 20 1.2 + 3600000 0.2829861 0.00000035 12.72 1385.3 18 1.3 + 3601500 0.2096354 0.00000038 17.18 1870.9 24 2.0 + 3612672 0.2601441 0.00000034 13.89 1512.6 20 1.2 + 3628800 0.2575317 0.00000033 14.09 1535.3 20 1.4 + 3630312 0.2217965 0.00000040 16.37 1783.4 23 1.9 + 3645000 0.2868246 0.00000032 12.71 1385.0 18 1.3 + 3670016 0.2754934 0.00000035 13.32 1452.5 19 1.1 + 3674160 0.2534546 0.00000035 14.50 1580.8 20 1.2 + 3675000 0.2945485 0.00000033 12.48 1360.5 17 1.2 + 3686400 0.2617065 0.00000033 14.09 1536.3 20 1.4 + 3687936 0.2908122 0.00000035 12.68 1383.2 18 1.2 + 3704400 0.2872314 0.00000032 12.90 1407.1 18 1.2 + 3720087 0.4375000 0.00000035 8.50 928.0 12 1.5 + 3732480 0.2869737 0.00000035 13.01 1419.8 18 1.4 + 3750000 0.3023897 0.00000035 12.40 1354.1 17 1.2 + 3750705 0.4237671 0.00000028 8.85 966.5 12 1.4 + 3763200 0.2795139 0.00000034 13.46 1470.4 18 1.2 + 3764768 0.2208093 0.00000040 17.05 1862.2 23 1.4 + 3779136 0.2656635 0.00000037 14.23 1554.1 19 1.2 + 3780000 0.3183441 0.00000034 11.87 1297.2 16 1.3 + 3781575 0.4368286 0.00000024 8.66 945.8 12 1.9 + 3796875 0.3924467 0.00000025 9.67 1057.3 13 1.4 + 3810240 0.2616821 0.00000034 14.56 1591.6 20 1.2 + 3827250 0.3526530 0.00000034 10.85 1186.6 15 1.3 + 3828125 0.4538371 0.00000028 8.44 922.3 12 1.5 + 3840000 0.2798530 0.00000035 13.72 1500.6 18 1.3 + 3841600 0.3203278 0.00000034 11.99 1311.6 16 1.2 + 3857868 0.3405762 0.00000039 11.33 1239.2 15 1.3 + 3858750 0.3671352 0.00000034 10.51 1149.8 14 1.4 + 3870720 0.2790799 0.00000034 13.87 1517.6 18 1.3 + 3888000 0.2877468 0.00000033 13.51 1478.9 18 1.4 + 3889620 0.3911884 0.00000027 9.94 1088.3 13 1.4 + 3906250 0.3755406 0.00000039 10.40 1138.8 14 1.4 + 3919104 0.2894830 0.00000038 13.54 1482.6 18 1.3 + 3920000 0.3145142 0.00000034 12.46 1364.9 16 1.3 + 3932160 0.2882080 0.00000033 13.64 1494.4 18 2.1 + 3936600 0.2991728 0.00000035 13.16 1441.4 17 1.4 + 3937500 0.3526042 0.00000033 11.17 1223.3 15 1.4 + 3951360 0.2826335 0.00000035 13.98 1531.8 18 1.2 + 3969000 0.2964154 0.00000033 13.39 1467.6 17 1.2 + 3981312 0.2968750 0.00000034 13.41 1470.1 17 1.5 + 4000000 0.2972915 0.00000036 13.45 1475.4 17 1.3 + 4000752 0.2781847 0.00000037 14.38 1577.1 18 1.2 + 4014080 0.2934028 0.00000034 13.68 1500.6 18 1.3 + 4032000 0.3149567 0.00000035 12.80 1404.5 16 1.5 + 4033680 0.2308461 0.00000038 17.47 1917.2 22 2.4 + 4050000 0.2907986 0.00000034 13.93 1528.5 18 1.3 + 4064256 0.3203125 0.00000037 12.69 1392.8 16 1.4 + 4082400 0.2810194 0.00000033 14.53 1595.1 18 1.4 + 4084101 0.4914995 0.00000029 8.31 912.4 11 1.8 + 4096000 0.3106618 0.00000034 13.18 1448.1 17 1.4 + 4100625 0.4686834 0.00000026 8.75 961.0 11 1.6 + 4116000 0.3627930 0.00000034 11.35 1246.4 14 1.4 + 4117715 0.4922097 0.00000025 8.37 919.1 11 1.7 + 4128768 0.3092687 0.00000033 13.35 1467.0 17 1.4 + 4133430 0.4134052 0.00000037 10.00 1098.8 13 1.5 + 4134375 0.5046387 0.00000025 8.19 900.4 10 1.6 + 4147200 0.3069853 0.00000033 13.51 1484.9 17 1.6 + 4148928 0.4472860 0.00000028 9.28 1019.6 12 1.5 + 4167450 0.4008414 0.00000033 10.40 1143.2 13 1.5 + 4194304 0.3064970 0.00000034 13.68 1505.3 17 1.2 + 4199040 0.3320312 0.00000036 12.65 1391.2 16 1.5 + 4200000 0.3484375 0.00000035 12.05 1326.0 15 1.5 + 4201750 0.2942437 0.00000038 14.28 1571.0 18 1.5 + 4214784 0.3065114 0.00000035 13.75 1513.1 17 1.3 + 4218750 0.4020621 0.00000035 10.49 1154.6 13 1.5 + 4233600 0.3246613 0.00000035 13.04 1435.3 16 2.0 + 4235364 0.2593262 0.00000040 16.33 1797.7 20 1.7 + 4251528 0.3484701 0.00000039 12.20 1343.3 15 1.4 + 4252500 0.4014423 0.00000033 10.59 1166.3 13 1.5 + 4286520 0.3241577 0.00000036 13.22 1456.7 16 1.4 + 4287500 0.3960712 0.00000034 10.83 1192.5 13 1.5 + 4300800 0.3106761 0.00000033 13.84 1525.3 17 1.4 + 4302592 0.2451521 0.00000039 17.55 1933.8 21 2.0 + 4320000 0.3116096 0.00000034 13.86 1527.9 17 1.5 + 4321800 0.4147010 0.00000031 10.42 1148.6 13 1.5 + 4354560 0.3102022 0.00000035 14.04 1548.0 17 1.5 + 4374000 0.3006089 0.00000033 14.55 1605.0 17 1.4 + 4375000 0.3766218 0.00000036 11.62 1281.3 14 1.5 + 4390400 0.3705532 0.00000033 11.85 1307.2 14 1.5 + 4408992 0.3188171 0.00000038 13.83 1526.2 16 1.4 + 4410000 0.3672049 0.00000033 12.01 1325.4 14 1.5 + 4423680 0.3178406 0.00000033 13.92 1536.3 16 1.5 + 4428675 0.5685764 0.00000030 7.79 859.9 9 1.8 + 4445280 0.3144531 0.00000034 14.14 1560.9 16 1.4 + 4465125 0.5274414 0.00000026 8.47 935.0 10 2.8 + 4478976 0.3739014 0.00000037 11.98 1323.4 14 1.7 + 4480000 0.3744245 0.00000034 11.97 1321.8 14 1.6 + 4500000 0.4080717 0.00000036 11.03 1218.6 13 1.6 + 4500846 0.4651101 0.00000038 9.68 1069.4 11 1.6 + 4501875 0.5311035 0.00000024 8.48 936.7 10 1.8 + 4515840 0.3526367 0.00000035 12.81 1415.5 15 1.5 + 4536000 0.3852351 0.00000034 11.77 1301.9 13 1.7 + 4537890 0.3541829 0.00000040 12.81 1416.6 15 2.2 + 4556250 0.4524333 0.00000034 10.07 1113.8 12 1.6 + 4572288 0.3505859 0.00000038 13.04 1442.7 15 1.5 + 4587520 0.3329620 0.00000033 13.78 1524.5 16 1.5 + 4592700 0.4602273 0.00000034 9.98 1104.2 11 1.8 + 4593750 0.4289754 0.00000035 10.71 1185.0 12 1.6 + 4608000 0.3500488 0.00000034 13.16 1457.0 15 1.8 + 4609920 0.2782796 0.00000038 16.57 1833.5 18 3.9 + 4630500 0.5133057 0.00000024 9.02 998.7 10 1.8 + 4644864 0.3525879 0.00000036 13.17 1458.8 15 1.6 + 4665600 0.3417643 0.00000034 13.65 1512.2 15 1.8 + 4667544 0.3582938 0.00000037 13.03 1443.0 14 1.4 + 4687500 0.4375000 0.00000037 10.71 1187.2 12 1.6 + 4704000 0.4031889 0.00000033 11.67 1293.0 13 1.6 + 4705960 0.2899170 0.00000038 16.23 1799.0 18 1.7 + 4718592 0.3380696 0.00000034 13.96 1547.2 15 1.5 + 4723920 0.3515625 0.00000037 13.44 1489.6 15 1.5 + 4725000 0.4461263 0.00000032 10.59 1174.1 12 1.7 + 4741632 0.3207703 0.00000036 14.78 1639.1 16 1.4 + 4762800 0.3280945 0.00000034 14.52 1610.1 16 1.5 + 4782969 0.6436462 0.00000036 7.43 824.5 8 2.0 + 4800000 0.4166870 0.00000035 11.52 1278.3 12 1.8 + 4802000 0.6336670 0.00000026 7.58 841.0 8 2.0 + 4816896 0.3552246 0.00000034 13.56 1505.2 15 1.5 + 4822335 0.6206597 0.00000030 7.77 862.5 9 2.0 + 4838400 0.3257294 0.00000033 14.85 1649.3 16 1.7 + 4840416 0.2833523 0.00000039 17.08 1896.7 18 2.8 + 4860000 0.4558549 0.00000034 10.66 1184.1 11 1.9 + 4862025 0.6757812 0.00000027 7.19 799.1 8 2.1 + 4898880 0.3467611 0.00000034 14.13 1569.9 15 1.6 + 4900000 0.4232992 0.00000034 11.58 1286.3 12 1.6 + 4915200 0.3953764 0.00000033 12.43 1381.7 13 1.7 + 4917248 0.3906062 0.00000034 12.59 1399.2 13 1.6 + 4920750 0.5693088 0.00000034 8.64 960.7 9 1.9 + 4921875 0.5886230 0.00000027 8.36 929.4 9 2.0 + 4939200 0.4440104 0.00000034 11.12 1236.8 12 1.7 + 4941258 0.3936298 0.00000040 12.55 1395.7 13 1.8 + 4960116 0.5281982 0.00000040 9.39 1044.3 10 1.8 + 4961250 0.5170898 0.00000034 9.59 1067.0 10 2.0 + 4976640 0.4167074 0.00000035 11.94 1328.4 12 1.9 + 5000000 0.4538574 0.00000039 11.02 1225.8 12 1.8 + 5000940 0.5226074 0.00000036 9.57 1064.8 10 1.9 + 5017600 0.4068322 0.00000034 12.33 1372.6 13 1.7 + 5038848 0.3708147 0.00000039 13.59 1512.7 14 1.7 + 5040000 0.4371745 0.00000033 11.53 1283.4 12 1.9 + 5042100 0.2916667 0.00000038 17.29 1924.5 18 4.0 + 5062500 0.4620028 0.00000033 10.96 1220.2 11 1.8 + 5080320 0.3532552 0.00000035 14.38 1601.8 15 1.5 + 5103000 0.3804409 0.00000034 13.41 1494.4 14 1.6 + 5120000 0.3856671 0.00000035 13.28 1479.4 13 1.7 + 5143824 0.3731864 0.00000038 13.78 1536.5 14 1.6 + 5145000 0.4572088 0.00000032 11.25 1254.4 11 1.7 + 5160960 0.3812779 0.00000033 13.54 1509.2 14 1.7 + 5184000 0.3506511 0.00000033 14.78 1648.8 15 1.8 + 5186160 0.3037684 0.00000038 17.07 1904.1 17 12.5 + 5225472 0.3576823 0.00000037 14.61 1630.2 15 1.7 + 5242880 0.3871695 0.00000033 13.54 1511.4 13 1.6 + 5248800 0.3611886 0.00000033 14.53 1622.0 14 1.8 + 5250000 0.4671520 0.00000034 11.24 1254.4 11 1.8 + 5250987 0.7173549 0.00000031 7.32 817.1 7 2.2 + 5268480 0.5859375 0.00000027 8.99 1003.9 9 2.0 + 5292000 0.4975142 0.00000035 10.64 1187.9 11 1.9 + 5294205 0.6298828 0.00000025 8.41 938.7 8 2.5 + 5308416 0.3870192 0.00000034 13.72 1532.1 13 1.8 + 5314410 0.6052517 0.00000038 8.78 980.8 9 2.0 + 5315625 0.6139323 0.00000025 8.66 967.2 9 2.0 + 5334336 0.5419922 0.00000036 9.84 1099.7 10 1.9 + 5358150 0.5933160 0.00000035 9.03 1009.3 9 2.0 + 5359375 0.6520996 0.00000026 8.22 918.6 8 2.1 + 5376000 0.4327799 0.00000035 12.42 1388.7 12 1.8 + 5378240 0.3154297 0.00000039 17.05 1906.1 16 4.3 + 5400000 0.4744318 0.00000035 11.38 1272.8 11 2.0 + 5402250 0.3984375 0.00000039 13.56 1516.2 13 4.7 + 5419008 0.4187826 0.00000036 12.94 1447.3 12 1.7 + 5443200 0.3973858 0.00000035 13.70 1532.5 13 1.9 + 5445468 0.3501302 0.00000042 15.55 1740.1 15 3.8 + 5467500 0.5831163 0.00000033 9.38 1049.3 9 2.1 + 5468750 0.5281250 0.00000038 10.36 1158.9 10 1.9 + 5488000 0.4884588 0.00000034 11.24 1257.7 11 1.8 + 5505024 0.4050481 0.00000035 13.59 1521.7 13 1.7 + 5511240 0.6464844 0.00000036 8.52 954.5 8 2.1 + 5512500 0.5351562 0.00000033 10.30 1153.4 10 2.0 + 5529600 0.4566761 0.00000033 12.11 1356.1 11 2.8 + 5531904 0.3931791 0.00000037 14.07 1575.8 13 1.8 + 5556600 0.5690104 0.00000034 9.77 1094.0 9 2.1 + 5598720 0.3843471 0.00000036 14.57 1632.7 14 1.9 + 5600000 0.5000000 0.00000035 11.20 1255.4 10 2.0 + 5619712 0.4290365 0.00000035 13.10 1468.5 12 1.8 + 5625000 0.5109375 0.00000036 11.01 1234.3 10 2.0 + 5644800 0.3811384 0.00000034 14.81 1660.9 14 1.7 + 5647152 0.3442708 0.00000039 16.40 1839.5 15 3.2 + 5668704 0.6660156 0.00000039 8.51 954.7 8 2.3 + 5670000 0.5039062 0.00000032 11.25 1262.2 10 2.0 + 5715360 0.6464844 0.00000036 8.84 992.2 8 2.2 + 5734400 0.4329427 0.00000033 13.25 1486.9 12 1.8 + 5740875 0.7912946 0.00000027 7.26 814.5 7 2.5 + 5760000 0.3930289 0.00000034 14.66 1645.6 13 1.9 + 5762400 0.5616319 0.00000034 10.26 1152.1 9 2.0 + 5764801 0.6962891 0.00000026 8.28 929.7 8 2.3 + 5786802 0.6953125 0.00000040 8.32 934.8 8 2.2 + 5788125 0.7021484 0.00000025 8.24 925.9 8 2.3 + 5806080 0.4744318 0.00000036 12.24 1374.9 11 2.0 + 5832000 0.5523437 0.00000034 10.56 1186.6 10 2.3 + 5834430 0.4687500 0.00000041 12.45 1398.8 11 5.5 + 5859375 0.6767578 0.00000032 8.66 973.3 8 2.2 + 5878656 0.4552557 0.00000039 12.91 1451.9 11 2.0 + 5880000 0.5304688 0.00000034 11.08 1246.3 10 2.0 + 5882450 0.4199219 0.00000038 14.01 1575.1 12 2.2 + 5898240 0.4420573 0.00000034 13.34 1500.5 12 1.9 + 5904900 0.6835938 0.00000035 8.64 971.5 8 2.3 + 5906250 0.5746528 0.00000035 10.28 1156.0 9 2.1 + 5927040 0.4322917 0.00000036 13.71 1542.4 12 1.8 + 5953500 0.6748047 0.00000033 8.82 992.8 8 2.3 + 5971968 0.4786932 0.00000036 12.48 1404.1 11 2.1 + 6000000 0.5382813 0.00000036 11.15 1254.9 10 2.1 + 6001128 0.7060547 0.00000037 8.50 956.9 8 2.3 + 6002500 0.5677083 0.00000033 10.57 1190.4 9 2.0 + 6021120 0.4566761 0.00000034 13.18 1484.7 11 1.9 + 6048000 0.4086539 0.00000034 14.80 1667.1 13 1.9 + 6050520 0.3526042 0.00000039 17.16 1932.9 15 6.9 + 6075000 0.5651042 0.00000033 10.75 1211.3 9 2.2 + 6096384 0.4270833 0.00000037 14.27 1608.7 12 5.3 + 6123600 0.5668403 0.00000035 10.80 1217.8 9 3.0 + 6125000 0.5653212 0.00000035 10.83 1221.4 9 3.2 + 6144000 0.4687500 0.00000034 13.11 1477.9 11 2.8 + 6146560 0.3744420 0.00000038 16.42 1850.9 14 6.7 + 6174000 0.5531250 0.00000033 11.16 1259.0 10 2.1 + 6193152 0.4687500 0.00000035 13.21 1490.5 11 2.0 + 6200145 0.9101562 0.00000032 6.81 768.5 6 2.7 + 6220800 0.4251302 0.00000034 14.63 1651.2 12 2.2 + 6223392 0.7455357 0.00000035 8.35 942.0 7 2.4 + 6250000 0.5850694 0.00000038 10.68 1205.8 9 2.1 + 6251175 0.9153646 0.00000028 6.83 770.9 6 2.7 + 6272000 0.5720486 0.00000033 10.96 1237.9 9 2.2 + 6291456 0.4744318 0.00000034 13.26 1497.5 11 2.0 + 6298560 0.7466518 0.00000036 8.44 952.7 7 2.6 + 6300000 0.6145833 0.00000036 10.25 1157.7 9 2.3 + 6302625 0.7555804 0.00000024 8.34 942.1 7 3.0 + 6322176 0.5234375 0.00000036 12.08 1364.4 10 2.0 + 6328125 0.7321429 0.00000026 8.64 976.4 7 2.4 + 6350400 0.6041667 0.00000035 10.51 1187.7 9 2.3 + 6353046 0.5335938 0.00000041 11.91 1345.3 10 2.8 + 6377292 0.8046875 0.00000041 7.93 895.7 7 2.6 + 6378750 0.6582031 0.00000035 9.69 1095.3 8 2.3 + 6400000 0.5296875 0.00000035 12.08 1365.9 10 2.1 + 6422528 0.4794034 0.00000035 13.40 1514.8 11 2.0 + 6429780 0.7700893 0.00000036 8.35 944.2 7 2.5 + 6431250 0.6318359 0.00000034 10.18 1151.0 8 2.2 + 6451200 0.5023438 0.00000034 12.84 1452.5 10 2.2 + 6453888 0.3870192 0.00000040 16.68 1886.2 13 5.9 + 6480000 0.4794034 0.00000035 13.52 1529.3 11 2.3 + 6482700 0.7868304 0.00000025 8.24 932.2 7 2.5 + 6531840 0.4545455 0.00000036 14.37 1626.6 11 2.1 + 6553600 0.4886364 0.00000033 13.41 1518.5 11 2.1 + 6561000 0.6494141 0.00000034 10.10 1143.9 8 2.4 + 6562500 0.6171875 0.00000036 10.63 1204.0 9 2.2 + 6585600 0.5946181 0.00000034 11.08 1254.3 9 2.8 + 6588344 0.4238281 0.00000040 15.54 1760.6 12 6.4 + 6613488 0.8802083 0.00000039 7.51 851.2 6 2.9 + 6615000 0.6718750 0.00000033 9.85 1115.4 8 2.5 + 6635520 0.5007812 0.00000034 13.25 1501.4 10 2.4 + 6667920 0.8024554 0.00000026 8.31 941.8 7 2.8 + 6718464 0.4801136 0.00000038 13.99 1586.8 11 2.3 + 6720000 0.6076389 0.00000033 11.06 1254.1 9 2.3 + 6722800 0.4375000 0.00000038 15.37 1742.6 12 4.1 + 6750000 0.6076389 0.00000034 11.11 1260.1 9 2.5 + 6751269 1.0437500 0.00000033 6.47 733.7 5 3.1 + 6773760 0.4723011 0.00000035 14.34 1627.2 11 2.0 + 6804000 0.8554688 0.00000035 7.95 902.6 6 2.9 + 6806835 0.8125000 0.00000027 8.38 950.8 7 3.6 + 6834375 0.9713542 0.00000025 7.04 798.7 6 3.0 + 6858432 0.8314732 0.00000038 8.25 936.6 7 2.8 + 6860000 0.6562500 0.00000033 10.45 1187.0 8 2.3 + 6881280 0.5351562 0.00000034 12.86 1460.3 10 2.7 + 6889050 0.9075521 0.00000036 7.59 862.2 6 2.9 + 6890625 0.8346354 0.00000026 8.26 937.7 6 2.7 + 6912000 0.5616319 0.00000034 12.31 1398.1 9 2.5 + 6914880 0.7667411 0.00000027 9.02 1024.6 7 2.6 + 6945750 0.9036458 0.00000032 7.69 873.5 6 2.8 + 6967296 0.5737847 0.00000038 12.14 1380.1 9 2.4 + 6998400 0.5335938 0.00000036 13.12 1491.2 10 2.5 + 7000000 0.6953125 0.00000035 10.07 1144.6 8 2.5 + 7001316 0.9270833 0.00000038 7.55 858.6 6 2.9 + 7024640 0.5500000 0.00000035 12.77 1452.4 10 2.2 + 7031250 0.7119141 0.00000038 9.88 1123.2 8 2.5 + 7056000 0.5460938 0.00000034 12.92 1469.8 10 2.2 + 7058940 0.4270833 0.00000039 16.53 1880.2 12 3.7 + 7077888 0.5382813 0.00000034 13.15 1496.0 10 2.3 + 7085880 0.8984375 0.00000037 7.89 897.4 6 2.9 + 7087500 0.6845703 0.00000033 10.35 1178.0 8 2.5 + 7112448 0.5156250 0.00000038 13.79 1569.9 10 3.4 + 7144200 0.8984375 0.00000034 7.95 905.2 6 3.0 + 7168000 0.5598958 0.00000034 12.80 1457.8 9 2.4 + 7200000 0.5296875 0.00000036 13.59 1548.2 10 2.5 + 7203000 0.4231771 0.00000038 17.02 1938.7 12 8.2 + 7225344 0.5590278 0.00000035 12.92 1472.4 9 2.3 + 7257600 0.5085937 0.00000034 14.27 1626.1 10 2.3 + 7260624 0.4459635 0.00000040 16.28 1855.3 12 6.7 + 7290000 0.6767578 0.00000032 10.77 1227.9 8 2.7 + 7340032 0.5824653 0.00000035 12.60 1437.1 9 2.3 + 7348320 0.9609375 0.00000036 7.65 872.1 6 3.2 + 7350000 0.6992188 0.00000033 10.51 1198.8 8 2.6 + 7372800 0.5616319 0.00000033 13.13 1497.4 9 2.5 + 7375872 0.9804688 0.00000028 7.52 858.1 6 3.1 + 7381125 1.1250000 0.00000028 6.56 748.5 5 3.3 + 7408800 0.6796875 0.00000033 10.90 1243.8 8 2.5 + 7411887 0.9257812 0.00000028 8.01 913.6 6 3.1 + 7440174 1.0562500 0.00000041 7.04 804.0 5 3.2 + 7441875 1.1843750 0.00000026 6.28 717.2 5 3.4 + 7464960 0.6474609 0.00000036 11.53 1316.2 8 2.7 + 7500000 0.7165179 0.00000036 10.47 1195.3 7 2.6 + 7501410 1.0218750 0.00000037 7.34 838.3 5 3.2 + 7503125 0.9713542 0.00000025 7.72 882.1 6 3.1 + 7526400 0.6250000 0.00000035 12.04 1375.4 8 2.4 + 7529536 0.4433594 0.00000041 16.98 1939.8 12 3.2 + 7558272 0.6197917 0.00000040 12.19 1393.2 9 2.5 + 7560000 0.6835938 0.00000032 11.06 1263.5 8 2.7 + 7563150 0.5572917 0.00000039 13.57 1550.6 9 4.7 + 7593750 0.7845982 0.00000035 9.68 1106.1 7 2.8 + 7620480 0.5772569 0.00000037 13.20 1509.0 9 2.4 + 7654500 0.9895833 0.00000034 7.74 884.4 6 3.2 + 7656250 0.7935268 0.00000036 9.65 1103.2 7 3.6 + 7680000 0.5972222 0.00000035 12.86 1470.7 9 2.7 + 7683200 0.7466518 0.00000033 10.29 1176.9 7 3.9 + 7715736 1.0359375 0.00000039 7.45 852.0 5 3.4 + 7717500 0.7555804 0.00000034 10.21 1168.5 7 2.8 + 7741440 0.6059028 0.00000035 12.78 1461.9 9 2.6 + 7776000 0.5555556 0.00000034 14.00 1602.0 9 2.5 + 7779240 0.4943182 0.00000040 15.74 1801.2 11 12.5 + 7812500 0.7712054 0.00000041 10.13 1159.8 7 2.7 + 7838208 0.5946181 0.00000039 13.18 1509.5 9 2.6 + 7840000 0.7343750 0.00000034 10.68 1222.5 7 2.7 + 7864320 0.5972222 0.00000034 13.17 1508.2 9 2.5 + 7873200 0.7801339 0.00000036 10.09 1156.0 7 2.9 + 7875000 0.7566964 0.00000034 10.41 1192.1 7 2.8 + 7902720 0.5694444 0.00000036 13.88 1590.0 9 2.3 + 7938000 0.7299107 0.00000033 10.88 1246.3 7 2.7 + 7962624 0.6357422 0.00000036 12.52 1435.7 8 2.7 + 7971615 1.2929688 0.00000033 6.17 706.7 4 3.7 + 8000000 0.7433036 0.00000036 10.76 1234.0 7 2.8 + 8001504 1.0921875 0.00000038 7.33 840.0 5 3.4 + 8028160 0.6269531 0.00000034 12.81 1468.5 8 2.5 + 8037225 1.2812500 0.00000028 6.27 719.5 4 3.8 + 8064000 0.5781250 0.00000034 13.95 1600.1 9 2.5 + 8067360 0.4928977 0.00000040 16.37 1877.6 11 8.6 + 8100000 0.7500000 0.00000033 10.80 1239.3 7 3.0 + 8103375 0.9414062 0.00000024 8.61 987.7 6 4.7 + 8128512 0.7332589 0.00000037 11.09 1272.3 7 2.8 + 8164800 1.0859375 0.00000034 7.52 863.2 5 3.6 + 8168202 0.7801339 0.00000043 10.47 1202.1 7 7.6 + 8192000 0.6484375 0.00000034 12.63 1450.7 8 2.7 + 8201250 1.1531250 0.00000035 7.11 816.7 5 3.7 + 8203125 1.0515625 0.00000030 7.80 895.8 5 3.5 + 8232000 1.3671875 0.00000026 6.02 691.6 4 4.1 + 8235430 0.5920139 0.00000039 13.91 1597.9 9 2.9 + 8257536 0.6367188 0.00000034 12.97 1489.9 8 2.7 + 8266860 1.1296875 0.00000038 7.32 840.8 5 3.5 + 8268750 0.8593750 0.00000035 9.62 1105.5 6 3.0 + 8294400 0.6660156 0.00000034 12.45 1431.2 8 3.0 + 8297856 0.6572266 0.00000038 12.63 1450.9 8 2.5 + 8334900 1.1359375 0.00000034 7.34 843.5 5 3.5 + 8388608 0.6611328 0.00000035 12.69 1459.1 8 2.5 diff --git a/wsjtx_lib/lib/allsim.f90 b/wsjtx_lib/lib/allsim.f90 new file mode 100644 index 0000000..94a03ef --- /dev/null +++ b/wsjtx_lib/lib/allsim.f90 @@ -0,0 +1,122 @@ +program allsim + +! Generate simulated data for WSJT-X modes: JT4, JT9, JT65, FT8, FT4, QRA64, +! and WSPR. Also unmodulated carrier and 20 WPM CW. + + use wavhdr + use packjt + parameter (NMAX=60*12000) + type(hdr) h !Header for the .wav file + integer*2 iwave(NMAX) !Generated waveform (no noise) + integer itone(206) !Channel symbols (values 0-8) + integer icw(250) !Encoded CW message bits + integer*1 msgbits(101) !Encoded message bits for FST4 FT8 FT4 + real dat(NMAX) !Audio waveform + complex cwave(NMAX) + real wave(NMAX) + character message*22,msgsent*22,arg*8 + character*37 msg37,msgsent37 + + nargs=iargc() + if(nargs.ne.1 .and. nargs.ne.2) then + print*,'Usage: allsim snr [isig]' + print*,'Examples: allsim -10 #Include all signal types' + print*,' allsim -10 6 #Include FT8 only' + print*,'isig order: 1 2 3 4 5 6 7 8 9 10' + print*,' Carrier CW WSPR FST4 JT9 JT4 FT8 FT4 Q65 JT65' + go to 999 + endif + + call getarg(1,arg) + read(arg,*) snrdb !S/N in dB (2500 hz reference BW) + isig=0 + if(nargs.eq.2) then + call getarg(2,arg) + read(arg,*) isig + endif + + message='CQ KA2ABC FN20' + msg37=message//' ' + rmsdb=25. + rms=10.0**(0.05*rmsdb) + sig=10.0**(0.05*snrdb) + + call init_random_seed() !Seed Fortran RANDOM_NUMBER generator + call sgran() !Seed C rand generator (used in gran) + + h=default_header(12000,NMAX) + open(10,file='000000_0000.wav',access='stream',status='unknown') + do i=1,NMAX !Generate gaussian noise + dat(i)=gran() + enddo + + itone=0 + if(isig.eq.0 .or. isig.eq.1) then + call addit(itone,12000,85,6912,400,sig,dat) !1 Unmodulated carrier + endif + + if(isig.eq.0 .or. isig.eq.2) then + call morse('CQ CQ DE KA2ABC KA2ABC',icw,ncw) + call addcw(icw,ncw,600,sig,dat) !2 CW at 20 WPM + endif + + if(isig.eq.0 .or. isig.eq.3) then + call genwspr(message,msgsent,itone) + call addit(itone,12000,86,8192,800,sig,dat) !3 WSPR (only 59 s of data) + endif + + if(isig.eq.0 .or. isig.eq.4) then !4 FST4-60 + iwspr=0 + call genfst4(msg37,0,msgsent37,msgbits,itone,iwspr) + nwave=162*3888 + call gen_fst4wave(itone,160,3888,nwave,12000.0,1,1000.0,0,cwave,wave) + dat(6001:6000+nwave)=dat(6001:6000+nwave) + sig*wave(1:nwave) + endif + + if(isig.eq.0 .or. isig.eq.5) then + call gen9(message,0,msgsent,itone,itype) + call addit(itone,12000,85,6912,1200,sig,dat) !4 JT9 + endif + + if(isig.eq.0 .or. isig.eq.6) then + call gen4(message,0,msgsent,itone,itype) + call addit(itone,11025,206,2520,1400,sig,dat) !6 JT4 + endif + + if(isig.eq.0 .or. isig.eq.7) then + call genft8(msg37,i3,n3,msgsent37,msgbits,itone) !7 FT8 + nwave=79*1920 + call gen_ft8wave(itone,79,1920,2.0,12000.0,1600.0,cwave,wave,0,nwave) + dat(6001:6000+nwave)=dat(6001:6000+nwave) + sig*wave(1:nwave) + k=30*12000 + dat(6001+k:6000+nwave+k)=dat(6001+k:6000+nwave+k) + sig*wave(1:nwave) + endif + + if(isig.eq.0 .or. isig.eq.8) then + call genft4(msg37,0,msgsent37,msgbits,itone) !8 FT4 + nwave=105*576 + call gen_ft4wave(itone,103,576,12000.0,1800.0,cwave,wave,0,nwave) + dat(6001:6000+nwave)=dat(6001:6000+nwave) + sig*wave(1:nwave) + k=15*12000 + dat(6001+k:6000+nwave+k)=dat(6001+k:6000+nwave+k) + sig*wave(1:nwave) + k=30*12000 + dat(6001+k:6000+nwave+k)=dat(6001+k:6000+nwave+k) + sig*wave(1:nwave) + k=45*12000 + dat(6001+k:6000+nwave+k)=dat(6001+k:6000+nwave+k) + sig*wave(1:nwave) + endif + + if(isig.eq.0 .or. isig.eq.9) then + call genq65(msg37,0,msgsent37,itone,i3,n3) + call addit(itone,12000,85,7200,2000,sig,dat) !9 Q65 + endif + + if(isig.eq.0 .or. isig.eq.10) then + call gen65(message,0,msgsent,itone,itype) + call addit(itone,11025,126,4096,2200,sig,dat) !10 JT65A + endif + + iwave=nint(rms*dat) + write(10) h,iwave + close(10) + +999 end program allsim diff --git a/wsjtx_lib/lib/ana64.f90 b/wsjtx_lib/lib/ana64.f90 new file mode 100644 index 0000000..68e05a0 --- /dev/null +++ b/wsjtx_lib/lib/ana64.f90 @@ -0,0 +1,20 @@ +subroutine ana64(iwave,npts,c0) + + use timer_module, only: timer + + integer*2 iwave(npts) !Raw data at 12000 Hz + complex c0(0:npts-1) !Complex data at 6000 Hz + save + + nfft1=npts + nfft2=nfft1/2 + df1=12000.0/nfft1 + fac=2.0/(32767.0*nfft1) + c0(0:npts-1)=fac*iwave(1:npts) + call four2a(c0,nfft1,1,-1,1) !Forward c2c FFT + c0(nfft2/2+1:nfft2-1)=0. + c0(0)=0.5*c0(0) + call four2a(c0,nfft2,1,1,1) !Inverse c2c FFT; c0 is analytic sig + + return +end subroutine ana64 diff --git a/wsjtx_lib/lib/ana932.f90 b/wsjtx_lib/lib/ana932.f90 new file mode 100644 index 0000000..2665b7a --- /dev/null +++ b/wsjtx_lib/lib/ana932.f90 @@ -0,0 +1,21 @@ +subroutine ana932(dat,npts0,cdat,npts) + + real dat(npts0) + complex cdat(262145) + + n=log(float(npts0))/log(2.0) + nfft1=2**(n+1) + nfft2=9*nfft1/32 + df932=11025.0/nfft1 + fac=2.0/nfft1 + do i=1,npts0/2 + cdat(i)=fac*cmplx(dat(2*i-1),dat(2*i)) + enddo + cdat(npts0/2+1:nfft1/2)=0. + call four2a(cdat,nfft1,1,-1,0) !Forward r2c FFT + call four2a(cdat,nfft2,1,1,1) !Inverse c2c FFT + npts=npts0*9.0/32.0 !Downsampled data length + npts2=npts + + return +end subroutine ana932 diff --git a/wsjtx_lib/lib/analytic.f90 b/wsjtx_lib/lib/analytic.f90 new file mode 100644 index 0000000..cf89be4 --- /dev/null +++ b/wsjtx_lib/lib/analytic.f90 @@ -0,0 +1,75 @@ +subroutine analytic(d,npts,nfft,c,pc,beq) + +! Convert real data to analytic signal + + parameter (NFFTMAX=1024*1024) + + real d(npts) ! passband signal + real h(NFFTMAX/2) ! real BPF magnitude + real*8 pc(5),pclast(5) ! static phase coeffs + real*8 ac(5),aclast(5) ! amp coeffs + real*8 fp + + complex corr(NFFTMAX/2) ! complex frequency-dependent correction + complex c(NFFTMAX) ! analytic signal + + logical*1 beq ! boolean static equalizer flag + + data nfft0/0/ + data aclast/0.0,0.0,0.0,0.0,0.0/ + data pclast/0.0,0.0,0.0,0.0,0.0/ +! data ac/1.0,0.05532,0.11438,0.12918,0.09274/ ! amp coeffs for TS2000 + data ac/1.0,0.0,0.0,0.0,0.0/ + + save corr,nfft0,h,ac,aclast,pclast,pi,t,beta + + df=12000.0/nfft + nh=nfft/2 + if( nfft.ne.nfft0 ) then + pi=4.0*atan(1.0) + t=1.0/2000.0 + beta=0.1 + do i=1,nh+1 + ff=(i-1)*df + f=ff-1500.0 + h(i)=1.0 + if(abs(f).gt.(1-beta)/(2*t) .and. abs(f).le.(1+beta)/(2*t)) then + h(i)=h(i)*0.5*(1+cos((pi*t/beta )*(abs(f)-(1-beta)/(2*t)))) + elseif( abs(f) .gt. (1+beta)/(2*t) ) then + h(i)=0.0 + endif + enddo + nfft0=nfft + endif + + if( any(aclast .ne. ac) .or. any(pclast .ne. pc) ) then + aclast=ac + pclast=pc +! write(*,3001) pc +!3001 format('Phase coeffs:',5f12.6) + do i=1,nh+1 + ff=(i-1)*df + f=ff-1500.0 + fp=f/1000.0 + corr(i)=ac(1)+fp*(ac(2)+fp*(ac(3)+fp*(ac(4)+fp*ac(5)))) + pd=fp*fp*(pc(3)+fp*(pc(4)+fp*pc(5))) ! ignore 1st two terms + corr(i)=corr(i)*cmplx(cos(pd),sin(pd)) + enddo + endif + + fac=2.0/nfft + c(1:npts)=fac*d(1:npts) + c(npts+1:nfft)=0. + call four2a(c,nfft,1,-1,1) !Forward c2c FFT + + if( beq ) then + c(1:nh+1)=h(1:nh+1)*corr(1:nh+1)*c(1:nh+1) + else + c(1:nh+1)=h(1:nh+1)*c(1:nh+1) + endif + + c(1)=0.5*c(1) !Half of DC term + c(nh+2:nfft)=0. !Zero the negative frequencies + call four2a(c,nfft,1,1,1) !Inverse c2c FFT + return +end subroutine analytic diff --git a/wsjtx_lib/lib/astro.f90 b/wsjtx_lib/lib/astro.f90 new file mode 100644 index 0000000..ae2ad1f --- /dev/null +++ b/wsjtx_lib/lib/astro.f90 @@ -0,0 +1,107 @@ +subroutine astro(nyear,month,nday,uth,freq8,Mygrid, & + NStation,MoonDX,AzSun,ElSun,AzMoon0,ElMoon0, & + ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd, & + poloffset,xnr,day,lon,lat,LST,techo) + +! Computes astronomical quantities for display and tracking. +! NB: may want to smooth the Tsky map to 10 degrees or so. + + character*6 MyGrid,HisGrid + real*8 freq8 + real LST + real lat,lon + integer*2 nt144(180) + +! common/echo/xdop(2),techo,AzMoon,ElMoon,mjd + real xdop(2) + + data rad/57.2957795/ + data nt144/ & + 234, 246, 257, 267, 275, 280, 283, 286, 291, 298, & + 305, 313, 322, 331, 341, 351, 361, 369, 376, 381, & + 383, 382, 379, 374, 370, 366, 363, 361, 363, 368, & + 376, 388, 401, 415, 428, 440, 453, 467, 487, 512, & + 544, 579, 607, 618, 609, 588, 563, 539, 512, 482, & + 450, 422, 398, 379, 363, 349, 334, 319, 302, 282, & + 262, 242, 226, 213, 205, 200, 198, 197, 196, 197, & + 200, 202, 204, 205, 204, 203, 202, 201, 203, 206, & + 212, 218, 223, 227, 231, 236, 240, 243, 247, 257, & + 276, 301, 324, 339, 346, 344, 339, 331, 323, 316, & + 312, 310, 312, 317, 327, 341, 358, 375, 392, 407, & + 422, 437, 451, 466, 480, 494, 511, 530, 552, 579, & + 612, 653, 702, 768, 863,1008,1232,1557,1966,2385, & + 2719,2924,3018,3038,2986,2836,2570,2213,1823,1461, & + 1163, 939, 783, 677, 602, 543, 494, 452, 419, 392, & + 373, 360, 353, 350, 350, 350, 350, 350, 350, 348, & + 344, 337, 329, 319, 307, 295, 284, 276, 272, 272, & + 273, 274, 274, 271, 266, 260, 252, 245, 238, 231/ + save + + call grid2deg(MyGrid,elon,lat) + lon=-elon + call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST, & + AzSun,ElSun,mjd,day) + + call MoonDopJPL(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon, & + LST,HA,AzMoon,ElMoon,vr,techo) + RAMoon=rad*RAMoon + DecMoon=rad*DecMoon + dist=2.99792458d5*techo/2.d0 + +! Compute spatial polarization offset + xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* & + cos(AzMoon/rad)*sin(ElMoon/rad) + yy=cos(lat/rad)*sin(AzMoon/rad) + if(NStation.eq.1) poloffset1=rad*atan2(yy,xx) + if(NStation.eq.2) poloffset2=rad*atan2(yy,xx) + + doppler=-freq8*vr/2.99792458e5 !One-way Doppler + + call coord(0.,0.,-1.570796,1.161639,RAMoon/rad,DecMoon/rad,el,eb) + longecl_half=nint(rad*el/2.0) + if(longecl_half.lt.1 .or. longecl_half.gt.180) longecl_half=180 + t144=nt144(longecl_half) + tsky=(t144-2.7)*(144.0d6/freq8)**2.6 + 2.7 !Tsky for obs freq + + xdop(NStation)=doppler + if(NStation.eq.2) then + HisGrid=MyGrid + go to 900 + endif + + doppler00=2.0*xdop(1) + doppler=xdop(1)+xdop(2) +! if(mode.eq.3) doppler=2.0*xdop(1) + dBMoon=-40.0*log10(dist/356903.) + sd=16.23*370152.0/dist + +! if(NStation.eq.1 .and. MoonDX.ne.0 .and. +! + (mode.eq.2 .or. mode.eq.5)) then + if(NStation.eq.1 .and. MoonDX.ne.0) then + poloffset=mod(poloffset2-poloffset1+720.0,180.0) + if(poloffset.gt.90.0) poloffset=poloffset-180.0 + x1=abs(cos(2*poloffset/rad)) + if(x1.lt.0.056234) x1=0.056234 + xnr=-20.0*log10(x1) + if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'R') xnr=0 + endif + + tr=80.0 !Good preamp + tskymin=13.0*(408.0d6/freq8)**2.6 !Cold sky temperature + tsysmin=tskymin+tr + tsys=tsky+tr + dgrd=-10.0*log10(tsys/tsysmin) + dbMoon +900 AzMoon0=Azmoon + ElMoon0=Elmoon + ntsky=nint(tsky) + +! auxHA = 15.0*(LST-auxra) !HA in degrees +! pi=3.14159265 +! pio2=0.5*pi +! call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0, +! + auxdec/rad,azaux,elaux) +! AzAux=azaux*rad +! ElAux=ElAux*rad + + return +end subroutine astro diff --git a/wsjtx_lib/lib/astro0.f90 b/wsjtx_lib/lib/astro0.f90 new file mode 100644 index 0000000..d852fbf --- /dev/null +++ b/wsjtx_lib/lib/astro0.f90 @@ -0,0 +1,83 @@ +subroutine astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, & + AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, & + dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, & + width1,width2,xlst8,techo8) + + parameter (DEGS=57.2957795130823d0) + character*6 mygrid,hisgrid + real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8 + real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0,dt + real*8 sd8,poloffset8,width1,width2,xlst8 + real*8 uth8,techo8,freq8 + real*8 xl,b + common/librcom/xl(2),b(2) + common/echocom2/fspread_self,fspread_dx + data uth8z/0.d0/ + save + + uth=uth8 + call astro(nyear,month,nday,uth,freq8,hisgrid,2,1, & + AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, & + dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, & + day,xlon2,xlat2,xlst,techo) + AzMoonB8=AzMoon + ElMoonB8=ElMoon + xl2=xl(1) + xl2a=xl(2) + b2=b(1) + b2a=b(2) + call astro(nyear,month,nday,uth,freq8,mygrid,1,1, & + AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, & + dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, & + day,xlon1,xlat1,xlst,techo) + xl1=xl(1) + xl1a=xl(2) + b1=b(1) + b1a=b(2) + techo8=techo + + fghz=1.d-9*freq8 + dldt1=DEGS*(xl1a-xl1) + dbdt1=DEGS*(b1a-b1) + dldt2=DEGS*(xl2a-xl2) + dbdt2=DEGS*(b2a-b2) + rate1=2.0*sqrt(dldt1**2 + dbdt1**2) + width1=0.5*6741*fghz*rate1 + rate2=sqrt((dldt1+dldt2)**2 + (dbdt1+dbdt2)**2) + width2=0.5*6741*fghz*rate2 + if(hisgrid(1:4).eq.' ') width2=width1 !No hisgrid, use self width + fspread_self=width1 !Save for avecho() + fspread_dx=width2 !Save for avecho() + + AzSun8=AzSun + ElSun8=ElSun + AzMoon8=AzMoon + ElMoon8=ElMoon + dbMoon8=dbMoon + RAMoon8=RAMoon/15.0 + DecMoon8=DecMoon + HA8=HA + xlst8=xlst + Dgrd8=Dgrd + sd8=sd + poloffset8=poloffset + xnr8=xnr + ndop=nint(doppler) + ndop00=nint(doppler00) + + if(uth8z.eq.0.d0) then + uth8z=uth8-1.d0/3600.d0 + dopplerz=doppler + doppler00z=doppler00 + endif + + dt=60.0*(uth8-uth8z) + if(dt.le.0) dt=1.d0/60.d0 + dfdt=(doppler-dopplerz)/dt + dfdt0=(doppler00-doppler00z)/dt + uth8z=uth8 + dopplerz=doppler + doppler00z=doppler00 + + return +end subroutine astro0 diff --git a/wsjtx_lib/lib/astrosub.f90 b/wsjtx_lib/lib/astrosub.f90 new file mode 100644 index 0000000..e190fac --- /dev/null +++ b/wsjtx_lib/lib/astrosub.f90 @@ -0,0 +1,98 @@ +module astro_module + implicit none + + private + public :: astrosub + + logical :: initialized = .false. + integer :: azel_extra_lines = 0 + +contains + + subroutine astrosub(nyear,month,nday,uth8,freq8,mygrid_cp, & + hisgrid_cp,AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8, & + ntsky,ndop,ndop00,RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8,techo8,width1, & + width2,bTx,AzElFileName_cp,jpleph_file_name_cp) & + bind (C, name="astrosub") + + use :: types, only: dp + use :: C_interface_module, only: C_int, C_double, C_bool, C_ptr, C_string_value, assignment(=) + + integer(C_int), intent(in), value :: nyear, month, nday + real(C_double), intent(in), value :: uth8, freq8 + real(C_double), intent(out) :: AzSun8, ElSun8, AzMoon8, ElMoon8, AzMoonB8, & + ElMoonB8, Ramoon8, DecMoon8, Dgrd8, poloffset8, xnr8, techo8, width1, & + width2 + integer(C_int), intent(out) :: ntsky, ndop, ndop00 + logical(C_bool), intent(in), value :: bTx + type(C_ptr), value, intent(in) :: mygrid_cp, hisgrid_cp, AzElFileName_cp, & + jpleph_file_name_cp + + character(len=6) :: mygrid, hisgrid + character(len=:), allocatable :: AzElFileName + character(len=1) :: c1 + character(len=32) :: envvar + integer :: ih, im, imin, is, isec, nfreq, env_status + real(dp) :: AzAux, ElAux, dbMoon8, dfdt, dfdt0, doppler, doppler00, HA8, sd8, xlst8 + character*256 jpleph_file_name + common/jplcom/jpleph_file_name + + if (.not.initialized) then + call get_environment_variable ('WSJT_AZEL_EXTRA_LINES', envvar, status=env_status) + if (env_status.eq.0) read (envvar, *, iostat=env_status) azel_extra_lines + initialized = .true. + end if + + mygrid = mygrid_cp + hisgrid = hisgrid_cp + AzElFileName = C_string_value (AzElFileName_cp) + jpleph_file_name = jpleph_file_name_cp + + call astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, & + AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, & + dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, & + width1,width2,xlst8,techo8) + + if (len_trim(AzElFileName) .eq. 0) go to 999 + if(len(trim(hisgrid)).eq.0) then !If DX grid is blank, set these to zero: + AzMoonB8=0 + ElMoonB8=0 + ndop=0 + width2=0 + endif + imin=60*uth8 + isec=3600*uth8 + ih=uth8 + im=mod(imin,60) + is=mod(isec,60) + open(15,file=AzElFileName,status='unknown',err=900) + c1='R' + if(bTx) then + c1='T' + endif + AzAux=0. + ElAux=0. + nfreq=freq8/1000000 + doppler=ndop + doppler00=ndop00 + write(15,1010,err=10) ih,im,is,AzMoon8,ElMoon8, & + ih,im,is,AzSun8,ElSun8, & + ih,im,is,AzAux,ElAux, & + nfreq,doppler,dfdt,doppler00,dfdt0,c1 + if (azel_extra_lines.ge.1) write(15, 1020, err=10) poloffset8, & + xnr8,Dgrd8,width1,width2 +1010 format( & + i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Moon'/ & + i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Sun'/ & + i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Source'/ & + i5,',',f8.1,',',f8.2,',',f8.1,',',f8.2,',Doppler, ',a1) +1020 format(f8.1,',',f8.1,',',f8.1,',',f8.1,',',f8.1,',Pol') +10 close(15) + go to 999 + +900 print*,'Error opening azel.dat' + +999 return + end subroutine astrosub + +end module astro_module diff --git a/wsjtx_lib/lib/avecho.f90 b/wsjtx_lib/lib/avecho.f90 new file mode 100644 index 0000000..90e828d --- /dev/null +++ b/wsjtx_lib/lib/avecho.f90 @@ -0,0 +1,120 @@ +subroutine avecho(id2,ndop,nfrit,nauto,navg,nqual,f1,xlevel,snrdb, & + db_err,dfreq,width,bDiskData) + + integer TXLENGTH + parameter (TXLENGTH=27648) !27*1024 + parameter (NFFT=32768,NH=NFFT/2) + parameter (NZ=4096) + integer*2 id2(34560) !Buffer for Rx data + real sa(NZ) !Avg spectrum relative to initial Doppler echo freq + real sb(NZ) !Avg spectrum with Dither and changing Doppler removed + real, dimension (:,:), allocatable :: sax + real, dimension (:,:), allocatable :: sbx + integer nsum !Number of integrations + real dop0 !Doppler shift for initial integration (Hz) + real dop !Doppler shift for current integration (Hz) + real s(8192) + real x(NFFT) + integer ipkv(1) + logical ex + logical*1 bDiskData + complex c(0:NH) + equivalence (x,c),(ipk,ipkv) + common/echocom/nclearave,nsum,blue(NZ),red(NZ) + common/echocom2/fspread_self,fspread_dx + data navg0/-1/ + save dop0,navg0,sax,sbx + + if(navg.ne.navg0) then + if(allocated(sax)) deallocate(sax) + if(allocated(sbx)) deallocate(sbx) + allocate(sax(1:navg,1:NZ)) + allocate(sbx(1:navg,1:NZ)) + nsum=0 + navg0=navg + endif + + fspread=fspread_dx !### Use the predicted Doppler spread ### + if(bDiskData) fspread=width + if(nauto.eq.1) fspread=fspread_self + inquire(file='fspread.txt',exist=ex) + if(ex) then + open(39,file='fspread.txt',status='old') + read(39,*) fspread + close(39) + endif + fspread=min(max(0.04,fspread),700.0) + width=fspread + dop=ndop + sq=0. + do i=1,TXLENGTH + x(i)=id2(i) + sq=sq + x(i)*x(i) + enddo + xlevel=10.0*log10(sq/TXLENGTH) + + if(nclearave.ne.0) nsum=0 + if(nsum.eq.0) then + dop0=dop !Remember the initial Doppler + sax=0. !Clear the average arrays + sbx=0. + endif + + x(TXLENGTH+1:)=0. + x=x/TXLENGTH + call four2a(x,NFFT,1,-1,0) + df=12000.0/NFFT + do i=1,8192 !Get spectrum 0 - 3 kHz + s(i)=real(c(i))**2 + aimag(c(i))**2 + enddo + + fnominal=1500.0 !Nominal audio frequency w/o doppler or dither + ia=nint((fnominal+dop0-nfrit)/df) + ib=nint((f1+dop-nfrit)/df) + if(ia.lt.2048 .or. ib.lt.2048 .or. ia.gt.6144 .or. ib.gt.6144) then + snrdb=0. + db_err=0. + dfreq=0. + go to 900 + endif + + nsum=nsum+1 + j=mod(nsum-1,navg)+1 + do i=1,NZ + sax(j,i)=s(ia+i-2048) !Center at initial doppler freq + sbx(j,i)=s(ib+i-2048) !Center at expected echo freq + sa(i)=sum(sax(1:navg,i)) + sb(i)=sum(sbx(1:navg,i)) + enddo + + call echo_snr(sa,sb,fspread,blue,red,snrdb,db_err,dfreq,snr_detect) + nqual=snr_detect-2 + if(nqual.lt.0) nqual=0 + if(nqual.gt.10) nqual=10 + +! Scale for plotting + redmax=maxval(red) + fac=10.0/max(redmax,10.0) + blue=fac*blue + red=fac*red + nsmo=max(0.0,0.25*width/df) + do i=1,nsmo + call smo121(red,NZ) + call smo121(blue,NZ) + enddo + + ia=50.0/df + ib=250.0/df + call pctile(red(ia:ib),ib-ia+1,50,bred1) + call pctile(blue(ia:ib),ib-ia+1,50,bblue1) + ia=1250.0/df + ib=1450.0/df + call pctile(red(ia:ib),ib-ia+1,50,bred2) + call pctile(blue(ia:ib),ib-ia+1,50,bblue2) + + red=red-0.5*(bred1+bred2) + blue=blue-0.5*(bblue1+bblue2) + +900 call sleep_msec(10) !Avoid the "blue Decode button" syndrome + return +end subroutine avecho diff --git a/wsjtx_lib/lib/averms.f90 b/wsjtx_lib/lib/averms.f90 new file mode 100644 index 0000000..a037c27 --- /dev/null +++ b/wsjtx_lib/lib/averms.f90 @@ -0,0 +1,20 @@ +subroutine averms(x,n,nskip,ave,rms) + real x(n) + integer ipk(1) + + ns=0 + s=0. + sq=0. + ipk=maxloc(x) + do i=1,n + if((nskip.lt.0) .or. (abs(i-ipk(1)).gt.nskip)) then + s=s + x(i) + sq=sq + x(i)**2 + ns=ns+1 + endif + enddo + ave=s/ns + rms=sqrt(sq/ns - ave*ave) + + return +end subroutine averms diff --git a/wsjtx_lib/lib/avg4.f90 b/wsjtx_lib/lib/avg4.f90 new file mode 100644 index 0000000..fc37ec0 --- /dev/null +++ b/wsjtx_lib/lib/avg4.f90 @@ -0,0 +1,2 @@ + ! The contents of this file have been migrated to lib/jt4_decode.f90 + diff --git a/wsjtx_lib/lib/azdist.f90 b/wsjtx_lib/lib/azdist.f90 new file mode 100644 index 0000000..9d6546e --- /dev/null +++ b/wsjtx_lib/lib/azdist.f90 @@ -0,0 +1,124 @@ +subroutine azdist(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter) + + character(len=*) :: MyGrid,HisGrid + character*6 mygrid0,hisgrid0 + real*8 utch,utch0 + logical HotABetter,IamEast + real eltab(22),daztab(22) + data eltab/18.,15.,13.,11.,9.,8.,7.,6.,5.3,4.7,4.,3.3,2.7, & + 2.,1.5,1.,0.8,0.6,0.4,0.2,0.0,0.0/ + data daztab/21.,18.,16.,15.,14.,13.,12.,11.,10.7,10.3,10., & + 10.,10.,10.,10.,10.,10.,9.,9.,9.,8.,8./ + data mygrid0/" "/,hisgrid0/" "/,utch0/-999.d0/ + save + + if(MyGrid.eq.HisGrid) then + naz=0 + nel=0 + ndmiles=0 + ndkm=0 + nhotaz=0 + nhotabetter=1 + go to 999 + endif + + if(mygrid.eq.mygrid0 .and. hisgrid.eq.hisgrid0 .and. & + abs(utch-utch0).lt.0.1666667d0) go to 900 + utch0=utch + mygrid0=mygrid + hisgrid0=hisgrid + utchours=utch + + if(MyGrid(5:5).eq.' ') MyGrid(5:5)='m' + if(MyGrid(6:6).eq.' ') MyGrid(6:6)='m' + if(HisGrid(5:5).eq.' ') HisGrid(5:5)='m' + if(HisGrid(6:6).eq.' ') HisGrid(6:6)='m' + + if(MyGrid.eq.HisGrid) then + Az=0. + Dmiles=0. + Dkm=0.0 + El=0. + HotA=0. + HotB=0. + HotABetter=.true. + go to 900 + endif + call grid2deg(MyGrid,dlong1,dlat1) + call grid2deg(HisGrid,dlong2,dlat2) + eps=1.e-6 + Az=0. + Dmiles=0. + Dkm=0.0 + El=0. + HotA=0. + HotB=0. + HotABetter=.true. + if(abs(dlat1-dlat2).lt.eps .and. abs(dlong1-dlong2).lt.eps) go to 900 + + difflong=mod(dlong1-dlong2+720.0,360.0) + if(abs(dlat1+dlat2).lt.eps .and. abs(difflong-180.0).lt.eps) then +! Antipodes + Dkm=20400 + go to 900 + endif + + call geodist(dlat1,dlong1,dlat2,dlong2,Az,Baz,Dkm) + + ndkm=Dkm/100 + j=ndkm-4 + if(j.lt.1) j=1 + if(j.gt.21)j=21 + if(Dkm.lt.500.0) then + El=18.0 + else + u=(Dkm-100.0*ndkm)/100.0 + El=(1.0-u)*eltab(j) + u*eltab(j+1) + endif + + daz=daztab(j) + u * (daztab(j+1)-daztab(j)) + Dmiles=Dkm/1.609344 + + tmid=mod(UTChours-0.5*(dlong1+dlong2)/15.0+48.0,24.0) + IamEast=.false. + if(dlong1.lt.dlong2) IamEast=.true. + if(dlong1.eq.dlong2 .and. dlat1.gt.dlat2) IamEast=.false. + azEast=baz + if(IamEast) azEast=az + if((azEast.ge.45.0 .and. azEast.lt.135.0) .or. & + (azEast.ge.225.0 .and. azEast.lt.315.0)) then +! The path will be taken as "east-west". + HotABetter=.true. + if(abs(tmid-6.0).lt.6.0) HotABetter=.false. + if((dlat1+dlat2)/2.0 .lt. 0.0) HotABetter=.not.HotABetter + else +! The path will be taken as "north-south". + HotABetter=.false. + if(abs(tmid-12.0).lt.6.0) HotABetter=.true. + endif + if(IamEast) then + HotA = Az - daz + HotB = Az + daz + else + HotA = Az + daz + HotB = Az - daz + endif + if(HotA.lt.0.0) HotA=HotA+360.0 + if(HotA.gt.360.0) HotA=HotA-360.0 + if(HotB.lt.0.0) HotB=HotB+360.0 + if(HotB.gt.360.0) HotB=HotB-360.0 + +900 continue + naz=nint(Az) + nel=nint(el) + nDmiles=nint(Dmiles) + nDkm=nint(Dkm) + nHotAz=nint(HotB) + nHotABetter=0 + if(HotABetter) then + nHotAz=nint(HotA) + nHotABetter=1 + endif + +999 return +end subroutine azdist diff --git a/wsjtx_lib/lib/baddata.f90 b/wsjtx_lib/lib/baddata.f90 new file mode 100644 index 0000000..7353ff7 --- /dev/null +++ b/wsjtx_lib/lib/baddata.f90 @@ -0,0 +1,29 @@ +logical function baddata(id2,nz) + + integer*2 id2(nz) + + nadd=1200 + j=0 + smin=1.e30 + smax=-smin + iz=49*12000/nadd + do i=1,iz + sq=0. + do n=1,nadd + j=j+1 + x=id2(j) + sq=sq + x*x + enddo + rms=sqrt(sq/nadd) + if(i.gt.6) then + smin=min(smin,rms) + smax=max(smax,rms) + endif + enddo + + sratio=smax/(smin+1.e-30) + baddata=.false. + if(sratio.gt.1.e30) baddata=.true. + + return +end function baddata diff --git a/wsjtx_lib/lib/badmsg.f90 b/wsjtx_lib/lib/badmsg.f90 new file mode 100644 index 0000000..007da8a --- /dev/null +++ b/wsjtx_lib/lib/badmsg.f90 @@ -0,0 +1,46 @@ +subroutine badmsg(irc,dat,nc1,nc2,ng2) + +! Get rid of a few QRA64 false decodes that cannot be correct messages. + + integer dat(12) !Decoded message (as 12 integers) + + ic1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ & + ishft(dat(4),4) + iand(ishft(dat(5),-2),15) + +! Test for "......" or "CQ 000" + if(ic1.eq.262177560 .or. ic1.eq.262177563) then + irc=-1 + return + endif + + ic2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) + & + ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) + & + iand(ishft(dat(10),-4),3) + + ig=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12) + +! Test for blank, -01 to -30, R-01 to R-30, RO, RRR, 73 + if(ig.ge.32401 .and. ig.le.32464) return + + if(ig.ge.14220 .and. ig.le.14229) return !-41 to -50 + if(ig.ge.14040 .and. ig.le.14049) return !-31 to -40 + + if(ig.ge.13320 .and. ig.le.13329) return !+00 to +09 + if(ig.ge.13140 .and. ig.le.13149) return !+10 to +19 + if(ig.ge.12960 .and. ig.le.12969) return !+20 to +29 + if(ig.ge.12780 .and. ig.le.12789) return !+30 to +39 + if(ig.ge.12600 .and. ig.le.12609) return !+40 to +49 + + if(ig.ge.12420 .and. ig.le.12429) return !R-41 to R-50 + if(ig.ge.12240 .and. ig.le.12249) return !R-31 to R-40 + + if(ig.ge.11520 .and. ig.le.11529) return !R+00 to R+09 + if(ig.ge.11340 .and. ig.le.11349) return !R+10 to R+19 + if(ig.ge.11160 .and. ig.le.11169) return !R+20 to R+29 + if(ig.ge.10980 .and. ig.le.10989) return !R+30 to R+39 + if(ig.ge.10800 .and. ig.le.10809) return !R+40 to R+49 + + if(ic1.eq.nc1 .and. ic2.eq.nc2 .and. ng2.ne.32401 .and. ig.ne.ng2) irc=-1 + + return +end subroutine badmsg diff --git a/wsjtx_lib/lib/blanker.f90 b/wsjtx_lib/lib/blanker.f90 new file mode 100644 index 0000000..fe43931 --- /dev/null +++ b/wsjtx_lib/lib/blanker.f90 @@ -0,0 +1,52 @@ +subroutine blanker(iwave,nz,ndropmax,npct,c_bigfft) + + integer*2 iwave(nz) + complex c_bigfft(0:nz/2) + integer hist(0:32768) + real fblank !Fraction of points to be blanked + + fblank=0.01*npct + hist=0 + do i=1,nz +! ### NB: if iwave(i)=-32768, abs(iwave(i))=-32768 ### + if(iwave(i).eq.-32768) iwave(i)=-32767 + n=abs(iwave(i)) + hist(n)=hist(n)+1 + enddo + n=0 + do i=32768,0,-1 + n=n+hist(i) + if(n.ge.nint(nz*fblank/ndropmax)) exit + enddo + nthresh=i + ndrop=0 + ndropped=0 + + xx=0. + do i=1,nz + i0=iwave(i) + if(ndrop.gt.0) then + i0=0 + ndropped=ndropped+1 + ndrop=ndrop-1 + endif + +! Start to apply blanking + if(abs(i0).gt.nthresh) then + i0=0 + ndropped=ndropped+1 + ndrop=ndropmax + endif + +! Now copy the data into c_bigfft + if(iand(i,1).eq.1) then + xx=i0 + else + yy=i0 + j=i/2 - 1 + c_bigfft(j)=cmplx(xx,yy) + endif + enddo + + return +end subroutine blanker diff --git a/wsjtx_lib/lib/bpdecode128_90.f90 b/wsjtx_lib/lib/bpdecode128_90.f90 new file mode 100644 index 0000000..9e018dc --- /dev/null +++ b/wsjtx_lib/lib/bpdecode128_90.f90 @@ -0,0 +1,117 @@ +subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter) +! +! A log-domain belief propagation 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) + real tov(4,N) + real toc(11,M) + real tanhtoc(11,M) + real zn(N) + real llr(N) + real Tmn + + include "ldpc_128_90_reordered_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 +! write(*,*) 'number of unsatisfied parity checks ',ncheck + 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 + + 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. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) 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:11,i)=tanh(-toc(1:11,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 bpdecode128_90 diff --git a/wsjtx_lib/lib/bpdecode128_90.f90.save b/wsjtx_lib/lib/bpdecode128_90.f90.save new file mode 100644 index 0000000..69537af --- /dev/null +++ b/wsjtx_lib/lib/bpdecode128_90.f90.save @@ -0,0 +1,116 @@ +subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter) +! +! A log-domain belief propagation 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(12,M) + integer Mn(4,N) + integer nrw(M),ncw(N) + integer synd(M) + real tov(4,N) + real toc(12,M) + real tanhtoc(12,M) + real zn(N) + real llr(N) + real Tmn + + include "ldpc_128_90_b_reordered_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 + + 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 + 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 + + 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. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) 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,4 ! 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:12,i)=tanh(-toc(1:12,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 + nharderror=-1 + return + +end subroutine bpdecode128_90 diff --git a/wsjtx_lib/lib/bpdecode144.f90 b/wsjtx_lib/lib/bpdecode144.f90 new file mode 100644 index 0000000..8cbf912 --- /dev/null +++ b/wsjtx_lib/lib/bpdecode144.f90 @@ -0,0 +1,348 @@ +subroutine pltanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.8 ) then + y=0.83*x + return + elseif( z.le. 1.6 ) then + y=isign*(0.322*z+0.4064) + return + elseif( z.le. 3.0 ) then + y=isign*(0.0524*z+0.8378) + return + elseif( z.lt. 7.0 ) then + y=isign*(0.0012*z+0.9914) + return + else + y=isign*0.9998 + return + endif +end subroutine pltanh + +subroutine platanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.664 ) then + y=x/0.83 + return + elseif( z.le. 0.9217 ) then + y=isign*(z-0.4064)/0.322 + return + elseif( z.le. 0.9951 ) then + y=isign*(z-0.8378)/0.0524 + return + elseif( z.le. 0.9998 ) then + y=isign*(z-0.9914)/0.0012 + return + else + y=isign*7.0 + return + endif +end subroutine platanh + +subroutine bpdecode144(llr,maxiterations,decoded,niterations) +! +! A log-domain belief propagation decoder for the msk144 code. +! The code is a regular (128,80) code with column weight 3 and row weight 8. +! k9an August, 2016 +! +integer, parameter:: N=128, K=80, M=N-K +integer*1 codeword(N),cw(N) +integer*1 colorder(N) +integer*1 decoded(K) +integer Nm(8,M) ! 8 bits per check +integer Mn(3,N) ! 3 checks per bit +integer synd(M) +real tov(3,N) ! single precision seems to be adequate in log-domain +real toc(8,M) +real tanhtoc(8,M) +real zn(N) +real llr(N) +real Tmn + +data colorder/0,1,2,3,4,5,6,7,8,9, & + 10,11,12,13,14,15,24,26,29,30, & + 32,43,44,47,60,77,79,97,101,111, & + 96,38,64,53,93,34,59,94,74,90, & + 108,123,85,57,70,25,69,62,48,49, & + 50,51,52,33,54,55,56,21,58,36, & + 16,61,23,63,20,65,66,67,68,46, & + 22,71,72,73,31,75,76,45,78,17, & + 80,81,82,83,84,42,86,87,88,89, & + 39,91,92,35,37,95,19,27,98,99, & + 100,28,102,103,104,105,106,107,40,109, & + 110,18,112,113,114,115,116,117,118,119, & + 120,121,122,41,124,125,126,127/ + +data Mn/ & + 1, 14, 38, & + 2, 4, 41, & + 3, 19, 39, & + 5, 29, 34, & + 6, 35, 40, & + 7, 20, 45, & + 8, 28, 48, & + 9, 22, 25, & + 10, 24, 36, & + 11, 12, 37, & + 13, 43, 44, & + 15, 18, 46, & + 16, 17, 47, & + 21, 32, 33, & + 23, 30, 31, & + 26, 27, 42, & + 1, 12, 46, & + 2, 36, 38, & + 3, 5, 10, & + 4, 9, 23, & + 6, 13, 39, & + 7, 15, 17, & + 8, 18, 27, & + 11, 33, 40, & + 14, 28, 44, & + 16, 29, 31, & + 19, 20, 22, & + 21, 30, 42, & + 24, 26, 47, & + 25, 37, 48, & + 32, 34, 45, & + 8, 35, 41, & + 12, 31, 43, & + 1, 19, 21, & + 2, 43, 45, & + 3, 4, 11, & + 5, 18, 33, & + 6, 25, 47, & + 7, 28, 30, & + 9, 14, 34, & + 10, 35, 42, & + 13, 15, 22, & + 16, 37, 38, & + 17, 41, 44, & + 20, 24, 29, & + 18, 23, 39, & + 12, 26, 32, & + 27, 38, 40, & + 15, 36, 48, & + 2, 30, 46, & + 1, 4, 13, & + 3, 28, 32, & + 5, 43, 47, & + 6, 34, 46, & + 7, 9, 40, & + 8, 11, 45, & + 10, 17, 23, & + 14, 31, 35, & + 16, 22, 42, & + 19, 37, 44, & + 20, 33, 48, & + 21, 24, 41, & + 25, 27, 29, & + 26, 39, 48, & + 19, 31, 36, & + 1, 5, 7, & + 2, 29, 39, & + 3, 16, 46, & + 4, 26, 37, & + 6, 28, 45, & + 8, 22, 33, & + 9, 21, 43, & + 10, 25, 38, & + 11, 14, 24, & + 12, 17, 40, & + 13, 27, 30, & + 15, 32, 35, & + 18, 44, 47, & + 20, 23, 36, & + 34, 41, 42, & + 1, 32, 48, & + 2, 3, 33, & + 4, 29, 42, & + 5, 14, 37, & + 6, 7, 36, & + 8, 9, 39, & + 10, 13, 19, & + 11, 18, 30, & + 12, 16, 20, & + 15, 29, 44, & + 17, 34, 38, & + 6, 21, 22, & + 23, 32, 40, & + 24, 27, 46, & + 25, 41, 45, & + 7, 26, 43, & + 28, 31, 47, & + 20, 35, 38, & + 1, 33, 41, & + 2, 42, 44, & + 3, 23, 48, & + 4, 31, 45, & + 5, 8, 30, & + 9, 16, 36, & + 10, 40, 47, & + 11, 17, 46, & + 12, 21, 34, & + 13, 24, 28, & + 14, 18, 43, & + 15, 25, 26, & + 19, 27, 35, & + 22, 37, 39, & + 1, 16, 18, & + 2, 6, 20, & + 3, 30, 43, & + 4, 28, 33, & + 5, 22, 23, & + 7, 39, 42, & + 8, 12, 38, & + 9, 35, 46, & + 10, 27, 32, & + 11, 15, 34, & + 13, 36, 37, & + 14, 41, 47, & + 17, 21, 25, & + 19, 29, 45, & + 24, 31, 48, & + 26, 40, 44/ + +data Nm/ & + 1, 17, 34, 51, 66, 81, 99, 113, & + 2, 18, 35, 50, 67, 82, 100, 114, & + 3, 19, 36, 52, 68, 82, 101, 115, & + 2, 20, 36, 51, 69, 83, 102, 116, & + 4, 19, 37, 53, 66, 84, 103, 117, & + 5, 21, 38, 54, 70, 85, 92, 114, & + 6, 22, 39, 55, 66, 85, 96, 118, & + 7, 23, 32, 56, 71, 86, 103, 119, & + 8, 20, 40, 55, 72, 86, 104, 120, & + 9, 19, 41, 57, 73, 87, 105, 121, & + 10, 24, 36, 56, 74, 88, 106, 122, & + 10, 17, 33, 47, 75, 89, 107, 119, & + 11, 21, 42, 51, 76, 87, 108, 123, & + 1, 25, 40, 58, 74, 84, 109, 124, & + 12, 22, 42, 49, 77, 90, 110, 122, & + 13, 26, 43, 59, 68, 89, 104, 113, & + 13, 22, 44, 57, 75, 91, 106, 125, & + 12, 23, 37, 46, 78, 88, 109, 113, & + 3, 27, 34, 60, 65, 87, 111, 126, & + 6, 27, 45, 61, 79, 89, 98, 114, & + 14, 28, 34, 62, 72, 92, 107, 125, & + 8, 27, 42, 59, 71, 92, 112, 117, & + 15, 20, 46, 57, 79, 93, 101, 117, & + 9, 29, 45, 62, 74, 94, 108, 127, & + 8, 30, 38, 63, 73, 95, 110, 125, & + 16, 29, 47, 64, 69, 96, 110, 128, & + 16, 23, 48, 63, 76, 94, 111, 121, & + 7, 25, 39, 52, 70, 97, 108, 116, & + 4, 26, 45, 63, 67, 83, 90, 126, & + 15, 28, 39, 50, 76, 88, 103, 115, & + 15, 26, 33, 58, 65, 97, 102, 127, & + 14, 31, 47, 52, 77, 81, 93, 121, & + 14, 24, 37, 61, 71, 82, 99, 116, & + 4, 31, 40, 54, 80, 91, 107, 122, & + 5, 32, 41, 58, 77, 98, 111, 120, & + 9, 18, 49, 65, 79, 85, 104, 123, & + 10, 30, 43, 60, 69, 84, 112, 123, & + 1, 18, 43, 48, 73, 91, 98, 119, & + 3, 21, 46, 64, 67, 86, 112, 118, & + 5, 24, 48, 55, 75, 93, 105, 128, & + 2, 32, 44, 62, 80, 95, 99, 124, & + 16, 28, 41, 59, 80, 83, 100, 118, & + 11, 33, 35, 53, 72, 96, 109, 115, & + 11, 25, 44, 60, 78, 90, 100, 128, & + 6, 31, 35, 56, 70, 95, 102, 126, & + 12, 17, 50, 54, 68, 94, 106, 120, & + 13, 29, 38, 53, 78, 97, 105, 124, & + 7, 30, 49, 61, 64, 81, 101, 127/ + +nrw=8 +ncw=3 + +toc=0 +tov=0 +tanhtoc=0 + +! initial messages to checks +do j=1,M + do i=1,nrw + toc(i,j)=llr((Nm(i,j))) + enddo +enddo + +ncnt=0 + +do iter=0,maxiterations + +! Update bit log likelihood ratios + do i=1,N + zn(i)=llr(i)+sum(tov(1:ncw,i)) + enddo + +! Check to see if we have a codeword + cw=0 + where( zn .gt. 0. ) cw=1 + ncheck=0 + do i=1,M + synd(i)=sum(cw(Nm(:,i))) + if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 + enddo + + if( ncheck .eq. 0 ) then ! we have a codeword + 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 + 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 ! Mn(3,128) + 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:nrw,i)=tanh(-toc(1:nrw,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(:,ichk),mask=Nm(:,ichk).ne.j) + call platanh(-Tmn,y) + tov(i,j)=2*y + enddo + enddo + +enddo +niterations=-1 +end subroutine bpdecode144 diff --git a/wsjtx_lib/lib/bpdecode40.f90 b/wsjtx_lib/lib/bpdecode40.f90 new file mode 100644 index 0000000..3a35bab --- /dev/null +++ b/wsjtx_lib/lib/bpdecode40.f90 @@ -0,0 +1,148 @@ +subroutine bpdecode40(llr,maxiterations,decoded,niterations) +! +! A log-domain belief propagation decoder for the msk40 code. +! The code is a regular (32,16) code with column weight 3, row weights 5,6,7. +! k9an August, 2016 +! +integer, parameter:: N=32, K=16, M=N-K +integer*1 codeword(N),cw(N) +integer*1 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/ & + 4, 1, 2, 3, 0, 8, 6, 10, & + 13, 28, 20, 23, 17, 15, 27, 25, & + 16, 12, 18, 19, 7, 21, 22, 11, & + 24, 5, 26, 14, 9, 29, 30, 31/ + +data Mn/ & + 1, 6, 13, & + 2, 3, 14, & + 4, 8, 15, & + 5, 11, 12, & + 7, 10, 16, & + 6, 9, 15, & + 1, 11, 16, & + 2, 4, 5, & + 3, 7, 9, & + 8, 10, 12, & + 8, 13, 14, & + 1, 4, 12, & + 2, 6, 10, & + 3, 11, 15, & + 5, 9, 14, & + 7, 13, 15, & + 12, 14, 16, & + 1, 2, 8, & + 3, 5, 6, & + 4, 9, 11, & + 1, 7, 14, & + 5, 10, 13, & + 3, 4, 16, & + 2, 15, 16, & + 6, 7, 12, & + 7, 8, 11, & + 1, 9, 10, & + 2, 11, 13, & + 3, 12, 13, & + 4, 6, 14, & + 1, 5, 15, & + 8, 9, 16/ + +data Nm/ & +1, 7, 12, 18, 21, 27, 31, & +2, 8, 13, 18, 24, 28, 0, & +2, 9, 14, 19, 23, 29, 0, & +3, 8, 12, 20, 23, 30, 0, & +4, 8, 15, 19, 22, 31, 0, & +1, 6, 13, 19, 25, 30, 0, & +5, 9, 16, 21, 25, 26, 0, & +3, 10, 11, 18, 26, 32, 0, & +6, 9, 15, 20, 27, 32, 0,& +5, 10, 13, 22, 27, 0, 0, & +4, 7, 14, 20, 26, 28, 0, & +4, 10, 12, 17, 25, 29, 0, & +1, 11, 16, 22, 28, 29, 0, & +2, 11, 15, 17, 21, 30, 0, & +3, 6, 14, 16, 24, 31, 0, & +5, 7, 17, 23, 24, 32, 0/ + +data nrw/7,6,6,6,6,6,6,6,6,5,6,6,6,6,6,6/ + +ncw=3 + +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 + +do iter=0,maxiterations + +! Update bit log likelihood ratios (tov=0 in iteration 0). + do i=1,N + zn(i)=llr(i)+sum(tov(1:ncw,i)) + 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 + enddo + + 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 + +! 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) + tov(i,j)=2*y + enddo + enddo + +enddo +niterations=-1 +return +end subroutine bpdecode40 diff --git a/wsjtx_lib/lib/calibrate.f90 b/wsjtx_lib/lib/calibrate.f90 new file mode 100644 index 0000000..76e70f2 --- /dev/null +++ b/wsjtx_lib/lib/calibrate.f90 @@ -0,0 +1,96 @@ +subroutine calibrate(data_dir,iz,a,b,rms,sigmaa,sigmab,irc) + +! Average groups of frequency-calibration measurements, then fit a +! straight line for slope and intercept. + + parameter (NZ=1000) + implicit real*8 (a-h,o-z) + character*(*) data_dir + character*256 infile,outfile + character*8 cutc,cutc1 + character*1 c1 + real*8 fd(NZ),deltaf(NZ),r(NZ),rmsd(NZ) + integer nn(NZ) + + infile=trim(data_dir)//'/'//'fmt.all' + outfile=trim(data_dir)//'/'//'fcal2.out' + + open(10,file=trim(infile),status='old',err=996) + open(12,file=trim(outfile),status='unknown',err=997) + + nkhz0=0 + sum=0.d0 + sumsq=0.d0 + n=0 + j=0 + do i=1,99999 + read(10,*,end=10,err=995) cutc,nkHz,ncal,noffset,faudio,df,dblevel,snr + if((nkHz.ne.nkHz0) .and. i.ne.1) then + ave=sum/n + rms=0.d0 + if(n.gt.1) then + rms=sqrt(abs(sumsq - sum*sum/n)/(n-1.d0)) + endif + fMHz=0.001d0*nkHz0 + j=j+1 + fd(j)=fMHz + deltaf(j)=ave + r(j)=0.d0 + rmsd(j)=rms + nn(j)=n + sum=0.d0 + sumsq=0.d0 + n=0 + endif + dial_error=faudio-noffset + sum=sum + dial_error + sumsq=sumsq + dial_error**2 + n=n+1 + if(n.eq.1) then + cutc1=cutc + ncal0=ncal + endif + nkHz0=nkHz + enddo + +10 ave=sum/n + rms=0.d0 + if(n.gt.0) then + rms=sqrt((sumsq - sum*sum/n)/(n-1.d0)) + endif + fMHz=0.001d0*nkHz + j=j+1 + fd(j)=fMHz + deltaf(j)=ave + r(j)=0.d0 + rmsd(j)=rms + nn(j)=n + iz=j + if(iz.lt.2) go to 998 + + call fitcal(fd,deltaf,r,iz,a,b,sigmaa,sigmab,rms) + + write(12,1002) +1002 format(' Freq DF Meas Freq N rms Resid'/ & + ' (MHz) (Hz) (MHz) (Hz) (Hz)'/ & + '----------------------------------------------------') + irc=0 + do i=1,iz + fm=fd(i) + 1.d-6*deltaf(i) + c1=' ' + if(rmsd(i).gt.1.0d0) c1='*' + write(12,1012) fd(i),deltaf(i),fm,nn(i),rmsd(i),r(i),c1 +1012 format(f8.3,f9.3,f14.9,i4,f7.2,f9.3,1x,a1) + enddo + go to 999 + +995 irc=-4; iz=i; go to 999 +996 irc=-1; go to 999 +997 irc=-2; go to 999 +998 irc=-3 +999 continue + close(10) + close(12) + + return +end subroutine calibrate diff --git a/wsjtx_lib/lib/ccf2.f90 b/wsjtx_lib/lib/ccf2.f90 new file mode 100644 index 0000000..8e1f6cf --- /dev/null +++ b/wsjtx_lib/lib/ccf2.f90 @@ -0,0 +1,49 @@ +subroutine ccf2(ss,nz,nflip,ccfbest,xlagpk) + +! parameter (LAGMIN=-86,LAGMAX=258) + parameter (LAGMIN=-112,LAGMAX=258) ! Look for DT from -3.6s to +5.0s + real ss(nz) + real ccf(-LAGMAX:LAGMAX) + integer npr(126) + +! The JT65 pseudo-random sync pattern: + data npr/ & + 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & + 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & + 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & + 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & + 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & + 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & + 1,1,1,1,1,1/ + save + + ccfbest=0. + lag1=LAGMIN + lag2=LAGMAX + do lag=lag1,lag2 + s0=0. + s1=0. + do i=1,126 + j=16*(i-1)+1 + lag + if(j.ge.1 .and. j.le.nz-8) then + x=ss(j) + if(npr(i).eq.0) then + s0=s0 + x + else + s1=s1 + x + endif + endif + enddo + ccf(lag)=nflip*(s1-s0) + if(ccf(lag).gt.ccfbest) then + ccfbest=ccf(lag) + lagpk=lag + xlagpk=lagpk + endif + enddo + if( lagpk.gt.-LAGMAX .and. lagpk.lt.LAGMAX) then + call peakup(ccf(lagpk-1),ccf(lagpk),ccf(lagpk+1),dx) + xlagpk=lagpk+dx + endif + return +end subroutine ccf2 diff --git a/wsjtx_lib/lib/ccf65.f90 b/wsjtx_lib/lib/ccf65.f90 new file mode 100644 index 0000000..6270aed --- /dev/null +++ b/wsjtx_lib/lib/ccf65.f90 @@ -0,0 +1,117 @@ +subroutine ccf65(ss,nhsym,ssmax,sync1,dt1,flipk,syncshort,snr2,dt2) + + parameter (NFFT=512,NH=NFFT/2) + real ss(322) !Input: half-symbol normalized powers + real s(NFFT) !CCF = ss*pr + complex cs(0:NH) !Complex FT of s + real s2(NFFT) !CCF = ss*pr2 + complex cs2(0:NH) !Complex FT of s2 + real pr(NFFT) !JT65 pseudo-random sync pattern + complex cpr(0:NH) !Complex FT of pr + real pr2(NFFT) !JT65 shorthand pattern + complex cpr2(0:NH) !Complex FT of pr2 + real tmp1(322) + real ccf(-11:54) + logical first + integer npr(126) + data first/.true./ + equivalence (s,cs),(pr,cpr),(s2,cs2),(pr2,cpr2) + save + +! The JT65 pseudo-random sync pattern: + data npr/ & + 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & + 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & + 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & + 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & + 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & + 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & + 1,1,1,1,1,1/ + + if(first) then +! Initialize pr, pr2; compute cpr, cpr2. + fac=1.0/NFFT + do i=1,NFFT + pr(i)=0. + pr2(i)=0. + k=2*mod((i-1)/8,2)-1 + if(i.le.NH) pr2(i)=fac*k + enddo + do i=1,126 + j=2*i + pr(j)=fac*(2*npr(i)-1) +! Not sure why, but it works significantly better without the following line: +! pr(j-1)=pr(j) + enddo + call four2a(cpr,NFFT,1,-1,0) + call four2a(cpr2,NFFT,1,-1,0) + first=.false. + endif + +! Look for JT65 sync pattern and shorthand square-wave pattern. + ccfbest=0. + ccfbest2=0. + do i=1,nhsym-1 + s(i)=min(ssmax,ss(i)+ss(i+1)) +! s(i)=ss(i)+ss(i+1) + enddo + + call pctile(s,nhsym-1,50,base) + s(1:nhsym-1)=s(1:nhsym-1)-base + s(nhsym:NFFT)=0. + call four2a(cs,NFFT,1,-1,0) !Real-to-complex FFT + do i=0,NH +! cs2(i)=cs(i)*conjg(cpr2(i)) !Mult by complex FFT of pr2 + cs(i)=cs(i)*conjg(cpr(i)) !Mult by complex FFT of pr + enddo + call four2a(cs,NFFT,1,1,-1) !Complex-to-real inv-FFT +! call four2a(cs2,NFFT,1,1,-1) !Complex-to-real inv-FFT + + do lag=-11,54 !Check for best JT65 sync + j=lag + if(j.lt.1) j=j+NFFT + ccf(lag)=s(j) +! if(abs(ccf(lag)).gt.ccfbest) then + if(ccf(lag).gt.ccfbest) then !No inverted sync for use at HF +! ccfbest=abs(ccf(lag)) + ccfbest=ccf(lag) + lagpk=lag + flipk=1.0 +! if(ccf(lag).lt.0.0) flipk=-1.0 + endif + enddo + +! do lag=-11,54 !Check for best shorthand +! ccf2=s2(lag+28) +! if(ccf2.gt.ccfbest2) then +! ccfbest2=ccf2 +! lagpk2=lag +! endif +! enddo + +! Find rms level on baseline of "ccfblue", for normalization. + sum=0. + do lag=-11,54 + if(abs(lag-lagpk).gt.1) sum=sum + ccf(lag) + enddo + base=sum/50.0 + sq=0. + do lag=-11,54 + if(abs(lag-lagpk).gt.1) sq=sq + (ccf(lag)-base)**2 + enddo + rms=sqrt(sq/49.0) + sync1=ccfbest/rms - 4.0 + dt1=lagpk*(2048.0/11025.0) - 2.5 + +! Find base level for normalizing snr2. + do i=1,nhsym + tmp1(i)=ss(i) + enddo + call pctile(tmp1,nhsym,40,base) + snr2=0.398107*ccfbest2/base !### empirical + syncshort=0.5*ccfbest2/rms - 4.0 !### better normalizer than rms? +! dt2=(2.5 + lagpk2*(2048.0/11025.0)) + dt2=0. + + return +end subroutine ccf65 diff --git a/wsjtx_lib/lib/char.h b/wsjtx_lib/lib/char.h new file mode 100644 index 0000000..cc477ec --- /dev/null +++ b/wsjtx_lib/lib/char.h @@ -0,0 +1,57 @@ +/* Include file to configure the RS codec for character symbols + * + * Copyright 2002, Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ +#define DTYPE unsigned char + +/* Reed-Solomon codec control block */ +struct rs { + int mm; /* Bits per symbol */ + int nn; /* Symbols per block (= (1<= rs->nn) { + x -= rs->nn; + x = (x >> rs->mm) + (x & rs->nn); + } + return x; +} +#define MODNN(x) modnn(rs,x) + +#define MM (rs->mm) +#define NN (rs->nn) +#define ALPHA_TO (rs->alpha_to) +#define INDEX_OF (rs->index_of) +#define GENPOLY (rs->genpoly) +#define NROOTS (rs->nroots) +#define FCR (rs->fcr) +#define PRIM (rs->prim) +#define IPRIM (rs->iprim) +#define PAD (rs->pad) +#define A0 (NN) + +#define ENCODE_RS encode_rs_char +#define DECODE_RS decode_rs_char +#define INIT_RS init_rs_char +#define FREE_RS free_rs_char + +void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity); +int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras); +void *INIT_RS(int symsize,int gfpoly,int fcr, + int prim,int nroots,int pad); +void FREE_RS(void *p); + + + + + diff --git a/wsjtx_lib/lib/chkcall.f90 b/wsjtx_lib/lib/chkcall.f90 new file mode 100644 index 0000000..92f42c6 --- /dev/null +++ b/wsjtx_lib/lib/chkcall.f90 @@ -0,0 +1,60 @@ +subroutine chkcall(w,bc,cok) + +! Check "w" to see if it could be a valid standard callsign or a valid +! compound callsign. +! Return base call "bc" and a logical "cok" indicator. + + character w*13 !A putative callsign + character bc*6 !Base call (tentative) + character c*1 + logical cok,isdigit,isletter + + isdigit(c)=(ichar(c).ge.ichar('0')) .and. (ichar(c).le.ichar('9')) + isletter(c)=(ichar(c).ge.ichar('A')) .and. (ichar(c).le.ichar('Z')) + + cok=.true. + bc=w(1:6) + n1=len_trim(w) + if(n1.gt.11) go to 100 + if(index(w,'.').ge.1) go to 100 + if(index(w,'+').ge.1) go to 100 + if(index(w,'-').ge.1) go to 100 + if(index(w,'?').ge.1) go to 100 + if(n1.gt.6 .and. index(w,'/').le.0) go to 100 + + i0=index(w,'/') + if(max(i0-1,n1-i0).gt.6) go to 100 !Base call must be < 7 characters + if(i0.ge.2 .and. i0.le.n1-1) then !Extract base call from compound call + if(i0-1.le.n1-i0) bc=w(i0+1:n1)//' ' + if(i0-1.gt.n1-i0) bc=w(1:i0-1)//' ' + endif + + nbc=len_trim(bc) + if(nbc.gt.6) go to 100 !Base call should have no more than 6 characters + +! One of first two characters (c1 or c2) must be a letter + if((.not.isletter(bc(1:1))) .and. (.not.isletter(bc(2:2)))) go to 100 +! Real calls don't start with Q, but we'll allow the placeholder +! callsign QU1RK to be considered a standard call: + if(bc(1:1).eq.'Q' .and. bc(1:5).ne.'QU1RK') go to 100 + +! Must have a digit in 2nd or 3rd position + i1=0 + if(isdigit(bc(2:2))) i1=2 + if(isdigit(bc(3:3))) i1=3 + if(i1.eq.0) go to 100 + +! Callsign must have a suffix of 1-3 letters + if(i1.eq.nbc) go to 100 + n=0 + do i=i1+1,nbc + j=ichar(bc(i:i)) + if(j.lt.ichar('A') .or. j.gt.ichar('Z')) go to 100 + n=n+1 + enddo + if(n.ge.1 .and. n.le.3) go to 200 + +100 cok=.false. + +200 return +end subroutine chkcall diff --git a/wsjtx_lib/lib/chkfft.f90 b/wsjtx_lib/lib/chkfft.f90 new file mode 100644 index 0000000..6eacc3a --- /dev/null +++ b/wsjtx_lib/lib/chkfft.f90 @@ -0,0 +1,164 @@ +program chkfft + +! Tests and times one-dimensional FFTs computed by four2a(). +! An all-Fortran version of four2a() is available, but the preferred +! version uses calls to the FFTW library. + + parameter (NMAX=8*1024*1024) !Maximum FFT length + complex a(NMAX),b(NMAX) + real ar(NMAX),br(NMAX) + real mflops + character infile*12,arg*8 + logical list + common/patience/npatience + equivalence (a,ar),(b,br) + + nargs=iargc() + if(nargs.ne.5) then + print*,'Usage: chkfft nr nw nc np' + print*,' nfft: length of FFT' + print*,' nfft=0: do lengths 2^n, n=2^4 to 2^23' + print*,' infile: name of file with nfft values, one per line' + print*,' nr: 0/1 to not read (or read) wisdom' + print*,' nw: 0/1 to not write (or write) wisdom' + print*,' nc: 0/1 for real or complex data' + print*,' np: 0-4 patience for finding best algorithm' + go to 999 + endif + + list=.false. + nfft=-1 + call getarg(1,infile) + open(10,file=infile,status='old',err=1) + list=.true. !A valid file name was provided + go to 2 +1 read(infile,*) nfft !Takje first argument to be nfft +2 call getarg(2,arg) + read(arg,*) nr + call getarg(3,arg) + read(arg,*) nw + call getarg(4,arg) + read(arg,*) ncomplex + call getarg(5,arg) + read(arg,*) npatience + + call sgran() + + if(list) write(*,1000) infile,nr,nw,ncomplex,npatience +1000 format(/'infile: ',a12,' nr:',i2,' nw',i2,' nc:',i2,' np:',i2/) + if(.not.list) write(*,1002) nfft,nr,nw,ncomplex,npatience +1002 format(/'nfft: ',i10,' nr:',i2,' nw',i2,' nc:',i2,' np:',i2/) + + open(12,file='chkfft.out',status='unknown') + open(13,file='fftwf_wisdom.dat',status='unknown') + + if(nr.ne.0) then + call import_wisdom_from_file(isuccess,13) + if(isuccess.eq.0) then + write(*,1010) +1010 format('Failed to import FFTW wisdom.') + go to 999 + endif + endif + + idum=-1 !Set random seed + ndim=1 !One-dimensional transforms + do i=1,NMAX !Set random data + x=gran() + y=gran() + b(i)=cmplx(x,y) !Generate random data + enddo + + iters=1000000 + if(list .or. (nfft.gt.0)) then + n1=1 + n2=1 + if(nfft.eq.-1) n2=999999 + write(*,1020) +1020 format(' NFFT Time rms MHz MFlops iters', & + ' tplan'/61('-')) + else + n1=4 + n2=23 + write(*,1030) +1030 format(' n N=2^n Time rms MHz MFlops iters', & + ' tplan'/63('-')) + endif + + do ii=n1,n2 !Test one or more FFT lengths + if(list) then + read(10,*,end=900) nfft !Read nfft from file + else if(n2.gt.n1) then + nfft=2**ii !Do powers of 2 + endif + + iformf=1 + iformb=1 + if(ncomplex.eq.0) then + iformf=0 !Real-to-complex transform + iformb=-1 !Complex-to-real (inverse) transform + endif + + if(nfft.gt.NMAX) go to 900 + a(1:nfft)=b(1:nfft) !Copy test data into a() + t0=second() + call four2a(a,nfft,ndim,-1,iformf) !Get planning time for forward FFT + call four2a(a,nfft,ndim,+1,iformb) !Get planning time for backward FFT + t2=second() + tplan=t2-t0 !Total planning time for this length + + total=0. + do iter=1,iters !Now do many iterations + a(1:nfft)=b(1:nfft) !Copy test data into a() + + t0=second() + call four2a(a,nfft,ndim,-1,iformf) !Forward FFT + call four2a(a,nfft,ndim,+1,iformb) !Backward FFT on same data + t1=second() + total=total+t1-t0 + if(total.ge.1.0) go to 40 !Cut iterations short if t>1 s + enddo + iter=iters + +40 time=0.5*total/iter !Time for one FFT of current length + tplan=0.5*tplan-time !Planning time for one FFT + if(tplan.lt.0) tplan=0. + a(1:nfft)=a(1:nfft)/nfft + +! Compute RMS difference between original array and back-transformed array. + sq=0. + if(ncomplex.eq.1) then + do i=1,nfft + sq=sq + real(a(i)-b(i))**2 + imag(a(i)-b(i))**2 + enddo + else + do i=1,nfft + sq=sq + (ar(i)-br(i))**2 + enddo + endif + rms=sqrt(sq/nfft) + + freq=1.e-6*nfft/time + mflops=5.0/(1.e6*time/(nfft*log(float(nfft))/log(2.0))) + if(n2.eq.1 .or. n2.eq.999999) then + write(*,1050) nfft,time,rms,freq,mflops,iter,tplan + write(12,1050) nfft,time,rms,freq,mflops,iter,tplan +1050 format(i8,f11.7,f12.8,f7.2,f8.1,i8,f6.1) + else + write(*,1060) ii,nfft,time,rms,freq,mflops,iter,tplan + write(12,1060) ii,nfft,time,rms,freq,mflops,iter,tplan +1060 format(i2,i8,f11.7,f12.8,f7.2,f8.1,i8,f6.1) + endif + if(mod(ii,50).eq.0) call four2a(0,-1,0,0,0) + enddo + +900 continue + if(nw.eq.1) then + rewind 13 + call export_wisdom_to_file(13) +! write(*,1070) +!1070 format(/'Exported FFTW wisdom') + endif + +999 call four2a(0,-1,0,0,0) +end program chkfft diff --git a/wsjtx_lib/lib/chkfft.txt b/wsjtx_lib/lib/chkfft.txt new file mode 100644 index 0000000..ed4377c --- /dev/null +++ b/wsjtx_lib/lib/chkfft.txt @@ -0,0 +1,124 @@ + Brief Description of chkfft, by K1JT + ------------------------------------ + +Discrete Fourier transforms (DFTs) are found at the root of most +digital signal processing tasks. In WSJT and its sister programs the +transforms are done using the FFTW library, and subroutine four2 +provides a convenient interface to the library. Program chkfft is a +command-line utility offering a convenient way to test FFT execution +times under a variety of circumstances. + +To compile chkfft in Linux: + +$ gfortran -o chkfft chkfft.f90 four2a.f90 f77_wisdom.f90 gran.c -lfftw3f + +To compile chkfft in Windows (you may need to customize the hard-coded +path shown here for libfftw3f-3.dll): + +> gfortran -o chkfft chkfft.f90 four2a.f90 f77_wisdom.f90 gran.c \ + /JTSDK-QT/appsupport/runtime/libfftw3f-3.dll + +To see a brief usage message, type chkfft at the command prompt: + +$ chkfft + Usage: chkfft nr nw nc np + nfft: length of FFT + nfft=0: do lengths 2^n, n=2^4 to 2^23 + infile: name of file with nfft values, one per line + nr: 0/1 to not read (or read) wisdom + nw: 0/1 to not write (or write) wisdom + nc: 0/1 for real or complex data + np: 0-4 patience for finding best algorithm + +As an example, to measure the speed of a complex DFT of length 131072: + +####################################################################### +$ chkfft 131072 0 1 1 2 + +nfft: 131072 nr: 0 nw 1 nc: 1 np: 2 + + NFFT Time rms MHz MFlops iters tplan +------------------------------------------------------------- + 131072 0.0021948 0.00000032 59.72 5076.1 231 2.9 +####################################################################### + +Program output shows that on the test machine the average time for one +forward (or inverse) transform of length N=131072 is about 2.2 ms, +corresponding to slightly over 5 GFlops computing speed. The planning +time in FFTW was 2.9 s. + +Running the command again with parameter nr=1 will use the +"wisdom" already accumulated for complex N=131072 FFTs. The execution +speed will be essentially the same, but no planning time is required: + +####################################################################### +$ chkfft 131072 1 1 1 2 + +nfft: 131072 nr: 1 nw 1 nc: 1 np: 2 + + NFFT Time rms MHz MFlops iters tplan +------------------------------------------------------------- + 131072 0.0021575 0.00000032 60.75 5164.0 235 0.0 +####################################################################### + +Optimized algorithms can compute DFTs much faster for lengths that are +the product of small integers. Length N=131072 = 2^17 is a good +example, and FFTs should be very efficient. For comparison, look at +the speed for N=131071, a prime number. The average time is now about +7 times larger: + +####################################################################### +C:\JTSDK-QT\src\wsjtx\lib>chkfft 131071 1 1 1 2 + +nfft: 131071 nr: 1 nw 1 nc: 1 np: 2 + + NFFT Time rms MHz MFlops iters tplan +------------------------------------------------------------- + 131071 0.0153637 0.00000065 8.53 725.2 33 5.6 +####################################################################### + +Here's an example that measures execution times for all integral +power-of-2 lengths from 2^4 to 2^23: + +####################################################################### +$ chkfft 0 1 1 1 2 + +nfft: 0 nr: 1 nw 1 nc: 1 np: 2 + + n N=2^n Time rms MHz MFlops iters tplan +--------------------------------------------------------------- + 4 16 0.0000003 0.00000014 58.61 1172.2 1000000 0.0 + 5 32 0.0000004 0.00000016 89.19 2229.6 1000000 0.0 + 6 64 0.0000006 0.00000016 109.44 3283.2 866975 0.0 + 7 128 0.0000009 0.00000021 135.92 4757.1 538369 0.0 + 8 256 0.0000016 0.00000020 158.40 6335.8 313701 0.0 + 9 512 0.0000032 0.00000021 162.53 7313.8 160943 0.1 +10 1024 0.0000067 0.00000023 152.53 7626.5 75521 0.1 +11 2048 0.0000136 0.00000025 150.42 8273.3 37239 0.2 +12 4096 0.0000316 0.00000027 129.75 7784.8 16060 0.3 +13 8192 0.0000720 0.00000026 113.75 7393.8 7040 0.5 +14 16384 0.0001620 0.00000028 101.11 7078.0 3129 0.9 +15 32768 0.0003227 0.00000030 101.53 7615.1 1571 1.7 +16 65536 0.0010020 0.00000030 65.41 5232.5 506 4.1 +17 131072 0.0021575 0.00000032 60.75 5164.0 235 0.0 +18 262144 0.0053937 0.00000032 48.60 4374.2 94 3.6 +19 524288 0.0190668 0.00000034 27.50 2612.2 27 6.8 +20 1048576 0.0468001 0.00000035 22.41 2240.5 11 2.4 +21 2097152 0.0936012 0.00000036 22.41 2352.5 6 31.6 +22 4194304 0.1949997 0.00000037 21.51 2366.0 3 9.8 +23 8388608 0.4212036 0.00000038 19.92 2290.3 2 112.9 +####################################################################### + +Test data for all transforms is gaussian random noise of zero mean and +standard deviation 1. Tabulated values of "rms" are the +root-mean-square differences between the original data and the +back-transfmred data. + +File nfft.dat contains all numbers between 2^3 and 2^23 with no factor +greater than 7, followed by their factors. These numbers are good +choices for FFT lengths. File all_fft.out gives the result on one +machine of running the command + +$ chkfft nfft.dat 0 1 1 2 + +Take note: this task may take as much as 24 hours, or even more! diff --git a/wsjtx_lib/lib/chkfft2.f90 b/wsjtx_lib/lib/chkfft2.f90 new file mode 100644 index 0000000..298f3db --- /dev/null +++ b/wsjtx_lib/lib/chkfft2.f90 @@ -0,0 +1,187 @@ +program chkfft + +! Tests and times one-dimensional FFTs computed by FFTW3 + use FFTW3 + parameter (NMAX=8*1024*1024) !Maximum FFT length + complex a(NMAX),b(NMAX),c(NMAX) + real ar(NMAX),br(NMAX),cr(NMAX) + real mflops + integer*8 plan1,plan2 !Pointers to stored plans + character infile*12,arg*8 + logical list + common/patience/npatience + equivalence (a,ar),(b,br),(c,cr) +! include 'fftw3.f90' !FFTW definitions + + nargs=iargc() + if(nargs.ne.6) then + print*,'Usage: chkfft nr nw nc np inplace' + print*,' nfft: length of FFT' + print*,' nfft=0: do lengths 2^n, n=2^4 to 2^23' + print*,' infile: name of file with nfft values, one per line' + print*,' nr: 0/1 to not read (or read) wisdom' + print*,' nw: 0/1 to not write (or write) wisdom' + print*,' nc: 0/1 for real or complex data' + print*,' np: 0-4 patience for finding best algorithm' + print*,' inplace: 1 for inplace, 0 otherwise' + go to 999 + endif + + list=.false. + nfft=-1 + call getarg(1,infile) + open(10,file=infile,status='old',err=1) + list=.true. !A valid file name was provided + go to 2 +1 read(infile,*) nfft !Take first argument to be nfft +2 call getarg(2,arg) + read(arg,*) nr + call getarg(3,arg) + read(arg,*) nw + call getarg(4,arg) + read(arg,*) ncomplex + call getarg(5,arg) + read(arg,*) npatience + call getarg(6,arg) + read(arg,*) inplace + + if(list) write(*,1000) infile,nr,nw,ncomplex,npatience +1000 format(/'infile: ',a12,' nr:',i2,' nw',i2,' nc:',i2,' np:',i2/) + if(.not.list) write(*,1002) nfft,nr,nw,ncomplex,npatience +1002 format(/'nfft: ',i10,' nr:',i2,' nw',i2,' nc:',i2,' np:',i2/) + + 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 + + open(12,file='chkfft.out',status='unknown') + open(13,file='fftwf_wisdom.dat',status='unknown') + + if(nr.ne.0) then + call import_wisdom_from_file(isuccess,13) + if(isuccess.eq.0) then + write(*,1010) +1010 format('Failed to import FFTW wisdom.') + go to 999 + endif + endif + + idum=-1 !Set random seed + ndim=1 !One-dimensional transforms + do i=1,NMAX !Set random data + x=gran() + y=gran() + b(i)=cmplx(x,y) !Generate random data + enddo + + iters=1000000 + if(list .or. (nfft.gt.0)) then + n1=1 + n2=1 + if(nfft.eq.-1) n2=999999 + write(*,1020) +1020 format(' NFFT Time rms MHz MFlops iters', & + ' tplan'/61('-')) + else + n1=4 + n2=23 + write(*,1030) +1030 format(' n N=2^n Time rms MHz MFlops iters', & + ' tplan'/63('-')) + endif + + do ii=n1,n2 !Test one or more FFT lengths + if(list) then + read(10,*,end=900) nfft !Read nfft from file + else if(n2.gt.n1) then + nfft=2**ii !Do powers of 2 + endif + + iformf=1 + iformb=1 + if(ncomplex.eq.0) then + iformf=0 !Real-to-complex transform + iformb=-1 !Complex-to-real (inverse) transform + endif + + if(nfft.gt.NMAX) go to 900 + a(1:nfft)=b(1:nfft) !Copy test data into a() + t0=second() + if(inplace.ne.0) then + if(ncomplex.ne.0) then + call sfftw_plan_dft_1d(plan1,nfft,a,a,FFTW_FORWARD,nflags) + call sfftw_plan_dft_1d(plan2,nfft,a,a,FFTW_BACKWARD,nflags) + else + call sfftw_plan_dft_r2c_1d(plan1,nfft,a,a,nflags) + call sfftw_plan_dft_c2r_1d(plan2,nfft,a,a,nflags) + endif + else + if(ncomplex.ne.0) then + call sfftw_plan_dft_1d(plan1,nfft,a,c,FFTW_FORWARD,nflags) + call sfftw_plan_dft_1d(plan2,nfft,c,a,FFTW_BACKWARD,nflags) + else + call sfftw_plan_dft_r2c_1d(plan1,nfft,a,c,nflags) + call sfftw_plan_dft_c2r_1d(plan2,nfft,c,a,nflags) + endif + endif + + t2=second() + tplan=t2-t0 !Total planning time for this length + + total=0. + do iter=1,iters !Now do many iterations + a(1:nfft)=b(1:nfft) !Copy test data into a() + t0=second() + call sfftw_execute(plan1) + call sfftw_execute(plan2) + t1=second() + total=total+t1-t0 + if(total.ge.1.0) go to 40 !Cut iterations short if t>1 s + enddo + iter=iters + +40 time=0.5*total/iter !Time for one FFT of current length + tplan=0.5*tplan-time !Planning time for one FFT + if(tplan.lt.0) tplan=0. + a(1:nfft)=a(1:nfft)/nfft + +! Compute RMS difference between original array and back-transformed array. + sq=0. + if(ncomplex.eq.1) then + do i=1,nfft + sq=sq + real(a(i)-b(i))**2 + imag(a(i)-b(i))**2 + enddo + else + do i=1,nfft + sq=sq + (ar(i)-br(i))**2 + enddo + endif + rms=sqrt(sq/nfft) + + freq=1.e-6*nfft/time + mflops=5.0/(1.e6*time/(nfft*log(float(nfft))/log(2.0))) + if(n2.eq.1 .or. n2.eq.999999) then + write(*,1050) nfft,time,rms,freq,mflops,iter,tplan + write(12,1050) nfft,time,rms,freq,mflops,iter,tplan +1050 format(i8,f11.7,f12.8,f7.2,f8.1,i8,f6.1) + else + write(*,1060) ii,nfft,time,rms,freq,mflops,iter,tplan + write(12,1060) ii,nfft,time,rms,freq,mflops,iter,tplan +1060 format(i2,i8,f11.7,f12.8,f7.2,f8.1,i8,f6.1) + endif + enddo + +900 continue + if(nw.eq.1) then + rewind 13 + call export_wisdom_to_file(13) +! write(*,1070) +!1070 format(/'Exported FFTW wisdom') + endif + + call sfftw_destroy_plan(plan1) + call sfftw_destroy_plan(plan2) + +999 end program chkfft diff --git a/wsjtx_lib/lib/chkfft3.f90 b/wsjtx_lib/lib/chkfft3.f90 new file mode 100644 index 0000000..01b3d3b --- /dev/null +++ b/wsjtx_lib/lib/chkfft3.f90 @@ -0,0 +1,177 @@ +program chkfft + +! Tests and times one-dimensional FFTs computed by FFTW3 + use, intrinsic :: iso_c_binding + use FFTW3 + parameter (NMAX=8*1024*1024) !Maximum FFT length + complex a(NMAX),b(NMAX),c(NMAX) + real ar(NMAX),br(NMAX),cr(NMAX) + real mflops +! integer*8 plan1,plan2 !Pointers to stored plans + type(C_PTR) :: plan1,plan2 !Pointers to FFTW plans + character infile*12,arg*8 + logical list + common/patience/npatience + equivalence (a,ar),(b,br),(c,cr) +! include 'fftw3.f90' !FFTW definitions + + nargs=iargc() + if(nargs.ne.5) then + print*,'Usage: chkfft3 nr nw nc np' + print*,' nfft: length of FFT' + print*,' nfft=0: do lengths 2^n, n=2^4 to 2^23' + print*,' infile: name of file with nfft values, one per line' + print*,' nr: 0/1 to not read (or read) wisdom' + print*,' nw: 0/1 to not write (or write) wisdom' + print*,' nc: 0/1 for real or complex data' + print*,' np: 0-4 patience for finding best algorithm' + go to 999 + endif + + list=.false. + nfft=-1 + call getarg(1,infile) + open(10,file=infile,status='old',err=1) + list=.true. !A valid file name was provided + go to 2 +1 read(infile,*) nfft !Take first argument to be nfft +2 call getarg(2,arg) + read(arg,*) nr + call getarg(3,arg) + read(arg,*) nw + call getarg(4,arg) + read(arg,*) ncomplex + call getarg(5,arg) + read(arg,*) npatience + + if(list) write(*,1000) infile,nr,nw,ncomplex,npatience +1000 format(/'infile: ',a12,' nr:',i2,' nw',i2,' nc:',i2,' np:',i2/) + if(.not.list) write(*,1002) nfft,nr,nw,ncomplex,npatience +1002 format(/'nfft: ',i10,' nr:',i2,' nw',i2,' nc:',i2,' np:',i2/) + + 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 + + open(12,file='chkfft.out',status='unknown') + + if(nr.ne.0) then + isuccess=fftwf_import_wisdom_from_filename('fftwf_wisdom.dat'//char(0)) + if(isuccess.eq.1) then + write(*,1010) +1010 format('Imported FFTW wisdom.') + else + write(*,1012) +1012 format('Failed to import FFTW wisdom.') + go to 999 + endif + endif + + idum=-1 !Set random seed + ndim=1 !One-dimensional transforms + do i=1,NMAX !Set random data + x=gran() + y=gran() + b(i)=cmplx(x,y) !Generate random data + enddo + + iters=1000000 + if(list .or. (nfft.gt.0)) then + n1=1 + n2=1 + if(nfft.eq.-1) n2=999999 + write(*,1020) +1020 format(' NFFT Time rms MHz MFlops iters', & + ' tplan'/61('-')) + else + n1=4 + n2=23 + write(*,1030) +1030 format(' n N=2^n Time rms MHz MFlops iters', & + ' tplan'/63('-')) + endif + + do ii=n1,n2 !Test one or more FFT lengths + if(list) then + read(10,*,end=900) nfft !Read nfft from file + else if(n2.gt.n1) then + nfft=2**ii !Do powers of 2 + endif + + iformf=1 + iformb=1 + if(ncomplex.eq.0) then + iformf=0 !Real-to-complex transform + iformb=-1 !Complex-to-real (inverse) transform + endif + + if(nfft.gt.NMAX) go to 900 + a(1:nfft)=b(1:nfft) !Copy test data into a() + t0=second() + if(ncomplex.ne.0) then + plan1=fftwf_plan_dft_1d(nfft,a,c,-1,nflags) + plan2=fftwf_plan_dft_1d(nfft,a,c,+1,nflags) + else + plan1=fftwf_plan_dft_r2c_1d(nfft,ar,c,nflags) + plan2=fftwf_plan_dft_c2r_1d(nfft,c,ar,nflags) + endif + + t2=second() + tplan=t2-t0 !Total planning time for this length + + total=0. + do iter=1,iters !Now do many iterations + a(1:nfft)=b(1:nfft) !Copy test data into a() + t0=second() + call fftwf_execute_dft(plan1,a,c) + call fftwf_execute_dft(plan2,c,a) + t1=second() + total=total+t1-t0 + if(total.ge.1.0) go to 40 !Cut iterations short if t>1 s + enddo + iter=iters + +40 time=0.5*total/iter !Time for one FFT of current length + tplan=0.5*tplan-time !Planning time for one FFT + if(tplan.lt.0) tplan=0. + a(1:nfft)=a(1:nfft)/nfft + +! Compute RMS difference between original array and back-transformed array. + sq=0. + if(ncomplex.eq.1) then + do i=1,nfft + sq=sq + real(a(i)-b(i))**2 + imag(a(i)-b(i))**2 + enddo + else + do i=1,nfft + sq=sq + (ar(i)-br(i))**2 + enddo + endif + rms=sqrt(sq/nfft) + + freq=1.e-6*nfft/time + mflops=5.0/(1.e6*time/(nfft*log(float(nfft))/log(2.0))) + if(n2.eq.1 .or. n2.eq.999999) then + write(*,1050) nfft,time,rms,freq,mflops,iter,tplan + write(12,1050) nfft,time,rms,freq,mflops,iter,tplan +1050 format(i8,f11.7,f12.8,f7.2,f8.1,i8,f6.1) + else + write(*,1060) ii,nfft,time,rms,freq,mflops,iter,tplan + write(12,1060) ii,nfft,time,rms,freq,mflops,iter,tplan +1060 format(i2,i8,f11.7,f12.8,f7.2,f8.1,i8,f6.1) + endif + enddo + +900 continue + if(nw.eq.1) then + ierr=fftwf_export_wisdom_to_filename('fftwf_wisdom.dat'//char(0)) + write(*,1070) +1070 format(/'Exported FFTW wisdom') + endif + + call fftwf_destroy_plan(plan1) + call fftwf_destroy_plan(plan2) + +999 end program chkfft diff --git a/wsjtx_lib/lib/chkhist.f90 b/wsjtx_lib/lib/chkhist.f90 new file mode 100644 index 0000000..116fe90 --- /dev/null +++ b/wsjtx_lib/lib/chkhist.f90 @@ -0,0 +1,21 @@ +subroutine chkhist(mrsym,nmax,ipk) + + integer mrsym(63) + integer hist(0:63) + + hist=0 + do j=1,63 + i=mrsym(j) + hist(i)=hist(i)+1 + enddo + + nmax=0 + do i=0,63 + if(hist(i).gt.nmax) then + nmax=hist(i) + ipk=i+1 + endif + enddo + + return +end subroutine chkhist diff --git a/wsjtx_lib/lib/chkmsg.f90 b/wsjtx_lib/lib/chkmsg.f90 new file mode 100644 index 0000000..eaabef7 --- /dev/null +++ b/wsjtx_lib/lib/chkmsg.f90 @@ -0,0 +1,31 @@ +subroutine chkmsg(message,cok,nspecial,flip) + + character message*22,cok*3 + + nspecial=0 + flip=1.0 + cok=" " + + do i=22,1,-1 + if(message(i:i).ne.' ') go to 10 + enddo + i=22 + +10 if(i.ge.11) then + if((message(i-3:i).eq.' OOO') .or. (message(20:22).eq.' OO')) then + cok='OOO' + flip=-1.0 + if(message(20:22).eq.' OO') then + message=message(1:19) + else + message=message(1:i-4) + endif + endif + endif + + if(message.eq.'RO ') nspecial=2 + if(message.eq.'RRR ') nspecial=3 + if(message.eq.'73 ') nspecial=4 + + return +end subroutine chkmsg diff --git a/wsjtx_lib/lib/chkss2.f90 b/wsjtx_lib/lib/chkss2.f90 new file mode 100644 index 0000000..7ce6f33 --- /dev/null +++ b/wsjtx_lib/lib/chkss2.f90 @@ -0,0 +1,20 @@ +subroutine chkss2(ss2,freq,drift,schk) + + real ss2(0:8,85) + real s(0:8,85) + include 'jt9sync.f90' + + ave=sum(ss2)/(9*85) + if(freq+drift.eq.-999999.0) ave=0. !To silence compiler warning + s=ss2/ave-1.0 + + s1=0. + do i=1,16 + j=ii(i) + if(j.le.85) s1=s1 + s(0,j) + enddo + schk=s1/16.0 + + return +end subroutine chkss2 + diff --git a/wsjtx_lib/lib/code426.f90 b/wsjtx_lib/lib/code426.f90 new file mode 100644 index 0000000..111c549 --- /dev/null +++ b/wsjtx_lib/lib/code426.f90 @@ -0,0 +1,62 @@ +program code426 + + parameter (MZ=26) !Number of 4-FSK symbols + parameter (JZMAX=64) !Desired number of codewords + integer ic(MZ,JZMAX),icsave(MZ) + real c(MZ) + character*12 arg + + nargs=iargc() + if(nargs.ne.2) then + print*,'Usage: code426 ' + print*,'Example: code426 64 10000000' + go to 999 + endif + call getarg(1,arg) + read(arg,*) nmsgs + call getarg(2,arg) + read(arg,*) iters + + call init_random_seed() + + open(13,file='code426.out',status='unknown') + + write(*,1002) nmsgs,iters + write(13,1002) nmsgs,iters +1002 format('Nmsgs:',i4,' Iters:',i10/(66('-'))) + + do i=1,MZ !Create 4 mutually orthogonal codewords + ic(i,1)=mod(i-1,4) + ic(i,2)=mod(i,4) + ic(i,3)=mod(i+1,4) + ic(i,4)=mod(i+2,4) + enddo + + do j=1,4 !Write them out + write(*,1000) j,MZ,ic(1:MZ,j) + write(13,1000) j,MZ,ic(1:MZ,j) +1000 format(2i5,3x,26i2) + enddo + + do j=5,nmsgs !Find codewords up to j=nmsgs with maximum + npk=0 !distance from all the rest + do i=1,iters + call random_number(c) !Generate a random codeword candidate + ic(1:MZ,j)=int(4*c) !Convert real to integer +! nd=MZ +! do k=1,j-1 !Test candidate against all others in list +! n=count(ic(1:MZ,j).ne.ic(1:MZ,k)) +! nd=min(n,nd) +! enddo + call dist426(ic,j,mind) + if(mind.gt.npk) then + npk=mind + icsave=ic(1:MZ,j) !Best candidate so far, save it +! if(npk.ge.19) exit !It won't get any better... + endif + enddo + write(*,1000) j,npk,ic(1:MZ,j) + write(13,1000) j,npk,ic(1:MZ,j) + enddo + +999 end program code426 diff --git a/wsjtx_lib/lib/constants.f90 b/wsjtx_lib/lib/constants.f90 new file mode 100644 index 0000000..2ffdd55 --- /dev/null +++ b/wsjtx_lib/lib/constants.f90 @@ -0,0 +1,5 @@ + integer, parameter :: NTMAX=30*60 + integer, parameter :: NMAX=NTMAX*12000 !Total sample intervals (one minute) + integer, parameter :: NDMAX=NTMAX*1500 !Sample intervals at 1500 Hz rate + integer, parameter :: NSMAX=6827 !Max length of saved spectra + integer, parameter :: MAXFFT3=16384 diff --git a/wsjtx_lib/lib/contest72.f90 b/wsjtx_lib/lib/contest72.f90 new file mode 100644 index 0000000..51629e1 --- /dev/null +++ b/wsjtx_lib/lib/contest72.f90 @@ -0,0 +1,89 @@ +program contest72 + + use packjt + integer dat(12) + logical text,bcontest,ok + character*22 msg,msg0,msg1 + character*72 ct1,ct2 + character*12 callsign1,callsign2 + character*1 c0 + character*42 c + character*6 mygrid + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/ + data bcontest/.true./ + data mygrid/"EM48 "/ + +! itype Message Type +!-------------------- +! 1 Standardd message +! 2 Type 1 prefix +! 3 Type 1 suffix +! 4 Type 2 prefix +! 5 Type 2 suffix +! 6 Free text +! -1 Does not decode correctly + + nargs=iargc() + if(nargs.eq.0) open(10,file='contest_msgs.txt',status='old') + + nn=0 + do imsg=1,9999 + if(nargs.eq.1) then + if(imsg.gt.1) exit + call getarg(1,msg0) + else + read(10,1001,end=999) msg0 +1001 format(a22) + endif + msg=msg0 + call packmsg(msg,dat,itype,bcontest) + call unpackmsg(dat,msg1,bcontest,mygrid) + ok=msg1.eq.msg0 + if(msg0.eq.' ') then + write(*,1002) + else + if(jt_c2(1:1).eq.'W') msg0=' '//msg0(1:20) + nn=nn+1 + write(*,1002) nn,msg0,ok,jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2 +1002 format(i1,'. ',a22,L2,i2,2i10,i6,2i8) + if(index(msg1,' 73 ').gt.4) nn=0 + endif + if(.not.ok) print*,msg0,msg1 + if(itype.lt.0 .or. itype.eq.6) cycle + + if(msg(1:3).eq.'CQ ') then + m=2 + write(ct1,1010) dat +1010 format(12b6.6) +! write(*,1014) ct1 +!1014 format(a72) + cycle + endif + + i1=index(msg,'<') + if(i1.eq.1) then + m=0 + cycle + endif + + if(i.ge.5) then + m=3 + cycle + endif + + if(msg(1:6).eq.'73 CQ ') then + m=4 + cycle + endif + + call packmsg(msg,dat,itype,.false.) + write(ct1,1010) dat + call packtext(msg,nc1,nc2,ng,.false.,'') +! write(ct2,1012) nc1,nc2,ng+32768 +!1012 format(2b28.28,b16.16) +! write(*,1014) ct1 +! write(*,1014) ct2 +! write(*,1014) + enddo + +999 end program contest72 diff --git a/wsjtx_lib/lib/conv232.f90 b/wsjtx_lib/lib/conv232.f90 new file mode 100644 index 0000000..3a347e1 --- /dev/null +++ b/wsjtx_lib/lib/conv232.f90 @@ -0,0 +1,38 @@ +! Layland-Lushbaugh polynomials for a K=32, r=1/2 convolutional code, +! and 8-bit parity lookup table. + + data npoly1/-221228207/,npoly2/-463389625/ + integer*1 partab(0:255) + data partab/ & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0/ diff --git a/wsjtx_lib/lib/coord.f90 b/wsjtx_lib/lib/coord.f90 new file mode 100644 index 0000000..c70f183 --- /dev/null +++ b/wsjtx_lib/lib/coord.f90 @@ -0,0 +1,41 @@ +SUBROUTINE COORD(A0,B0,AP,BP,A1,B1,A2,B2) + +! Examples: +! 1. From ha,dec to az,el: +! call coord(pi,pio2-lat,0.,lat,ha,dec,az,el) +! 2. From az,el to ha,dec: +! call coord(pi,pio2-lat,0.,lat,az,el,ha,dec) +! 3. From ra,dec to l,b +! call coord(4.635594495,-0.504691042,3.355395488,0.478220215, +! ra,dec,l,b) +! 4. From l,b to ra,dec +! call coord(1.705981071d0,-1.050357016d0,2.146800277d0, +! 0.478220215d0,l,b,ra,dec) +! 5. From ra,dec to ecliptic latitude (eb) and longitude (el): +! call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb) +! 6. From ecliptic latitude (eb) and longitude (el) to ra,dec: +! call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,el,eb,ra,dec) + + SB0=sin(B0) + CB0=cos(B0) + SBP=sin(BP) + CBP=cos(BP) + SB1=sin(B1) + CB1=cos(B1) + SB2=SBP*SB1 + CBP*CB1*cos(AP-A1) + CB2=SQRT(1.e0-SB2**2) + B2=atan(SB2/CB2) + SAA=sin(AP-A1)*CB1/CB2 + CAA=(SB1-SB2*SBP)/(CB2*CBP) + CBB=SB0/CBP + SBB=sin(AP-A0)*CB0 + SA2=SAA*CBB-CAA*SBB + CA2=CAA*CBB+SAA*SBB + TA2O2=0.0 !Shut up compiler warnings. -db + IF(CA2.LE.0.e0) TA2O2=(1.e0-CA2)/SA2 + IF(CA2.GT.0.e0) TA2O2=SA2/(1.e0+CA2) + A2=2.e0*atan(TA2O2) + IF(A2.LT.0.e0) A2=A2+6.2831853 + + RETURN +END SUBROUTINE COORD diff --git a/wsjtx_lib/lib/count4.f90 b/wsjtx_lib/lib/count4.f90 new file mode 100644 index 0000000..3c8c5dd --- /dev/null +++ b/wsjtx_lib/lib/count4.f90 @@ -0,0 +1,54 @@ +program count4 + + parameter(NMAX=1000) + character*47 line + real snr(NMAX) + real dt(NMAX) + real f(NMAX) + + open(10,file='/users/joe/appdata/local/wsjt-x/all.txt',status='old') + + read(10,1000,end=10) line +1000 format(a47) + + nsync1=0 + nsync2=0 + n1=0 + n2=0 + nerr=0 + + do i=1,99999 + read(10,1000,end=10) line + if(line(47:47).ne.' ') cycle !Skip average decodes + if(line(20:20).eq.'*') nsync1=nsync1+1 + if(line(20:20).eq.'#') nsync2=nsync2+1 + if(line(22:34).eq.'CQ K1ABC FN42') then + n2=n2+1 !Correlation decode + read(line,1002) snr(n2),dt(n2),f(n2) +1002 format(4x,f4.0,f5.2,f5.0) + if(line(42:42).eq.'*') n1=n1+1 !Convolutional decode + else + if(line(22:34).ne.' ') nerr=nerr+1 + endif + enddo + +10 call stats(snr,n2,snrave,snrdev) + call stats(dt,n2,dtave,dtdev) + call stats(f,n2,fave,fdev) + +write(*,1010) nsync1,nsync2,n1,n2,nerr,snrave,dtave,fave,snrdev,dtdev,fdev +1010 format(5i5,f7.1,f7.2,f7.0/25x,f7.1,f7.2,f7.0) + +end program count4 + +subroutine stats(x,nz,ave,rms) + real x(nz) + + ave=0. + rms=0. + if(nz.gt.0) ave=sum(x)/nz + x=x-ave + if(nz.gt.1) rms=sqrt(dot_product(x,x)/(nz-1)) + + return +end subroutine stats diff --git a/wsjtx_lib/lib/crc.f90 b/wsjtx_lib/lib/crc.f90 new file mode 100644 index 0000000..f0cd17e --- /dev/null +++ b/wsjtx_lib/lib/crc.f90 @@ -0,0 +1,54 @@ +module crc + use, intrinsic :: iso_c_binding, only: c_int, c_loc, c_int8_t, c_bool, c_short + interface + + function crc14 (data, length) bind (C, name="crc14") + use, intrinsic :: iso_c_binding, only: c_short, c_ptr, c_int + implicit none + integer (c_short) :: crc14 + type (c_ptr), value :: data + integer (c_int), value :: length + end function crc14 + + function crc14_check (data, length) bind (C, name="crc14_check") + use, intrinsic :: iso_c_binding, only: c_bool, c_ptr, c_int + implicit none + logical (c_bool) :: crc14_check + type (c_ptr), value :: data + integer (c_int), value :: length + end function crc14_check + + function crc13 (data, length) bind (C, name="crc13") + use, intrinsic :: iso_c_binding, only: c_short, c_ptr, c_int + implicit none + integer (c_short) :: crc13 + type (c_ptr), value :: data + integer (c_int), value :: length + end function crc13 + + function crc13_check (data, length) bind (C, name="crc13_check") + use, intrinsic :: iso_c_binding, only: c_bool, c_ptr, c_int + implicit none + logical (c_bool) :: crc13_check + type (c_ptr), value :: data + integer (c_int), value :: length + end function crc13_check + + function crc10 (data, length) bind (C, name="crc10") + use, intrinsic :: iso_c_binding, only: c_short, c_ptr, c_int + implicit none + integer (c_short) :: crc10 + type (c_ptr), value :: data + integer (c_int), value :: length + end function crc10 + + function crc10_check (data, length) bind (C, name="crc10_check") + use, intrinsic :: iso_c_binding, only: c_bool, c_ptr, c_int + implicit none + logical (c_bool) :: crc10_check + type (c_ptr), value :: data + integer (c_int), value :: length + end function crc10_check + + end interface +end module crc diff --git a/wsjtx_lib/lib/crc10.cpp b/wsjtx_lib/lib/crc10.cpp new file mode 100644 index 0000000..93f6649 --- /dev/null +++ b/wsjtx_lib/lib/crc10.cpp @@ -0,0 +1,31 @@ +#include +#include + +extern "C" +{ + short crc10 (unsigned char const * data, int length); + bool crc10_check (unsigned char const * data, int length); +} + +#define POLY 0x08f + +#ifdef BOOST_NO_CXX11_CONSTEXPR +#define TRUNCATED_POLYNOMIAL POLY +#else +namespace +{ + unsigned long constexpr TRUNCATED_POLYNOMIAL = POLY; +} +#endif + +// assumes CRC is last 16 bits of the data and is set to zero +// caller should assign the returned CRC into the message in big endian byte order +short crc10 (unsigned char const * data, int length) +{ + return boost::augmented_crc<10, TRUNCATED_POLYNOMIAL> (data, length); +} + +bool crc10_check (unsigned char const * data, int length) +{ + return !boost::augmented_crc<10, TRUNCATED_POLYNOMIAL> (data, length); +} diff --git a/wsjtx_lib/lib/crc13.cpp b/wsjtx_lib/lib/crc13.cpp new file mode 100644 index 0000000..0326508 --- /dev/null +++ b/wsjtx_lib/lib/crc13.cpp @@ -0,0 +1,31 @@ +#include +#include + +extern "C" +{ + short crc13 (unsigned char const * data, int length); + bool crc13_check (unsigned char const * data, int length); +} + +#define POLY 0x15D7 + +#ifdef BOOST_NO_CXX11_CONSTEXPR +#define TRUNCATED_POLYNOMIAL POLY +#else +namespace +{ + unsigned long constexpr TRUNCATED_POLYNOMIAL = POLY; +} +#endif + +// assumes CRC is last 13 bits of the data and is set to zero +// caller should assign the returned CRC into the message in big endian byte order +short crc13 (unsigned char const * data, int length) +{ + return boost::augmented_crc<13, TRUNCATED_POLYNOMIAL> (data, length); +} + +bool crc13_check (unsigned char const * data, int length) +{ + return !boost::augmented_crc<13, TRUNCATED_POLYNOMIAL> (data, length); +} diff --git a/wsjtx_lib/lib/crc14.cpp b/wsjtx_lib/lib/crc14.cpp new file mode 100644 index 0000000..19a9ba5 --- /dev/null +++ b/wsjtx_lib/lib/crc14.cpp @@ -0,0 +1,31 @@ +#include +#include + +extern "C" +{ + short crc14 (unsigned char const * data, int length); + bool crc14_check (unsigned char const * data, int length); +} + +#define POLY 0x2757 + +#ifdef BOOST_NO_CXX11_CONSTEXPR +#define TRUNCATED_POLYNOMIAL POLY +#else +namespace +{ + unsigned long constexpr TRUNCATED_POLYNOMIAL = POLY; +} +#endif + +// assumes CRC is last 14 bits of the data and is set to zero +// caller should assign the returned CRC into the message in big endian byte order +short crc14 (unsigned char const * data, int length) +{ + return boost::augmented_crc<14, TRUNCATED_POLYNOMIAL> (data, length); +} + +bool crc14_check (unsigned char const * data, int length) +{ + return !boost::augmented_crc<14, TRUNCATED_POLYNOMIAL> (data, length); +} diff --git a/wsjtx_lib/lib/db.f90 b/wsjtx_lib/lib/db.f90 new file mode 100644 index 0000000..aa58f43 --- /dev/null +++ b/wsjtx_lib/lib/db.f90 @@ -0,0 +1,5 @@ +real function db(x) + db=-99.0 + if(x.gt.1.259e-10) db=10.0*log10(x) + return +end function db diff --git a/wsjtx_lib/lib/decode4.f90 b/wsjtx_lib/lib/decode4.f90 new file mode 100644 index 0000000..e0596ed --- /dev/null +++ b/wsjtx_lib/lib/decode4.f90 @@ -0,0 +1,112 @@ +subroutine decode4(dat,npts,dtx,nfreq,flip,mode4,ndepth,neme,minw, & + mycall,hiscall,hisgrid,decoded,nfano,deepbest,qbest,ichbest) + +! Decodes JT4 data, assuming that DT and DF have already been determined. +! Input dat(npts) has already been downsampled by 2: rate = 11025/2. +! ### NB: this initial downsampling should be removed in WSJT-X, since +! it restricts the useful bandwidth to < 2.7 kHz. + + use jt4 + real dat(npts) !Raw data + character decoded*22,deepmsg*22,deepbest*22 + character*12 mycall,hiscall + character*6 hisgrid + real*8 dt,df,phi,f0,dphi,twopi,phi1,dphi1 + complex*16 cz,cz1,c0,c1 + real*4 sym(207) + + twopi=8*atan(1.d0) + dt=2.d0/11025 !Sample interval (2x downsampled data) + df=11025.d0/2520.d0 !Tone separation for JT4A mode + nsym=206 + amp=15.0 + istart=nint((dtx+0.8)/dt) !Start index for synced FFTs + if(istart.lt.0) istart=0 + nchips=0 + qbest=0. + qtop=0. + deepmsg=' ' + ichbest=-1 + c0=0. + k=istart + phi=0.d0 + phi1=0.d0 + + ich1=minw+1 + do ich=1,7 + if(nch(ich).le.mode4) ich2=ich + enddo + + do ich=ich1,ich2 + nchips=min(nch(ich),70) + nspchip=1260/nchips + k=istart + phi=0.d0 + phi1=0.d0 + fac2=1.e-8 * sqrt(float(mode4)) + do j=1,nsym+1 + if(flip.gt.0.0) then + f0=nfreq + (npr(j))*mode4*df + f1=nfreq + (2+npr(j))*mode4*df + else + f0=nfreq + (1-npr(j))*mode4*df + f1=nfreq + (3-npr(j))*mode4*df + endif + dphi=twopi*dt*f0 + dphi1=twopi*dt*f1 + sq0=0. + sq1=0. + do nc=1,nchips + phi=0.d0 + phi1=0.d0 + c0=0. + c1=0. + do i=1,nspchip + k=k+1 + phi=phi+dphi + phi1=phi1+dphi1 + cz=dcmplx(cos(phi),-sin(phi)) + cz1=dcmplx(cos(phi1),-sin(phi1)) + if(k.le.npts) then + c0=c0 + dat(k)*cz + c1=c1 + dat(k)*cz1 + endif + enddo + sq0=sq0 + real(c0)**2 + aimag(c0)**2 + sq1=sq1 + real(c1)**2 + aimag(c1)**2 + enddo + sq0=fac2*sq0 + sq1=fac2*sq1 + rsym=amp*(sq1-sq0) + if(j.ge.1) then + rsymbol(j,ich)=rsym + sym(j)=rsym + endif + enddo + + call extract4(sym,ncount,decoded) !Do the convolutional decode + nfano=0 + if(ncount.ge.0) then + nfano=1 + ichbest=ich + exit + endif + + qual=0. !Now try deep search +! if(ndepth.ge.1) then + if(iand(ndepth,32).eq.32) then + call deep4(sym(2),neme,flip,mycall,hiscall,hisgrid,deepmsg,qual) + if(qual.gt.qbest) then + qbest=qual + deepbest=deepmsg + ichbest=ich + endif + endif + enddo + if(qbest.gt.qtop) then + qtop=qbest + endif + qual=qbest + + return +end subroutine decode4 diff --git a/wsjtx_lib/lib/decode65a.f90 b/wsjtx_lib/lib/decode65a.f90 new file mode 100644 index 0000000..be2f84c --- /dev/null +++ b/wsjtx_lib/lib/decode65a.f90 @@ -0,0 +1,154 @@ +subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,ntrials, & + naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, & + ljt65apon,bVHF,sync2,a,dt,nft,nspecial,qual,nhist,nsmo,decoded) + +! Apply AFC corrections to a candidate JT65 signal, then decode it. + + use jt65_mod + use timer_module, only: timer + + parameter (NMAX=60*12000) !Samples per 60 s + real*4 dd(NMAX) !92 MB: raw data from Linrad timf2 + complex cx(NMAX/8) !Data at 1378.125 sps + complex cx1(NMAX/8) !Data at 1378.125 sps, offset by 355.3 Hz + complex c5x(NMAX/32) !Data at 344.53125 Hz + complex c5a(512) + real s2(66,126) + real a(5) + logical bVHF,first,ljt65apon + character decoded*22,decoded_best*22 + character mycall*12,hiscall*12,hisgrid*6 + character*27 cr + data first/.true./,jjjmin/1000/,jjjmax/-1000/,cr/'(C) 2016, Joe Taylor - K1JT'/ + save + +! Mix sync tone to baseband, low-pass filter, downsample to 1378.125 Hz + call timer('filbig ',0) + call filbig(dd,npts,f0,newdat,cx,n5,sq0) + if(mode65.eq.4) call filbig(dd,npts,f0+355.297852,newdat,cx1,n5,sq0) + call timer('filbig ',1) +! NB: cx has sample rate 12000*77125/672000 = 1378.125 Hz + +! Check for a shorthand message + if(bVHF .and. mode65.ne.101) then + call sh65(cx,n5,mode65,ntol,xdf,nspecial,sync2) + if(nspecial.gt.0) then + a=0. + a(1)=xdf + nflip=0 + endif + endif + if(nflip.eq.0) go to 900 + +! Find best DF, drift, curvature, and DT. Start by downsampling to 344.53125 Hz + call fil6521(cx,n5,c5x,n6) + + fsample=1378.125/4. + + call timer('afc65b ',0) +! Best fit for DF, drift, and dt. fsample = 344.53125 S/s + dtbest=dt + call afc65b(c5x,n6,fsample,nflip,mode65,a,ccfbest,dtbest) + call timer('afc65b ',1) + dtbest=dtbest+0.003628 !Remove decimation filter and coh. integrator delay + dt=dtbest !Return new, improved estimate of dt + sync2=3.7e-4*ccfbest/sq0 !Constant is empirical + if(mode65.eq.4) cx=cx1 + +! Apply AFC corrections to the time-domain signal +! Now we are back to using the 1378.125 Hz sample rate, enough to +! accommodate the full JT65C bandwidth. + a(3)=0 + call twkfreq65(cx,n5,a) + +! Compute spectrum for each symbol. + nsym=126 + nfft=512 + df=1378.125/nfft + j=int(dtbest*1378.125) + + c5a=cmplx(0.0,0.0) + do k=1,nsym + do i=1,nfft + j=j+1 + if(j.ge.1 .and. j.le.NMAX/8) then + c5a(i)=cx(j) + else + c5a(i)=0. + endif + enddo + call four2a(c5a,nfft,1,1,1) + do i=1,512 + jj=i + if(i.gt.256) jj=i-512 + s1(jj,k)=real(c5a(i))**2 + aimag(c5a(i))**2 + enddo + enddo + + call timer('dec65b ',0) + qualbest=0. + nftbest=0 + qual0=-1.e30 + minsmo=0 + maxsmo=0 + if(mode65.ge.2 .and. mode65.ne.101) then + minsmo=nint(width/df)-1 + maxsmo=2*nint(width/df) + endif + nn=0 + do ismo=minsmo,maxsmo + if(ismo.gt.0) then + do j=1,126 + call smo121(s1(-255,j),512) + if(j.eq.1) nn=nn+1 + if(nn.ge.4) then + call smo121(s1(-255,j),512) + if(j.eq.1) nn=nn+1 + endif + enddo + endif + + do i=1,66 + jj=i + if(mode65.eq.2) jj=2*i-1 + if(mode65.eq.4) then + ff=4*(i-1)*df - 355.297852 + jj=nint(ff/df)+1 + endif + s2(i,1:126)=s1(jj,1:126) + enddo + nadd=ismo !### ??? ### + call decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, & + mycall,hiscall,hisgrid,nQSOProgress,ljt65apon,nqd,nft,qual, & + nhist,decoded) + if(nft.eq.1) then + nsmo=ismo + param(9)=nsmo + nsum=1 + exit + else if(nft.eq.2) then + if(qual.gt.qualbest) then + decoded_best=decoded + qualbest=qual + nnbest=nn + nsmobest=ismo + nftbest=nft + endif + endif + if(qual.lt.qual0) exit + qual0=qual + enddo + + if(nftbest.eq.2) then + decoded=decoded_best + qual=qualbest + nsmo=nsmobest + param(9)=nsmo + nn=nnbest + nft=nftbest + endif + + call timer('dec65b ',1) + +900 return +end subroutine decode65a diff --git a/wsjtx_lib/lib/decode65b.f90 b/wsjtx_lib/lib/decode65b.f90 new file mode 100644 index 0000000..ac9c0c5 --- /dev/null +++ b/wsjtx_lib/lib/decode65b.f90 @@ -0,0 +1,36 @@ +subroutine decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, & + mycall,hiscall,hisgrid,nQSOProgress,ljt65apon,nqd,nft,qual, & + nhist,decoded) + + use jt65_mod + real s2(66,126) + real s3(64,63) + logical ltext,ljt65apon + character decoded*22 + character mycall*12,hiscall*12,hisgrid*6 + save + + if(nqd.eq.-99) stop !Silence compiler warning + do j=1,63 + k=mdat(j) !Points to data symbol + if(nflip.lt.0) k=mdat2(j) + do i=1,64 + s3(i,j)=s2(i+2,k) + enddo + enddo + + call extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, & + hiscall,hisgrid,nQSOProgress,ljt65apon,ncount, & + nhist,decoded,ltext,nft,qual) + +! Suppress "birdie messages" and other garbage decodes: + if(decoded(1:7).eq.'000AAA ') ncount=-1 + if(decoded(1:7).eq.'0L6MWK ') ncount=-1 + if(nflip.lt.0 .and. ltext) ncount=-1 + if(ncount.lt.0) then + nft=0 + decoded=' ' + endif + + return +end subroutine decode65b diff --git a/wsjtx_lib/lib/decode9w.f90 b/wsjtx_lib/lib/decode9w.f90 new file mode 100644 index 0000000..2c043c7 --- /dev/null +++ b/wsjtx_lib/lib/decode9w.f90 @@ -0,0 +1,67 @@ +subroutine decode9w(nfqso,ntol,nsubmode,ss,id2,sync,nsnr,xdt1,f0,decoded) + +! Decode a weak signal in a wide/slow JT9 submode. + + parameter (NSMAX=6827,NZMAX=60*12000) + real ss(184,NSMAX) !Symbol spectra at 1/2-symbol steps + real ccfred(NSMAX) !Best sync vs frequency + real ccfblue(-9:18) !Sync vs time at best frequency + real a(5) !Fitted Lorentzian params + integer*2 id2(NZMAX) !Raw 16-bit data + integer*1 i1SoftSymbols(207) !Binary soft symbols + character*22 decoded !Decoded message + + df=12000.0/16384.0 !Bin spacing in ss() + nsps=6912 !Samples per 9-FSK symbol + tstep=nsps*0.5/12000.0 !Half-symbol duration + npts=52*12000 + limit=10000 !Fano timeout parameter + + ia=max(1,nint((nfqso-ntol)/df)) !Start frequency bin + ib=min(NSMAX,nint((nfqso+ntol)/df)) !End frequency bin + lag1=-int(2.5/tstep + 0.9999) !Start lag + lag2=int(5.0/tstep + 0.9999) !End lag + nhsym=184 !Number of half-symbols + +! First sync pass finds approximate Doppler spread; second pass does a +! good Lorentzian fit to determine frequency f0. + do iter=1,2 + nadd=3 + if(iter.eq.2) nadd=2*nint(0.375*a(4)) + 1 + call sync9w(ss,nhsym,lag1,lag2,ia,ib,ccfred,ccfblue,ipk,lagpk,nadd) + s=0. + sq=0. + ns=0 + do i=-9,18 + if(abs(i-lagpk).gt.3) then + s=s+ccfblue(i) + sq=sq+ccfblue(i)**2 + ns=ns+1 + endif + enddo + base=s/ns + rms=sqrt(sq/ns - base**2) + sync=(ccfblue(lagpk)-base)/rms + xdt0=lagpk*tstep + call lorentzian(ccfred(ia),ib-ia+1,a) + f0=(ia+a(3))*df + enddo + ccfblue=(ccfblue-base)/rms + + call softsym9w(id2,npts,xdt0,f0,a(4)*df,nsubmode,xdt1-1.05,snrdb,i1softsymbols) + nsnr=nint(snrdb) + call jt9fano(i1softsymbols,limit,nlim,decoded) + +!### +! do i=-9,18 +! write(81,3081) i,ccfblue(i) +!3081 format(i3,f10.3) +! enddo +! do i=1,NSMAX +! write(82,3082) i*df,ccfred(i) +!3082 format(f10.1,e12.3) +! enddo +!### + + return +end subroutine decode9w diff --git a/wsjtx_lib/lib/decode_rs.c b/wsjtx_lib/lib/decode_rs.c new file mode 100644 index 0000000..53b441d --- /dev/null +++ b/wsjtx_lib/lib/decode_rs.c @@ -0,0 +1,263 @@ +/* Reed-Solomon decoder + * Copyright 2002 Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ + +#ifdef DEBUG +#include +#endif + +#include +#include + +#define min(a,b) ((a) < (b) ? (a) : (b)) + +#ifdef FIXED +#include "fixed.h" +#elif defined(BIGSYM) +#include "int.h" +#else +#include "char.h" +#endif + +int DECODE_RS( +#ifdef FIXED +DTYPE *data, int *eras_pos, int no_eras,int pad){ +#else +void *p,DTYPE *data, int *eras_pos, int no_eras){ + struct rs *rs = (struct rs *)p; +#endif + int deg_lambda, el, deg_omega; + int i, j, r,k; + DTYPE u,q,tmp,num1,num2,den,discr_r; + DTYPE lambda[NROOTS+1], s[NROOTS]; /* Err+Eras Locator poly + * and syndrome poly */ + DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1]; + DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS]; + int syn_error, count; + +#ifdef FIXED + /* Check pad parameter for validity */ + if(pad < 0 || pad >= NN) + return -1; +#endif + + /* form the syndromes; i.e., evaluate data(x) at roots of g(x) */ + for(i=0;i 0) { + /* Init lambda to be the erasure locator polynomial */ + lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))]; + for (i = 1; i < no_eras; i++) { + u = MODNN(PRIM*(NN-1-eras_pos[i])); + for (j = i+1; j > 0; j--) { + tmp = INDEX_OF[lambda[j - 1]]; + if(tmp != A0) + lambda[j] ^= ALPHA_TO[MODNN(u + tmp)]; + } + } + +#if DEBUG >= 1 + /* Test code that verifies the erasure locator polynomial just constructed + Needed only for decoder debugging. */ + + /* find roots of the erasure location polynomial */ + for(i=1;i<=no_eras;i++) + reg[i] = INDEX_OF[lambda[i]]; + + count = 0; + for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) { + q = 1; + for (j = 1; j <= no_eras; j++) + if (reg[j] != A0) { + reg[j] = MODNN(reg[j] + j); + q ^= ALPHA_TO[reg[j]]; + } + if (q != 0) + continue; + /* store root and error location number indices */ + root[count] = i; + loc[count] = k; + count++; + } + if (count != no_eras) { + printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras); + count = -1; + goto finish; + } +#if DEBUG >= 2 + printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n"); + for (i = 0; i < count; i++) + printf("%d ", loc[i]); + printf("\n"); +#endif +#endif + } + for(i=0;i 0; j--){ + if (reg[j] != A0) { + reg[j] = MODNN(reg[j] + j); + q ^= ALPHA_TO[reg[j]]; + } + } + if (q != 0) + continue; /* Not a root */ + /* store root (index-form) and error location number */ +#if DEBUG>=2 + printf("count %d root %d loc %d\n",count,i,k); +#endif + root[count] = i; + loc[count] = k; + /* If we've already found max possible roots, + * abort the search to save time + */ + if(++count == deg_lambda) + break; + } + if (deg_lambda != count) { + /* + * deg(lambda) unequal to number of roots => uncorrectable + * error detected + */ + count = -1; + goto finish; + } + /* + * Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo + * x**NROOTS). in index form. Also find deg(omega). + */ + deg_omega = deg_lambda-1; + for (i = 0; i <= deg_omega;i++){ + tmp = 0; + for(j=i;j >= 0; j--){ + if ((s[i - j] != A0) && (lambda[j] != A0)) + tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])]; + } + omega[i] = INDEX_OF[tmp]; + } + + /* + * Compute error values in poly-form. num1 = omega(inv(X(l))), num2 = + * inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form + */ + for (j = count-1; j >=0; j--) { + num1 = 0; + for (i = deg_omega; i >= 0; i--) { + if (omega[i] != A0) + num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])]; + } + num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)]; + den = 0; + + /* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */ + for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) { + if(lambda[i+1] != A0) + den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])]; + } +#if DEBUG >= 1 + if (den == 0) { + printf("\n ERROR: denominator = 0\n"); + count = -1; + goto finish; + } +#endif + /* Apply error to data */ + if (num1 != 0 && loc[j] >= PAD) { + data[loc[j]-PAD] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])]; + } + } + finish: + if(eras_pos != NULL){ + for(i=0;i',2i4,i9) + call flush(6) + endif + close(13) + if(ncontest.eq.6) close(19) + if(params%nmode.eq.4 .or. params%nmode.eq.65 .or. params%nmode.eq.66) close(14) + return +contains + + subroutine jt4_decoded(this,snr,dt,freq,have_sync,sync,is_deep, & + decoded0,qual,ich,is_average,ave) + implicit none + class(jt4_decoder), intent(inout) :: this + integer, intent(in) :: snr + real, intent(in) :: dt + integer, intent(in) :: freq + logical, intent(in) :: have_sync + logical, intent(in) :: is_deep + character(len=1), intent(in) :: sync + character(len=22), intent(in) :: decoded0 + real, intent(in) :: qual + integer, intent(in) :: ich + logical, intent(in) :: is_average + integer, intent(in) :: ave + + character*22 decoded + character*3 cflags + + if(ich.eq.-99) stop !Silence compiler warning + if (have_sync) then + decoded=decoded0 + cflags=' ' + if(decoded.ne.' ') then + cflags='f ' + if(is_deep) then + cflags='d ' + write(cflags(2:2),'(i1)') min(int(qual),9) + if(qual.ge.10.0) cflags(2:2)='*' + if(qual.lt.3.0) decoded(22:22)='?' + endif + if(is_average) then + write(cflags(3:3),'(i1)') min(ave,9) + if(ave.ge.10) cflags(3:3)='*' + if(cflags(1:1).eq.'f') cflags=cflags(1:1)//cflags(3:3)//' ' + endif + endif + write(*,1000) params%nutc,snr,dt,freq,sync,decoded,cflags +1000 format(i4.4,i4,f5.1,i5,1x,'$',a1,1x,a22,1x,a3) + else + write(*,1000) params%nutc,snr,dt,freq + end if + + select type(this) + type is (counting_jt4_decoder) + this%decoded = this%decoded + 1 + end select + end subroutine jt4_decoded + + subroutine jt4_average (this, used, utc, sync, dt, freq, flip) + implicit none + class(jt4_decoder), intent(inout) :: this + logical, intent(in) :: used + integer, intent(in) :: utc + real, intent(in) :: sync + real, intent(in) :: dt + integer, intent(in) :: freq + logical, intent(in) :: flip + character(len=1) :: cused, csync + + cused = '.' + csync = '*' + if (used) cused = '$' + if (flip) csync = '$' + write(14,1000) cused,utc,sync,dt,freq,csync +1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1) + end subroutine jt4_average + + subroutine jt65_decoded(this,sync,snr,dt,freq,drift,nflip,width, & + decoded0,ft,qual,nsmo,nsum,minsync) + + use jt65_decode + implicit none + + class(jt65_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + integer, intent(in) :: freq + integer, intent(in) :: drift + integer, intent(in) :: nflip + real, intent(in) :: width + character(len=22), intent(in) :: decoded0 + integer, intent(in) :: ft + integer, intent(in) :: qual + integer, intent(in) :: nsmo + integer, intent(in) :: nsum + integer, intent(in) :: minsync + + integer i,nap + logical is_deep,is_average + character decoded*22,csync*2,cflags*3 + + if(width.eq.-9999.0) stop !Silence compiler warning +!$omp critical(decode_results) + decoded=decoded0 + cflags=' ' + is_deep=ft.eq.2 + + if(ft.eq.0 .and. minsync.ge.0 .and. int(sync).lt.minsync) then + write(*,1010) params%nutc,snr,dt,freq + else + is_average=nsum.ge.2 + if(bVHF .and. ft.gt.0) then + cflags='f ' + if(is_deep) then + cflags='d ' + write(cflags(2:2),'(i1)') min(qual,9) + if(qual.ge.10) cflags(2:2)='*' + if(qual.lt.3) decoded(22:22)='?' + endif + if(is_average) then + write(cflags(3:3),'(i1)') min(nsum,9) + if(nsum.ge.10) cflags(3:3)='*' + endif + nap=ishft(ft,-2) + if(nap.ne.0) then + if(nsum.lt.2) write(cflags(1:3),'(a1,i1," ")') 'a',nap + if(nsum.ge.2) write(cflags(1:3),'(a1,2i1)') 'a',nap,min(nsum,9) + endif + endif + csync='# ' + i=0 + if(bVHF .and. nflip.ne.0 .and. & + sync.ge.max(0.0,float(minsync))) then + csync='#*' + if(nflip.eq.-1) then + csync='##' + if(decoded.ne.' ') then + do i=22,1,-1 + if(decoded(i:i).ne.' ') exit + enddo + if(i.gt.18) i=18 + decoded(i+2:i+4)='OOO' + endif + endif + endif + n=len(trim(decoded)) + if(n.eq.2 .or. n.eq.3) csync='# ' + if(cflags(1:1).eq.'f') then + cflags(2:2)=cflags(3:3) + cflags(3:3)=' ' + endif + write(*,1010) params%nutc,snr,dt,freq,csync,decoded,cflags +1010 format(i4.4,i4,f5.1,i5,1x,a2,1x,a22,1x,a3) + endif + !if(ios13.eq.0) write(13,1012) params%nutc,nint(sync),snr,dt, & + ! float(freq),drift,decoded,ft,nsum,nsmo +!1012! format(i4.4,i4,i5,f6.2,f8.0,i4,3x,a22,' JT65',3i3) + call wsjtx_decoded(params%nutc,snr,dt,freq,decoded) + call flush(6) + +!$omp end critical(decode_results) + select type(this) + type is (counting_jt65_decoder) + this%decoded = this%decoded + 1 + end select + end subroutine jt65_decoded + + subroutine jt9_decoded (this, sync, snr, dt, freq, drift, decoded) + use jt9_decode + implicit none + + class(jt9_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + real, intent(in) :: freq + integer, intent(in) :: drift + character(len=22), intent(in) :: decoded + + !$omp critical(decode_results) + write(*,1000) params%nutc,snr,dt,nint(freq),decoded +1000 format(i4.4,i4,f5.1,i5,1x,'@ ',1x,a22) + !if(ios13.eq.0) write(13,1002) params%nutc,nint(sync),snr,dt,freq, & + ! drift,decoded +!1002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9') + call wsjtx_decoded(params%nutc,snr,dt,nint(freq),decoded) + call flush(6) + !$omp end critical(decode_results) + select type(this) + type is (counting_jt9_decoder) + this%decoded = this%decoded + 1 + end select + end subroutine jt9_decoded + + subroutine ft8_decoded (this,sync,snr,dt,freq,decoded,nap,qual) + use ft8_decode + implicit none + + class(ft8_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + character c1*12,c2*12,g2*4,w*4 + integer i0,i1,i2,i3,i4,i5,n30,nwrap + integer, intent(in) :: nap + real, intent(in) :: qual + character*2 annot + character*37 decoded0 + logical isgrid4,first,b0,b1,b2 + data first/.true./ + save + + isgrid4(w)=(len_trim(w).eq.4 .and. & + ichar(w(1:1)).ge.ichar('A') .and. ichar(w(1:1)).le.ichar('R') .and. & + ichar(w(2:2)).ge.ichar('A') .and. ichar(w(2:2)).le.ichar('R') .and. & + ichar(w(3:3)).ge.ichar('0') .and. ichar(w(3:3)).le.ichar('9') .and. & + ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9')) + + if(first) then + c2fox=' ' + g2fox=' ' + nsnrfox=-99 + nfreqfox=-99 + n30z=0 + nwrap=0 + nfox=0 + first=.false. + endif + + decoded0=decoded + + annot=' ' + if(nap.ne.0) then + write(annot,'(a1,i1)') 'a',nap + if(qual.lt.0.17) decoded0(37:37)='?' + endif + +! i0=index(decoded0,';') +! Always print 37 characters? Or, send i3,n3 up to here from ft8b_2 and use them +! to decide how many chars to print? +!TEMP + i0=1 + if(i0.le.0) write(*,1000) params%nutc,snr,dt,nint(freq),decoded0(1:22),annot +1000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2) + if(i0.gt.0) write(*,1001) params%nutc,snr,dt,nint(freq),decoded0,annot +1001 format(i6.6,i4,f5.1,i5,' ~ ',1x,a37,1x,a2) + !if(ios13.eq.0) write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0 +!1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FT8') + + call wsjtx_decoded(params%nutc,snr,dt,nint(freq),decoded0) + if(ncontest.eq.6) then + i1=index(decoded0,' ') + i2=i1 + index(decoded0(i1+1:),' ') + i3=i2 + index(decoded0(i2+1:),' ') + if(i1.ge.3 .and. i2.ge.7 .and. i3.ge.10) then + c1=decoded0(1:i1-1)//' ' + c2=decoded0(i1+1:i2-1) + g2=decoded0(i2+1:i3-1) + b0=c1.eq.mycall + if(c1(1:3).eq.'DE ' .and. index(c2,'/').ge.2) b0=.true. + if(len(trim(c1)).ne.len(trim(mycall))) then + i4=index(trim(c1),trim(mycall)) + i5=index(trim(mycall),trim(c1)) + if(i4.ge.1 .or. i5.ge.1) b0=.true. + endif + b1=i3-i2.eq.5 .and. isgrid4(g2) + b2=i3-i2.eq.1 + if(b0 .and. (b1.or.b2) .and. nint(freq).ge.1000) then + n=params%nutc + n30=(3600*(n/10000) + 60*mod((n/100),100) + mod(n,100))/30 + if(n30.lt.n30z) nwrap=nwrap+5760 !New UTC day, handle the wrap + n30z=n30 + n30=n30+nwrap + if(nfox.lt.MAXFOX) nfox=nfox+1 + c2fox(nfox)=c2 + g2fox(nfox)=g2 + nsnrfox(nfox)=snr + nfreqfox(nfox)=nint(freq) + n30fox(nfox)=n30 + endif + endif + endif + + call flush(6) + ! if(ios13.eq.0) call flush(13) + + select type(this) + type is (counting_ft8_decoder) + this%decoded = this%decoded + 1 + end select + + return + end subroutine ft8_decoded + + subroutine ft4_decoded (this,sync,snr,dt,freq,decoded,nap,qual) + use ft4_decode + implicit none + + class(ft4_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + character*2 annot + character*37 decoded0 + + decoded0=decoded + + annot=' ' + if(nap.ne.0) then + write(annot,'(a1,i1)') 'a',nap + if(qual.lt.0.17) decoded0(37:37)='?' + endif + + write(*,1001) params%nutc,snr,dt,nint(freq),decoded0,annot +1001 format(i6.6,i4,f5.1,i5,' + ',1x,a37,1x,a2) + ! if(ios13.eq.0) then + ! write(13,1002,err=10) params%nutc,nint(sync),snr,dt,freq,0,decoded0 +!1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FT4') + ! flush(13) + ! endif + call wsjtx_decoded(params%nutc,snr,dt,nint(freq),decoded0) +10 call flush(6) + + select type(this) + type is (counting_ft4_decoder) + this%decoded = this%decoded + 1 + end select + + return + end subroutine ft4_decoded + + subroutine fst4_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, & + qual,ntrperiod,fmid,w50) + + use fst4_decode + implicit none + + class(fst4_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: sync + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + integer, intent(in) :: ntrperiod + real, intent(in) :: fmid + real, intent(in) :: w50 + + character*2 annot + character*37 decoded0 + character*70 line + + decoded0=decoded + annot=' ' + if(nap.ne.0) then + write(annot,'(a1,i1)') 'a',nap + if(qual.lt.0.17) decoded0(37:37)='?' + endif + + if(ntrperiod.lt.60) then + write(line,1001) nutc,nsnr,dt,nint(freq),decoded0,annot +1001 format(i6.6,i4,f5.1,i5,' ` ',1x,a37,1x,a2) +! if(ios13.eq.0) write(13,1002) nutc,nint(sync),nsnr,dt,freq,0,decoded0 +!1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST4') + call wsjtx_decoded(nutc,nsnr,dt,nint(freq),decoded0) + else + write(line,1003) nutc,nsnr,dt,nint(freq),decoded0,annot +1003 format(i4.4,i4,f5.1,i5,' ` ',1x,a37,1x,a2,2f7.3) +! if(ios13.eq.0) write(13,1004) nutc,nint(sync),nsnr,dt,freq,0,decoded0 +!1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' FST4') + call wsjtx_decoded(nutc,nsnr,dt,nint(freq),decoded0) + endif + + if(fmid.ne.-999.0) then + if(w50.lt.0.95) write(line(65:70),'(f6.3)') w50 + if(w50.ge.0.95) write(line(65:70),'(f6.2)') w50 + endif + + write(*,1005) line +1005 format(a70) + + call flush(6) +! if(ios13.eq.0) call flush(13) + + select type(this) + type is (counting_fst4_decoder) + this%decoded = this%decoded + 1 + end select + + return + end subroutine fst4_decoded + + subroutine q65_decoded (this,nutc,snr1,nsnr,dt,freq,decoded,idec, & + nused,ntrperiod) + + use q65_decode + implicit none + + class(q65_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: snr1 + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: idec + integer, intent(in) :: nused + integer, intent(in) :: ntrperiod + character*3 cflags + + cflags=' ' + if(idec.ge.0) then + cflags='q ' + write(cflags(2:2),'(i1)') idec + if(nused.ge.2) write(cflags(3:3),'(i1)') nused + endif + + if(ntrperiod.lt.60) then + write(*,1001) nutc,nsnr,dt,nint(freq),decoded,cflags +1001 format(i6.6,i4,f5.1,i5,' : ',1x,a37,1x,a3) +! if(ios13.eq.0) write(13,1002) nutc,nint(snr1),nsnr,dt,freq,0,decoded +!1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' Q65') + else + write(*,1003) nutc,nsnr,dt,nint(freq),decoded,cflags +1003 format(i4.4,i4,f5.1,i5,' : ',1x,a37,1x,a3) +! if(ios13.eq.0) write(13,1004) nutc,nint(snr1),nsnr,dt,freq,0,decoded +!1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' Q65') + + endif + call flush(6) +! if(ios13.eq.0) call flush(13) + + select type(this) + type is (counting_q65_decoder) + if(idec.ge.0) this%decoded = this%decoded + 1 + end select + + return + end subroutine q65_decoded + +end subroutine multimode_decoder diff --git a/wsjtx_lib/lib/deep4.f90 b/wsjtx_lib/lib/deep4.f90 new file mode 100644 index 0000000..05f6732 --- /dev/null +++ b/wsjtx_lib/lib/deep4.f90 @@ -0,0 +1,169 @@ +subroutine deep4(sym0,neme,flip,mycall,hiscall,hisgrid,decoded,qual) + +! Deep search routine for JT4 + + use prog_args + parameter (MAXCALLS=7000,MAXRPT=63) + real*4 sym0(206),sym(206) + character callsign*12,grid*4,message*22,hisgrid*6,ceme*3 + character*12 mycall,hiscall + character mycall0*12,hiscall0*12,hisgrid0*6 + character*22 decoded + character*22 testmsg(2*MAXCALLS + 2 + MAXRPT) + character*15 callgrid(MAXCALLS) + character*180 line + character*4 rpt(MAXRPT) + integer ncode(206) + real*4 code(206,2*MAXCALLS + 2 + MAXRPT) + real pp(2*MAXCALLS + 2 + MAXRPT) + data neme0/-99/ + data rpt/'-01','-02','-03','-04','-05', & + '-06','-07','-08','-09','-10', & + '-11','-12','-13','-14','-15', & + '-16','-17','-18','-19','-20', & + '-21','-22','-23','-24','-25', & + '-26','-27','-28','-29','-30', & + 'R-01','R-02','R-03','R-04','R-05', & + 'R-06','R-07','R-08','R-09','R-10', & + 'R-11','R-12','R-13','R-14','R-15', & + 'R-16','R-17','R-18','R-19','R-20', & + 'R-21','R-22','R-23','R-24','R-25', & + 'R-26','R-27','R-28','R-29','R-30', & + 'RO','RRR','73'/ + save mycall0,hiscall0,hisgrid0,neme0,ntot,code,testmsg + + sym=sym0 + if(mycall.eq.mycall0 .and. hiscall.eq.hiscall0 .and. & + hisgrid.eq.hisgrid0 .and. neme.eq.neme0) go to 30 + + open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown') + k=0 + icall=0 + do n=1,MAXCALLS + if(n.eq.1) then + callsign=hiscall + do i=4,12 + if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' ' + enddo + grid=hisgrid(1:4) + if(ichar(grid(3:3)).eq.0) grid(3:3)=' ' + if(ichar(grid(4:4)).eq.0) grid(4:4)=' ' + else + read(23,1002,end=20) line +1002 format (A80) + if(line(1:4).eq.'ZZZZ') go to 20 + if(line(1:2).eq.'//') go to 10 + i1=index(line,',') + if(i1.lt.4) go to 10 + i2=index(line(i1+1:),',') + if(i2.lt.5) go to 10 + i2=i2+i1 + i3=index(line(i2+1:),',') + if(i3.lt.1) i3=index(line(i2+1:),' ') + i3=i2+i3 + callsign=line(1:i1-1) + grid=line(i1+1:i2-1) + ceme=line(i2+1:i3-1) + if(neme.eq.1 .and. ceme.ne.'EME') go to 10 + endif + + icall=icall+1 + j1=index(mycall,' ') - 1 + if(j1.le.-1) j1=12 + if(j1.lt.3) j1=6 + j2=index(callsign,' ') - 1 + if(j2.le.-1) j2=12 + if(j2.lt.3) j2=6 + j3=index(mycall,'/') ! j3>0 means compound mycall + j4=index(callsign,'/') ! j4>0 means compound hiscall + callgrid(icall)=callsign(1:j2) + + mz=1 +! Allow MyCall + HisCall + rpt (?) + if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and. callsign(1:6).ne.' ') & + mz=MAXRPT+1 + do m=1,mz + if(m.gt.1) grid=rpt(m-1) + if(j3.lt.1 .and.j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid + message=mycall(1:j1)//' '//callgrid(icall) + k=k+1 + testmsg(k)=message + call encode4(message,ncode) + code(1:206,k)=2*ncode(1:206)-1 + if(n.ge.2) then +! Insert CQ message + if(j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid + message='CQ '//callgrid(icall) + k=k+1 + testmsg(k)=message + call encode4(message,ncode) + code(1:206,k)=2*ncode(1:206)-1 + endif + enddo +10 continue + enddo + +20 continue + close(23) + ntot=k + +30 mycall0=mycall + hiscall0=hiscall + hisgrid0=hisgrid + neme0=neme + + sq=0. + do j=1,206 + sq=sq + sym(j)**2 + enddo + rms=sqrt(sq/206.0) + sym=sym/rms + + p1=-1.e30 + p2=-1.e30 + do k=1,ntot + pp(k)=0. +! Should re-instate the following: +! if(k.ge.2 .and. k.le.64 .and. flip.gt.0.0) cycle +! Test all messages if flip=+1; skip the CQ messages if flip=-1. + if(flip.gt.0.0 .or. testmsg(k)(1:3).ne.'CQ ') then + p=0. + do j=1,206 + p=p + code(j,k)*sym(j) + enddo + pp(k)=p + if(p.gt.p1) then + p1=p + ip1=k + endif + endif + enddo + + do i=1,ntot + if(pp(i).gt.p2 .and. testmsg(i).ne.testmsg(ip1)) p2=pp(i) + enddo + + qual=p1-max(1.15*p2,70.0) + +! ### DO NOT REMOVE ### + rewind 77 + if(ip1.ge.1 .and. ip1.le.2*MAXCALLS+2+MAXRPT) write(77,1001) p1,p2,ntot, & + rms,qual,ip1,testmsg(ip1) +1001 format(2f8.2,i8,2f8.2,i6,2x,a22) + call flush(77) + + if(qual.gt.1.0) then + decoded=testmsg(ip1) + else + decoded=' ' + qual=0. + endif + +! Make sure everything is upper case. + do i=1,22 + if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z') & + decoded(i:i)=char(ichar(decoded(i:i))-32) + enddo + + return +end subroutine deep4 diff --git a/wsjtx_lib/lib/deg2grid.f90 b/wsjtx_lib/lib/deg2grid.f90 new file mode 100644 index 0000000..4fdc2af --- /dev/null +++ b/wsjtx_lib/lib/deg2grid.f90 @@ -0,0 +1,30 @@ +subroutine deg2grid(dlong0,dlat,grid) + + real dlong !West longitude (deg) + real dlat !Latitude (deg) + character grid*6 + + dlong=dlong0 + if(dlong.lt.-180.0) dlong=dlong+360.0 + if(dlong.gt.180.0) dlong=dlong-360.0 + +! Convert to units of 5 min of longitude, working east from 180 deg. + nlong=int(60.0*(180.0-dlong)/5.0) + n1=nlong/240 !20-degree field + n2=(nlong-240*n1)/24 !2 degree square + n3=nlong-240*n1-24*n2 !5 minute subsquare + grid(1:1)=char(ichar('A')+n1) + grid(3:3)=char(ichar('0')+n2) + grid(5:5)=char(ichar('a')+n3) + +! Convert to units of 2.5 min of latitude, working north from -90 deg. + nlat=int(60.0*(dlat+90)/2.5) + n1=nlat/240 !10-degree field + n2=(nlat-240*n1)/24 !1 degree square + n3=nlat-240*n1-24*n2 !2.5 minuts subsquare + grid(2:2)=char(ichar('A')+n1) + grid(4:4)=char(ichar('0')+n2) + grid(6:6)=char(ichar('a')+n3) + + return +end subroutine deg2grid diff --git a/wsjtx_lib/lib/degrade_snr.f90 b/wsjtx_lib/lib/degrade_snr.f90 new file mode 100644 index 0000000..fd5db5f --- /dev/null +++ b/wsjtx_lib/lib/degrade_snr.f90 @@ -0,0 +1,21 @@ +subroutine degrade_snr(d2,npts,db,bw) + +! Degrade S/N by specified number of dB. + + integer*2 d2(npts) + + p0=0. + do i=1,npts + x=d2(i) + p0=p0 + x*x + enddo + p0=p0/npts + if(bw.gt.0.0) p0=p0*6000.0/bw + s=sqrt(p0*(10.0**(0.1*db) - 1.0)) + fac=sqrt(p0/(p0+s*s)) + do i=1,npts + d2(i)=nint(fac*(d2(i) + s*gran())) + enddo + + return +end subroutine degrade_snr diff --git a/wsjtx_lib/lib/demod64a.f90 b/wsjtx_lib/lib/demod64a.f90 new file mode 100644 index 0000000..b1176ef --- /dev/null +++ b/wsjtx_lib/lib/demod64a.f90 @@ -0,0 +1,61 @@ +subroutine demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) + +! Demodulate the 64-bin spectra for each of 63 symbols in a frame. + +! Parameters +! nadd number of spectra already summed +! mrsym most reliable symbol value +! mr2sym second most likely symbol value +! mrprob probability that mrsym was the transmitted value +! mr2prob probability that mr2sym was the transmitted value + + implicit real*8 (a-h,o-z) + real*4 s3(64,63),afac1 + integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63) + + if(nadd.eq.-999) return + afac=afac1 * float(nadd)**0.64 + scale=255.999 + +! Compute average spectral value + ave=sum(s3)/(64.*63.) + i1=1 !Silence warning + i2=1 + +! Compute probabilities for most reliable symbol values + do j=1,63 + s1=-1.e30 + psum=0. + do i=1,64 + x=min(afac*s3(i,j)/ave,50.d0) + psum=psum+s3(i,j) + if(s3(i,j).gt.s1) then + s1=s3(i,j) + i1=i !Most reliable + endif + enddo + if(psum.eq.0.0) psum=1.e-6 + + s2=-1.e30 + do i=1,64 + if(i.ne.i1 .and. s3(i,j).gt.s2) then + s2=s3(i,j) + i2=i !Second most reliable + endif + enddo + p1=s1/psum !Symbol metrics for ftrsd + p2=s2/psum + mrsym(j)=i1-1 + mr2sym(j)=i2-1 + mrprob(j)=scale*p1 + mr2prob(j)=scale*p2 + enddo + + nlow=0 + do j=1,63 + if(mrprob(j).le.5) nlow=nlow+1 + enddo + ntest=sum(mrprob) + + return +end subroutine demod64a diff --git a/wsjtx_lib/lib/determ.f90 b/wsjtx_lib/lib/determ.f90 new file mode 100644 index 0000000..6ae471b --- /dev/null +++ b/wsjtx_lib/lib/determ.f90 @@ -0,0 +1,32 @@ +real*8 function determ(array,norder) + implicit real*8 (a-h,o-z) + real*8 array(10,10) + + determ=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 + determ=0. + go to 60 + +31 do i=k,norder + s8=array(i,j) + array(i,j)=array(i,k) + array(i,k)=s8 + enddo + determ=-1.*determ +41 determ=determ*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 determ diff --git a/wsjtx_lib/lib/digi-contest.txt b/wsjtx_lib/lib/digi-contest.txt new file mode 100644 index 0000000..b0eafae --- /dev/null +++ b/wsjtx_lib/lib/digi-contest.txt @@ -0,0 +1,277 @@ + Possible FT8 Enhancements for Contesting + ---------------------------------------- + +In addition to all the standard FT8 messages, FT8 DXpedition Mode +defines a new message type to convey messages like this example +acknowledging completion of a QSO with K1ABC and initiating a QSO with +W9XYZ: + + K1ABC RR73; W9XYZ -11 + +With 15s T/R sequencing and otherwise using standard FT8 messages, +this feature allows QSO rates up to 120/hour with one Tx signal. The +callsign enclosed in angle brackets is sent as a 10-bit hash code. + +High QSO rates are also desirable for contest operating, but some +details are quite different from the DXpedition case. Contesting is a +many-to-many (as opposed to many-to-one) activity. We distinguish +between "Run stations" and "S+P stations" rather than between "Fox" +and "Hounds". + +An optimal sequence of messages suitable for contesting looks +something like the list in Table 1, where {exch} represents the +required contest exchange. With 15 s transmissions and a steady +stream of callers, messages like these can support QSO rates +approaching 120/hour. + +Table 1. Example sequence of FT8 contest messages +------------------------------------------------------------------------- + Run station S+P stations +------------------------------------------------------------------------- +1. CQ K1ABC +2. K1ABC W9XYZ, K1ABC G4AAA, ... +3. W9XYZ K1ABC {exch} +4. K1ABC W9XYZ {exch} +5. TU; G4AAA K1ABC {exch} +6. K1ABC G4AAA {exch} +7. TU; VE2BBB K1ABC {exch} +8. K1ABC VE2BBB {exch} +9. ... +------------------------------------------------------------------------- + +In some circumstances one or both station callsigns may safely be +taken as known by context. High-rate contest transmissions in SSB, +CW, and RTTY can therefore be considerably shortened with no resulting +ambiguity for attentive operators. CQing stations need not include +their own callsign in every transmission, while S+P stations may send +only their own callsign at first, as in line 2 of Table 2, and then +only the contest exchange, as in line 4. + +Table 2. Abbreviated contest messages +------------------------------------------------------------------------- + Run station S+P stations +------------------------------------------------------------------------- +1. CQ K1ABC +2. W9XYZ, G4AAA, ... +3. W9XYZ {exch} +4. {exch} (sent by W9XYZ) +5. TU; G4AAA {exch} +6. {exch} (sent by G4AAA) +7. TU; VE2BBB {exch} +8. {exch} (sent by VE2BBB) +9. TU; CQ K1ABC +10. ... +------------------------------------------------------------------------- + +There would be no advantage to such message brevity with FT8. FT8 +transmissions are of fixed duration, by design; and the AP decoder can +treat the home callsign and previously decoded callsigns as +hypothetically given, thereby making the effective code rate lower and +sensitivity up to 4 dB better. + +Required exchange information for some relevant contests is +illustrated in Table 3, along with a breakdown of bit requirements for +each component of the exchange. Lower-case letter-number combinations +such as r1, r3, s7,... in the table suggest the meanings and indicate +the number of bits required to convey each part of the exchange. +Further details are given below the Table. Parameter T1 is the total +number of exchange bits, and T2=T1+56 is the number of bits for the +full message, including two standard 28-bit callsigns. + +Table 3. Examples of required contest exchanges {exch} +------------------------------------------------------------------------------ +Event Exchange Example Bits T1 T2 +------------------------------------------------------------------------------ +ARRL RTTY US/Can: rpt state/prov R 579 MA r1 r3 s7 11 67 + DX: rpt serial R 559 0013 r1 r3 n12 16 72 + +Field Day US/Can: OpClass Section R 6A EMA r1 n5 c3 s7 16 72 + DX: OpClass DX R 1A DX r1 n5 c3 s7 16 72 + +CQ WPX RTTY RST + serial R 589 0013 r1 r3 n12 16 72 + +CQ WW RTTY US/Can: RST CQZ state/prov R 579 8 NJ r1 r3 z6 s6 16 72 + DX: RST + CQzone R 559 3 r1 r3 z6 10 66 + +ARRL VHF+ grid4 R FN42 r1 g15 16 72 + +EU VHF+ rpt serial grid6 R 590013 IO91NP r1 r3 n12 g25 41 97 +------------------------------------------------------------------------------ +Meaning and number of bits for each exchange component: + +c3 Operating class (A-F) +g15 grid4 +g25 grid6 +n12 Serial number +n5 Number of transmitters (0-31) +r1 acknowledgment of received exchange +r3 3-bit report (0-7 ==> -24 to +18 dB, effectively "S2 to "S9") +s6 US state or Canadian province (48+14=62) +s7 ARRL/RAC Section (83 sections) +z6 CQ zone +------------------------------------------------------------------------------ + +How best to accommodate all these possibilities within the 72+3-bit +FT8 message payload? Let i3 (aka "i3bit") denote message type, with +available range 0-7. Type 0 is already used for standard JT-style +structured messages and free text, and type 1 for DXpedition mode. +Examples of suggested new message types 2 through 6 are summarized in +the Table 4. + +Table 4. Proposed FT8 message types +------------------------------------------------------------------------------ +i3 Example message Bits i72 Total Special purpose +------------------------------------------------------------------------------ +0 K1ABC W9XYZ EN37 28 28 15 0 72 Standard message +0 FREE TEXT 71 1 72 Free text +1 K1ABC RR73; W9XYZ -11 28 28 10 6 72 DXpedition Mode +2 W9XYZ K1ABC x16 28 28 16 72 Contesting +3 TU; G4AAA K1ABC x16 28 28 16 72 Contesting with "TU;" +4 W9XYZ/R R x25 17 28 1 1 25 72 Rovers, Grid6 +5 PJ4/W9XYZ 17 49 66 Compound TxCall +6 PA9XYZ R 590003 IO91NP 28 1 3 12 24 68 EU VHF contest +7 tbd... + +The first callsign in a message can also be "CQ" and a few other +special tokens. Type 3 messages are the same as type 2 except for +including "TU;", the completion-of-QSO indicator. Message fragments +x16 and x25 represent generic contest exchanges. A "contest template" +will define the specific source encoding/decoding needed for each +event. + +Suggested message types 4 and 5 use a 17-bit hash for the first +callsign. I'm imagining that we'd start with a 32-bit crc and then +use its remainder after dividing by the prime number 131063. Values +less than 131063 will be the desired hash code, and the nine values +131063-131071 can be assigned special meanings such as CQ, QRZ, etc. +Type 4 messages identify the transmitting station as a Rover and can +also accommodate 6-digit grid locators. Type 5 messages allow the +transmitting station to send a full compound callsign with add-on +prefixes up to 4 characters and suffixes up to 3. Compound callsigns +are also permissible for the hashed callsigns in message types 4 and +5. + +Contest Operating +----------------- + +Operating in this proposed FT8 Contest Mode would be similar to that +in current RTTY contests. CQing stations will be distributed over 20 +kHz or more on each band, perhaps at ~500 Hz separation. They will +respond to callers on their own frequency +/- ~200 Hz. Thus, a CQing +station and callers should occupy no more than 500 Hz total bandwidth. +CQers might always transmit at Tx audio frequency 1750 Hz and +configure their FT8 decoders to respond to signals between 1500 and +2000 Hz. S+P stations will typically work their way up or down the +band, perhaps in steps of 2 or 3 kHz, looking for unworked CQers. The +FT8 Contest GUI will offer special features for CQ mode and S+P mode +that make such conventions easy to follow. + +Some Pertinent Questions +------------------------ + +1. FT8 is a good mode, but does it make for a good contesting mode? + +The model described above maxes out at 120 QSOs/hour. (One can +imagine SO2R or even SO3R extensions, doubling or tripling that +limit.) Should we consider T/R sequences of 10s, or even 5s, to get +potentially higher rates? Should we consider giving up synchronized, +fixed-length sequences entirely, and use operator-determined start +times and transmission lengths? That's a significant departure from +all existing WSJT-X modes. + +2. How much automation should be permissible? + +We're not aiming to make a contesting robot. We want something that +rewards operator and station performance. The recently introduced FT8 +DXpedition Mode offers the "Fox" operator a list of decoded "Hounds" +sorted by Call, Grid, S/N, Distance, or Random order. Hounds must +initiate their calls to Fox, and Fox must manually select each Hound +to be called. Otherwise, QSOs proceed with standard FT8 +"auto-sequencing". Is this model acceptable? + +3. How much bandwidth? How much sensitivity? + +RTTY signals use bandwidth ~220 Hz and require S/N around -5 dB or +better, measured in a 2500 Hz bandwidth. FT8 uses signal bandwidth 50 +Hz and reaches threshold sensitivity between -20 and -24 dB, depending +on how much a priori (AP) information is available. Shorter +transmissions conveying the same messages would increase the +bandwidth, S/N threshold, and potential QSO rate proportionally. Has +FT8 already hit the "sweet spot" of such trade-offs? + +4. Suitable power limits? + +WSJT-X modes are designed as weak-signal modes. They have strong FEC +and don't suffer from partial or corrupted copy. Sensitivity already +beats RTTY by 15-19 dB, so arguably it makes sense for an FT8 contest +or contest category to be limited to 100 W or even QRP power levels. + +5. What software should provide the operator's GUI? + +Things are described above as though WSJT-X, the software that +introduced FT8, would be used for contest operating. WSJT-X can send +QSO information to N1MM+ and other logging programs, so they could be +used in combination with WSJT-X. Alternatively, we could set things +up so that N1MM+ is the control program and FT8 encoding/decoding is +provided by a plug-in "MMFT8" similar to MMTTY. Operators already +into serious RTTY contesting would probably like the N1MM-in-control +option. However, existing FT8 users might be more comfortable with +WSJT-X in full control. Moreover, WSJT-X offers full support for +Linux and MacOS, which N1MM+ does not. + +######################################################################## + +More thinking, beyond the above... + +FT8 currently uses LDPC(174,87), where 87=72+3+12. Suggest going to +LDPC(174,91), with 91=72+5+14. This would give us 32 message types +rather than 7, and stronger suppression of false decodes. SNR penalty +would be 10log(91/87)=0.2 dB. + +MSK144 currently uses LDPC(128,80), where 80=72+8. Suggest going to +LDPC(128,87), with 87=72+5+10. SNR penalty is 0.4 dB. + +ARRL RTTY Roundup +------------------------------------------------------------------------- + Run station S+P stations +------------------------------------------------------------------------- +1. CQ K1ABC +2. K1ABC W9XYZ, K1ABC G4AAA, ... +3. W9XYZ K1ABC 579 MA +4. K1ABC W9XYZ 599 WI +5. TU; G4AAA K1ABC 559 MA +6. K1ABC G4AAA 579 0013 +7. TU; VE2BBB K1ABC 599 MA +8. K1ABC VE2BBB 599 QC +9. TU; CQ K1ABC +------------------------------------------------------------------------- + + +NA VHF Contest +------------------------------------------------------------------------- + Run station S+P station i3 +------------------------------------------------------------------------- +1. CQ K1ABC/R FN54 0 +2. K1ABC W9XYZ EN37 0 +3. W9XYZ K1ABC R FN54 2 +4. K1ABC W9XYZ RR73 0 +5. CQ K1ABC/R FN54 0 +------------------------------------------------------------------------- +1. CQ K1ABC FN42 0 +2. W9XYZ/R EN47 5 +3. W9XYZ K1ABC R FN42 0 +4. DE W9XYZ/R RR73 0 +5. CQ K1ABC FN42 0 +------------------------------------------------------------------------- + + + +EU VHF+ Contest +------------------------------------------------------------------------- + Run station S+P station i3 +------------------------------------------------------------------------- +1. CQ G4ABC IO91 0 +2. G4ABC PA9XYZ JO22 0 +3. PA9XYZ 590003 IO91NP 6 +4. G4ABC R 570007 JO22DB 6 +5. PA9XYZ G4ABC RR73 0 diff --git a/wsjtx_lib/lib/downsam9.f90 b/wsjtx_lib/lib/downsam9.f90 new file mode 100644 index 0000000..7cd1962 --- /dev/null +++ b/wsjtx_lib/lib/downsam9.f90 @@ -0,0 +1,88 @@ +subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2) + +!Downsample from id2() into c2() so as to yield nspsd samples per symbol, +!mixing from fpk down to zero frequency. The downsample factor is 432. + + use, intrinsic :: iso_c_binding + use FFTW3 + use timer_module, only: timer + + include 'constants.f90' + integer(C_SIZE_T) NMAX1 + parameter (NMAX1=653184) + parameter (NFFT1=653184,NFFT2=1512) + type(C_PTR) :: plan !Pointers plan for big FFT + integer*2 id2(0:8*npts8-1) + logical, intent(inout) :: newdat + real*4, pointer :: x1(:) + complex c1(0:NFFT1/2) + complex c2(0:NFFT2-1) + real s(5000) + logical first + common/patience/npatience,nthreads + data first/.true./ + save plan,first,c1,s,x1 + + df1=12000.0/NFFT1 + npts=8*npts8 + if(npts.gt.NFFT1) npts=NFFT1 !### Fix! ### + + if(first) then + 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 +! Plan the FFTs just once + + !$omp critical(fftw) ! serialize non thread-safe FFTW3 calls + plan=fftwf_alloc_real(NMAX1) + call c_f_pointer(plan,x1,[NMAX1]) + x1(0:NMAX1-1) => x1 !remap bounds + call fftwf_plan_with_nthreads(nthreads) + plan=fftwf_plan_dft_r2c_1d(NFFT1,x1,c1,nflags) + call fftwf_plan_with_nthreads(1) + !$omp end critical(fftw) + + first=.false. + endif + + if(newdat) then + x1(0:npts-1)=id2(0:npts-1) + x1(npts:NFFT1-1)=0. !Zero the rest of x1 + call timer('FFTbig9 ',0) + call fftwf_execute_dft_r2c(plan,x1,c1) + call timer('FFTbig9 ',1) + + nadd=int(1.0/df1) + s=0. + do i=1,5000 + j=int((i-1)/df1) + do n=1,nadd + j=j+1 + s(i)=s(i)+real(c1(j))**2 + aimag(c1(j))**2 + enddo + enddo + newdat=.false. + endif + + ndown=8*nsps8/nspsd !Downsample factor = 432 + nh2=NFFT2/2 + nf=nint(fpk) + i0=int(fpk/df1) + + nw=100 + ia=max(1,nf-nw) + ib=min(5000,nf+nw) + call pctile(s(ia),ib-ia+1,40,avenoise) + + fac=sqrt(1.0/avenoise) + do i=0,NFFT2-1 + j=i0+i + if(i.gt.nh2) j=j-NFFT2 + c2(i)=fac*c1(j) + enddo + call four2a(c2,NFFT2,1,1,1) !FFT back to time domain + + return +end subroutine downsam9 diff --git a/wsjtx_lib/lib/dxped_fifo.f90 b/wsjtx_lib/lib/dxped_fifo.f90 new file mode 100644 index 0000000..77fe06e --- /dev/null +++ b/wsjtx_lib/lib/dxped_fifo.f90 @@ -0,0 +1,23 @@ +subroutine dxped_fifo(cx,gx,isnrx) + + parameter (NCALLS=268) + character*6 xcall(NCALLS) + character*4 xgrid(NCALLS) + integer isnr(NCALLS) + + character cx*6,gx*4 + common/dxpfifo/nc,isnr,xcall,xgrid + + if(nc.lt.NCALLS) then + nc=nc+1 + cx=xcall(nc) + gx=xgrid(nc) + isnrx=isnr(nc) + else + cx=' ' + gx=' ' + isnrx=0 + endif + + return +end subroutine dxped_fifo diff --git a/wsjtx_lib/lib/echo_snr.f90 b/wsjtx_lib/lib/echo_snr.f90 new file mode 100644 index 0000000..fb976b7 --- /dev/null +++ b/wsjtx_lib/lib/echo_snr.f90 @@ -0,0 +1,51 @@ +subroutine echo_snr(sa,sb,fspread,blue,red,snrdb,db_err,fpeak,snr_detect) + + parameter (NZ=4096) + real sa(NZ) + real sb(NZ) + real blue(NZ) + real red(NZ) + integer ipkv(1) + equivalence (ipk,ipkv) + + df=12000.0/32768.0 + wh=0.5*fspread+10.0 + i1=nint((1500.0 - 2.0*wh)/df) - 2048 + i2=nint((1500.0 - wh)/df) - 2048 + i3=nint((1500.0 + wh)/df) - 2048 + i4=nint((1500.0 + 2.0*wh)/df) - 2048 + +! call pctile(sb(i1),i2-i1,50,r0) +! call pctile(sb(i3+1),i4-i3,50,r1) +! ave=0.5*(r0+r1) +! blue=sa/ave +! red=sb/ave + + baseline=(sum(sb(i1:i2-1)) + sum(sb(i3+1:i4)))/(i2+i4-i1-i3) + blue=sa/baseline + red=sb/baseline + psig=sum(red(i2:i3)-1.0) + pnoise_2500 = 2500.0/df + snrdb=db(psig/pnoise_2500) + + smax=0. + mh=max(1,nint(0.2*fspread/df)) + do i=i2,i3 + ssum=sum(red(i-mh:i+mh)) + if(ssum.gt.smax) then + smax=ssum + ipk=i + endif + enddo + fpeak=ipk*df - 750.0 + + call averms(red(i1:i2-1),i2-i1,-1,ave1,rms1) + call averms(red(i3+1:i4),i4-i3,-1,ave2,rms2) + perr=0.707*(rms1+rms2)*sqrt(float(i2-i1+i4-i3)) + snr_detect=psig/perr + db_err=99.0 + if(psig.gt.perr) db_err=snrdb - db((psig-perr)/pnoise_2500) + if(db_err.lt.0.5) db_err=0.5 + + return +end subroutine echo_snr diff --git a/wsjtx_lib/lib/echosim.f90 b/wsjtx_lib/lib/echosim.f90 new file mode 100644 index 0000000..96854aa --- /dev/null +++ b/wsjtx_lib/lib/echosim.f90 @@ -0,0 +1,126 @@ +program echosim + +! Generate simulated echo-mode files -- self-echo or "measure" + + use wavhdr + parameter (NWAVE=27648,NMAX=32768,NZ=36000) + type(hdr) h !Header for .wav file + character arg*12,fname*17 + complex c0(0:NMAX-1) + complex c(0:NMAX-1) + real*4 level_1,level_2 + real*8 f0,dt,twopi,phi,dphi + real wave(NZ) + integer*2 iwave(NZ) !Generated full-length waveform + equivalence (nDop0,iwave(1)) + equivalence (nDopAudio0,iwave(3)) + equivalence (nfrit0,iwave(5)) + equivalence (f10,iwave(7)) + equivalence (fspread0,iwave(9)) + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.3 .and. nargs.ne.5) then + print*,'Usage 1: echosim f0 fdop fspread nfiles snr' + print*,'Example: echosim 1500 0.0 4.0 10 -22' + print*,'Usage 2: echosim level_1 level_2 nfiles' + print*,'Example: echosim 30.0 40.0 100' + go to 999 + endif + + call getarg(1,arg) + read(arg,*) f0 !Tone frequency + call getarg(2,arg) + read(arg,*) fdop !Doppler shift (Hz) + call getarg(3,arg) + read(arg,*) fspread !Frequency spread (Hz) (JHT Lorentzian model) + + if(nargs.eq.3) then + level_1=f0 + level_2=fdop + nfiles=fspread + snrdb=0. + go to 10 + endif + + call getarg(4,arg) + read(arg,*) nfiles !Number of files + call getarg(5,arg) + read(arg,*) snrdb !SNR_2500 + +10 twopi=8.d0*atan(1.d0) + fs=12000.0 !Sample rate (Hz) + dt=1.d0/fs !Sample interval (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 + dphi=twopi*(f0+fdop)*dt + + write(*,1000) +1000 format(' N f0 fDop fSpread SNR File name'/51('-')) + + do ifile=1,nfiles + wave=0. + + if(nargs.eq.5) then + phi=0.d0 + do i=0,NWAVE-1 + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + c0(i)=cmplx(cos(xphi),sin(xphi)) + enddo + c0(NWAVE:)=0. + if(fspread.gt.0.0) call fspread_lorentz(c0,fspread) + c=sig*c0 + wave(1:NWAVE)=imag(c(1:NWAVE)) + peak=maxval(abs(wave)) + endif + + if(snrdb.lt.90) then + do i=1,NWAVE !Add gaussian noise at specified SNR + xnoise=gran() + wave(i)=wave(i) + xnoise + enddo + do i=NWAVE+1,NZ + xnoise=gran() + wave(i)=xnoise + enddo + endif + + gain=100.0 + if(nargs.eq.3) then + gain=10.0**(0.05*level_1) + if(mod((ifile-1)/10,2).eq.1) gain=10.0**(0.05*level_2) + endif + 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) + + nDop0=nint(fdop) + nDopAudio0=0 + nfrit0=0 + f10=f0 + fdop + fspread0=fspread + + h=default_header(12000,NMAX) + n=3*(ifile-1) + ihr=n/3600 + imin=(n-3600*ihr)/60 + isec=mod(n,60) + write(fname,1102) ihr,imin,isec +1102 format('000000_',3i2.2,'.wav') + open(10,file=fname,status='unknown',access='stream') + write(10) h,iwave !Save to *.wav file + close(10) + write(*,1110) ifile,f0,fdop,fspread,snrdb,fname +1110 format(i4,4f7.1,2x,a17) + enddo + +999 end program echosim diff --git a/wsjtx_lib/lib/emedop.dat b/wsjtx_lib/lib/emedop.dat new file mode 100644 index 0000000..c37d5b8 --- /dev/null +++ b/wsjtx_lib/lib/emedop.dat @@ -0,0 +1,8 @@ +Lat_A 40.35417 +WLong_A 75.62500 +Lat_B 45.1875 +WLong_B -1.541667 +TxFreqMHz 143.05 +StartTime 20180907 08:00:00 +StopTime 20180907 09:00:00 +StepSec 60.0 diff --git a/wsjtx_lib/lib/emedop.f90 b/wsjtx_lib/lib/emedop.f90 new file mode 100644 index 0000000..4a95fb8 --- /dev/null +++ b/wsjtx_lib/lib/emedop.f90 @@ -0,0 +1,67 @@ +program emedop + + real*8 txfreq8 + real*8 rxfreq8 + real*4 LST + real*4 lat_a + real*4 lat_b + character*80 infile + character*256 jpleph_file_name + common/jplcom/jpleph_file_name + data jpleph_file_name/'JPLEPH'/ + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: emedop ' + go to 999 + endif + + call getarg(1,infile) + open(10,file=infile,status='old',err=900) + read(10,1001) lat_a +1001 format(10x,f12.0) + read(10,1001) wlon_a + read(10,1001) lat_b + read(10,1001) wlon_b + read(10,1001) txfreq8 + read(10,1002) nyear,month,nday,ih,im,is +1002 format(10x,i4,2i2,1x,i2,1x,i2,1x,i2) + sec_start=3600.0*ih + 60.0*im + is + read(10,1002) nyear,month,nday,ih,im,is + sec_stop=3600.0*ih + 60.0*im + is + read(10,1001) sec_step + + write(*,1005) +1005 format(' Date UTC Tx Freq Rx Freq Doppler'/ & + '------------------------------------------------------') + + sec=sec_start + ncalc=(sec_stop - sec_start)/sec_step + + do icalc=1,ncalc + uth=sec/3600.0 + call MoonDopJPL(nyear,month,nday,uth,-wlon_a,lat_a,RAMoon,DecMoon, & + LST,HA,AzMoon,ElMoon,vr_a,techo) + + call MoonDopJPL(nyear,month,nday,uth,-wlon_b,lat_b,RAMoon,DecMoon, & + LST,HA,AzMoon,ElMoon,vr_b,techo) + + dop_a=-txfreq8*vr_a/2.99792458e5 !One-way Doppler from a + dop_b=-txfreq8*vr_b/2.99792458e5 !One-way Doppler to b + doppler=1.e6*(dop_a + dop_b) + rxfreq8=txfreq8 + dop_a + dop_b + + ih=sec/3600.0 + im=(sec-ih*3600.0)/60.0 + is=nint(mod(sec,60.0)) + write(*,1010) nyear,month,nday,ih,im,is,txFreq8,rxFreq8,doppler +1010 format(i4,2i2.2,2x,i2.2,':',i2.2,':',i2.2,2f13.7,f8.1) + + sec=sec + sec_step + enddo + go to 999 +900 print*,'Cannot open file ',trim(infile) +999 end program emedop + + + diff --git a/wsjtx_lib/lib/encode232.f90 b/wsjtx_lib/lib/encode232.f90 new file mode 100644 index 0000000..491f204 --- /dev/null +++ b/wsjtx_lib/lib/encode232.f90 @@ -0,0 +1,33 @@ +subroutine encode232(dat,nsym,symbol) + +! Convolutional encoder for a K=32, r=1/2 code. + + integer*1 dat(13) !User data, packed 8 bits per byte + integer*1 symbol(206) !Channel symbols, one bit per byte + integer*1 i1 + include 'conv232.f90' + + nstate=0 + k=0 + do j=1,nsym + do i=7,0,-1 + i1=dat(j) + i4=i1 + if (i4.lt.0) i4=i4+256 + nstate=ior(ishft(nstate,1),iand(ishft(i4,-i),1)) + n=iand(nstate,npoly1) + n=ieor(n,ishft(n,-16)) + k=k+1 + symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255)) + n=iand(nstate,npoly2) + n=ieor(n,ishft(n,-16)) + k=k+1 + symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255)) + if(k.ge.nsym) go to 100 + enddo + enddo + +100 continue + + return +end subroutine encode232 diff --git a/wsjtx_lib/lib/encode4.f90 b/wsjtx_lib/lib/encode4.f90 new file mode 100644 index 0000000..bf1f0a8 --- /dev/null +++ b/wsjtx_lib/lib/encode4.f90 @@ -0,0 +1,20 @@ +subroutine encode4(message,ncode) + + use packjt + parameter (MAXCALLS=7000,MAXRPT=63) + integer ncode(206) + character*22 message !Message to be generated + character*3 cok !' ' or 'OOO' + integer dgen(13) + integer*1 data0(13),symbol(216) + + call chkmsg(message,cok,nspecial,flip) + call packmsg(message,dgen,itype) !Pack 72-bit message into 12 six-bit symbols + call entail(dgen,data0) + call encode232(data0,206,symbol) !Convolutional encoding + call interleave4(symbol,1) !Apply JT4 interleaving + do i=1,206 + ncode(i)=symbol(i) + enddo + +end subroutine encode4 diff --git a/wsjtx_lib/lib/encode_128_90.f90 b/wsjtx_lib/lib/encode_128_90.f90 new file mode 100644 index 0000000..e59cf11 --- /dev/null +++ b/wsjtx_lib/lib/encode_128_90.f90 @@ -0,0 +1,58 @@ +subroutine encode_128_90(message77,codeword) +! +! Add a 13-bit CRC to a 77-bit message and return a 128-bit codeword +! +use, intrinsic :: iso_c_binding +use iso_c_binding, only: c_loc,c_size_t +use crc + +integer, parameter:: N=128, K=90, M=N-K +character*90 tmpchar +integer*1 codeword(N) +integer*1 gen(M,K) +integer*1 message77(77),message(K) +integer*1 pchecks(M) +integer*1, target :: i1MsgBytes(12) +include "ldpc_128_90_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,23 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.23) 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 + +! Add 13 bit CRC to form 90-bit message+CRC13 +write(tmpchar,'(77i1)') message77 +tmpchar(78:80)='000' +i1MsgBytes=0 +read(tmpchar,'(10b8)') i1MsgBytes(1:10) +ncrc13 = crc13 (c_loc (i1MsgBytes), 12) +write(tmpchar(78:90),'(b13)') ncrc13 +read(tmpchar,'(90i1)') message + +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 encode_128_90 diff --git a/wsjtx_lib/lib/encode_msk40.f90 b/wsjtx_lib/lib/encode_msk40.f90 new file mode 100644 index 0000000..9c53255 --- /dev/null +++ b/wsjtx_lib/lib/encode_msk40.f90 @@ -0,0 +1,46 @@ +subroutine encode_msk40(message,codeword) +! Encode a 16-bit message and return a 32-bit codeword. +! The code is a (32,16) regular ldpc code with column weight 3. +! The code was generated using the PEG algorithm. +! After creating the codeword, the columns are re-ordered according to +! "colorder" to make the codeword compatible with the parity-check +! matrix stored in Radford Neal's "pchk" format. +! +integer*1 codeword(32) +integer*1 colorder(32) +integer g(16) +integer*1 gen40(16,16) +integer*1 itmp(32) +integer*1 message(16) +integer*1 pchecks(16) +logical first +data first/.true./ +data g/Z'4428',Z'5a6b',Z'1b04',Z'2c12',Z'60c4',Z'1071',Z'be6a',Z'36dd', & + Z'c580',Z'ad9a',Z'eca2',Z'7843',Z'332e',Z'a685',Z'5906',Z'1efe'/ +data colorder/4,1,2,3,0,8,6,10,13,28,20,23,17,15,27,25, & + 16,12,18,19,7,21,22,11,24,5,26,14,9,29,30,31/ +save first,gen40 + +if( first ) then ! fill the generator matrix + gen40=0 + do i=1,16 + do j=1,16 + if( btest(g(i),16-j) ) gen40(i,j)=1 + enddo + enddo + first=.false. +endif + +do i=1,16 + nsum=0 + do j=1,16 + nsum=nsum+message(j)*gen40(i,j) + enddo + pchecks(i)=mod(nsum,2) +enddo +itmp(1:16)=pchecks +itmp(17:32)=message(1:16) +codeword(colorder+1)=itmp(1:32) + +return +end subroutine encode_msk40 diff --git a/wsjtx_lib/lib/encode_rs.c b/wsjtx_lib/lib/encode_rs.c new file mode 100644 index 0000000..9d56d0b --- /dev/null +++ b/wsjtx_lib/lib/encode_rs.c @@ -0,0 +1,47 @@ +/* Reed-Solomon encoder + * Copyright 2002, Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ +#include + +#ifdef FIXED +#include "fixed.h" +#elif defined(BIGSYM) +#include "int.h" +#else +#include "char.h" +#endif + +void ENCODE_RS( +#ifndef FIXED +void *p, +#endif +DTYPE *data, DTYPE *bb){ +#ifndef FIXED + struct rs *rs = (struct rs *)p; +#endif + int i, j; + DTYPE feedback; + + memset(bb,0,NROOTS*sizeof(DTYPE)); + + for(i=0;i=0) +! ltext true if decoded message is free text +! nft 0=no decode; 1=FT decode; 2=hinted decode + + use prog_args !shm_key, exe_dir, data_dir + use packjt + use jt65_mod + use timer_module, only: timer + + real s3(64,63) + character decoded*22, apmessage*22 + character*12 mycall_12,hiscall_12 + character*6 mycall,hiscall,hisgrid + character*6 mycall0,hiscall0,hisgrid0 + integer apsymbols(7,12),ap(12) + integer nappasses(0:5) ! the number of decoding passes to use for each QSO state + integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now + integer dat4(12) + integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63) + integer correct(63),tmp(63) + logical first,ltext,ljt65apon + common/chansyms65/correct + data first/.true./ + save + + if(mode65.eq.-99) stop !Silence compiler warning + if(first) then + +! aptype +!------------------------ +! 1 CQ ??? ??? +! 2 MyCall ??? ??? +! 3 MyCall DxCall ??? +! 4 MyCall DxCall RRR +! 5 MyCall DxCall 73 +! 6 MyCall DxCall DxGrid +! 7 CQ DxCall DxGrid + + apsymbols=-1 + nappasses=(/3,4,2,3,3,4/) + naptypes(0,1:4)=(/1,2,6,0/) ! Tx6 + naptypes(1,1:4)=(/2,3,6,7/) ! Tx1 + naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 + naptypes(3,1:4)=(/3,4,5,0/) ! Tx3 + naptypes(4,1:4)=(/3,4,5,0/) ! Tx4 + naptypes(5,1:4)=(/2,3,4,5/) ! Tx5 + first=.false. + endif + + mycall=mycall_12(1:6) + hiscall=hiscall_12(1:6) +! Fill apsymbols array + if(ljt65apon .and. & + (mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. hisgrid.ne.hisgrid0)) then +!write(*,*) 'initializing apsymbols ' + apsymbols=-1 + mycall0=mycall + hiscall0=hiscall + ap=-1 + apsymbols(1,1:4)=(/62,32,32,49/) ! CQ + if(len_trim(mycall).gt.0) then + apmessage=mycall//" "//mycall//" RRR" + call packmsg(apmessage,ap,itype) + if(itype.ne.1) ap=-1 + apsymbols(2,1:4)=ap(1:4) +!write(*,*) 'mycall symbols ',ap(1:4) + if(len_trim(hiscall).gt.0) then + apmessage=mycall//" "//hiscall//" RRR" + call packmsg(apmessage,ap,itype) + if(itype.ne.1) ap=-1 + apsymbols(3,1:9)=ap(1:9) + apsymbols(4,:)=ap + apmessage=mycall//" "//hiscall//" 73" + call packmsg(apmessage,ap,itype) + if(itype.ne.1) ap=-1 + apsymbols(5,:)=ap + if(len_trim(hisgrid(1:4)).gt.0) then + apmessage=mycall//' '//hiscall//' '//hisgrid(1:4) + call packmsg(apmessage,ap,itype) + if(itype.ne.1) ap=-1 + apsymbols(6,:)=ap + apmessage='CQ'//' '//hiscall//' '//hisgrid(1:4) + call packmsg(apmessage,ap,itype) + if(itype.ne.1) ap=-1 + apsymbols(7,:)=ap + endif + endif + endif + endif + + qual=0. + nbirdie=20 + npct=50 + afac1=1.1 + nft=0 + nfail=0 + decoded=' ' + call pctile(s3,4032,npct,base) + s3=s3/base + s3a=s3 !### + +! Get most reliable and second-most-reliable symbol values, and their +! probabilities +1 call demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) + + call chkhist(mrsym,nhist,ipk) !Test for birdies and QRM + if(nhist.ge.nbirdie) then + nfail=nfail+1 + call pctile(s3,4032,npct,base) + s3(ipk,1:63)=base + if(nfail.gt.30) then + decoded=' ' + ncount=-1 + go to 900 + endif + go to 1 + endif + + mrs=mrsym + mrs2=mr2sym + + call graycode65(mrsym,63,-1) !Remove gray code + call interleave63(mrsym,-1) !Remove interleaving + call interleave63(mrprob,-1) + + call graycode65(mr2sym,63,-1) !Remove gray code and interleaving + call interleave63(mr2sym,-1) !from second-most-reliable symbols + call interleave63(mr2prob,-1) + + npass=1 ! if ap decoding is disabled + if(ljt65apon .and. len_trim(mycall).gt.0) then + npass=1+nappasses(nQSOProgress) +!write(*,*) 'ap is on: ',npass-1,'ap passes of types ',naptypes(nQSOProgress,:) + endif + do ipass=1,npass + ap=-1 + ntype=0 + if(ipass.gt.1) then + ntype=naptypes(nQSOProgress,ipass-1) +!write(*,*) 'ap pass, type ',ntype + ap=apsymbols(ntype,:) + if(count(ap.ge.0).eq.0) cycle ! don't bother if all ap symbols are -1 +!write(*,'(12i3)') ap + endif + ntry=0 + call timer('ftrsd ',0) + param=0 + call ftrsdap(mrsym,mrprob,mr2sym,mr2prob,ap,ntrials,correct,param,ntry) + call timer('ftrsd ',1) + ncandidates=param(0) + nhard=param(1) + nsoft=param(2) + nerased=param(3) + rtt=0.001*param(4) + ntotal=param(5) + qual=0.001*param(7) + nd0=81 + r0=0.87 + if(naggressive.eq.10) then + nd0=83 + r0=0.90 + endif + + if(ntotal.le.nd0 .and. rtt.le.r0) then + nft=1+ishft(ntype,2) + endif + + if(nft.gt.0) exit + enddo + if(nft.eq.0 .and. iand(ndepth,32).eq.32) then + qmin=2.0 - 0.1*naggressive + call timer('hint65 ',0) + call hint65(s3,mrs,mrs2,nadd,nflip,mycall,hiscall,hisgrid,qual,decoded) + if(qual.ge.qmin) then + nft=2 + ncount=0 + else + decoded=' ' + ntry=0 + endif + call timer('hint65 ',1) + go to 900 + endif + + ncount=-1 + decoded=' ' + ltext=.false. + if(nft.gt.0) then +! Turn the corrected symbol array into channel symbols for subtraction; +! pass it back to jt65a via common block "chansyms65". + do i=1,12 + dat4(i)=correct(13-i) + enddo + do i=1,63 + tmp(i)=correct(64-i) + enddo + correct(1:63)=tmp(1:63) + call interleave63(correct,1) + call graycode65(correct,63,1) + call unpackmsg(dat4,decoded) !Unpack the user message + ncount=0 + if(iand(dat4(10),8).ne.0) ltext=.true. + endif +900 continue + if(nft.eq.1 .and. nhard.lt.0) decoded=' ' + + return +end subroutine extract + +subroutine getpp(workdat,p) + + use jt65_mod + integer workdat(63) + integer a(63) + + a(1:63)=workdat(63:1:-1) + call interleave63(a,1) + call graycode(a,63,1,a) + + psum=0. + do j=1,63 + i=a(j)+1 + x=s3a(i,j) + s3a(i,j)=0. + psum=psum + x + s3a(i,j)=x + enddo + p=psum/63.0 + + return +end subroutine getpp diff --git a/wsjtx_lib/lib/extract4.f90 b/wsjtx_lib/lib/extract4.f90 new file mode 100644 index 0000000..ce8fb86 --- /dev/null +++ b/wsjtx_lib/lib/extract4.f90 @@ -0,0 +1,69 @@ +subroutine extract4(sym0,ncount,decoded) + + use packjt + real sym0(207) + real sym(207) + character decoded*22 + character*72 c72 + integer*1 symbol(207) + integer*1 data1(13) !Decoded data (8-bit bytes) + integer data4a(9) !Decoded data (8-bit bytes) + integer data4(12) !Decoded data (6-bit bytes) + integer mettab(-128:127,0:1) !Metric table + logical first + data first/.true./ + save first,mettab,ndelta + + if(first) then + call getmet4(mettab,ndelta) + first=.false. + endif + +!### Optimize these params: ... + amp=30.0 + limit=10000 + + ave0=sum(sym0)/207.0 + sym=sym0-ave0 + sq=dot_product(sym,sym) + rms0=sqrt(sq/206.0) + sym=sym/rms0 + + do j=1,207 + n=nint(amp*sym(j)) + if(n.lt.-127) n=-127 + if(n.gt.127) n=127 + symbol(j)=n + enddo + + nbits=72 + ncycles=0 + ncount=-1 + decoded=' ' + call interleave4(symbol(2),-1) !Remove the interleaving + call fano232(symbol(2),nbits+31,mettab,ndelta,limit,data1, & + ncycles,metric,ncount) + nlim=ncycles/(nbits+31) + +!### Make usage here like that in jt9fano... + if(ncount.ge.0) then + do i=1,9 + i4=data1(i) + if(i4.lt.0) i4=i4+256 + data4a(i)=i4 + enddo + write(c72,1100) (data4a(i),i=1,9) +1100 format(9b8.8) + read(c72,1102) data4 +1102 format(12b6) + + call unpackmsg(data4,decoded) + if(decoded(1:6).eq.'000AAA') then +! decoded='***WRONG MODE?***' + decoded=' ' + ncount=-1 + endif + endif + + return +end subroutine extract4 diff --git a/wsjtx_lib/lib/extractmessage77.f90 b/wsjtx_lib/lib/extractmessage77.f90 new file mode 100644 index 0000000..d2b41e3 --- /dev/null +++ b/wsjtx_lib/lib/extractmessage77.f90 @@ -0,0 +1,17 @@ +subroutine extractmessage77(decoded77,msgreceived) + use packjt + + character*22 msgreceived + character*77 cbits + integer*1 decoded77(77) + integer*4 i4Dec6BitWords(12) + + write(cbits,'(77i1)') decoded77 +!**** Temporary: For now, just handle i5bit=0. + read(cbits,'(12b6)') i4Dec6BitWords + read(cbits,'(72x,i5.5)') i5bit + if( i5bit .eq. 0 ) then + call unpackmsg(i4Dec6BitWords,msgreceived) + endif + return +end subroutine extractmessage77 diff --git a/wsjtx_lib/lib/fano232.f90 b/wsjtx_lib/lib/fano232.f90 new file mode 100644 index 0000000..8888624 --- /dev/null +++ b/wsjtx_lib/lib/fano232.f90 @@ -0,0 +1,138 @@ +subroutine fano232(symbol,nbits,mettab,ndelta,maxcycles,dat, & + ncycles,metric,ierr) + +! Sequential decoder for K=32, r=1/2 convolutional code using +! the Fano algorithm. Translated from C routine for same purpose +! written by Phil Karn, KA9Q. + + parameter (MAXBITS=103) + parameter (MAXBYTES=13) !(MAXBITS+7)/8 + integer*1 symbol(0:2*MAXBITS-1) !Soft symbols (as unsigned i*1) + integer*1 dat(MAXBYTES) !Decoded user data, 8 bits per byte + integer mettab(-128:127,0:1) !Metric table + +! These were the "node" structure in Karn's C code: + integer nstate(0:MAXBITS) !Encoder state of next node + integer gamma(0:MAXBITS) !Cumulative metric to this node + integer metrics(0:3,0:MAXBITS) !Metrics indexed by all possible Tx syms + integer tm(0:1,0:MAXBITS) !Sorted metrics for current hypotheses + integer ii(0:MAXBITS) !Current branch being tested + + logical noback + include 'conv232.f90' !Polynomials defined here + + ntail=nbits-31 + +! Compute all possible branch metrics for each symbol pair. +! This is the only place we actually look at the raw input symbols + i4a=0 + i4b=0 + do np=0,nbits-1 + j=2*np + i4a=symbol(j) + i4b=symbol(j+1) + metrics(0,np) = mettab(i4a,0) + mettab(i4b,0) + metrics(1,np) = mettab(i4a,0) + mettab(i4b,1) + metrics(2,np) = mettab(i4a,1) + mettab(i4b,0) + metrics(3,np) = mettab(i4a,1) + mettab(i4b,1) + enddo + + np=0 + nstate(np)=0 + + n=iand(nstate(np),npoly1) !Compute and sort branch metrics + n=ieor(n,ishft(n,-16)) !from the root node + lsym=partab(iand(ieor(n,ishft(n,-8)),255)) + n=iand(nstate(np),npoly2) + n=ieor(n,ishft(n,-16)) + lsym=lsym+lsym+partab(iand(ieor(n,ishft(n,-8)),255)) + m0=metrics(lsym,np) + m1=metrics(ieor(3,lsym),np) + if(m0.gt.m1) then + tm(0,np)=m0 !0-branch has better metric + tm(1,np)=m1 + else + tm(0,np)=m1 !1-branch is better + tm(1,np)=m0 + nstate(np)=nstate(np) + 1 !Set low bit + endif + + ii(np)=0 !Start with best branch + gamma(np)=0 + nt=0 + + do i=1,nbits*maxcycles !Start the Fano decoder + ngamma=gamma(np) + tm(ii(np),np) !Look forward + if(ngamma.ge.nt) then +! Node is acceptable. If first time visiting this node, tighten threshold: + if(gamma(np).lt.(nt+ndelta)) nt=nt + ndelta * ((ngamma-nt)/ndelta) + gamma(np+1)=ngamma !Move forward + nstate(np+1)=ishft(nstate(np),1) + np=np+1 + if(np.eq.nbits) go to 100 !We're done! + + n=iand(nstate(np),npoly1) + n=ieor(n,ishft(n,-16)) + lsym=partab(iand(ieor(n,ishft(n,-8)),255)) + n=iand(nstate(np),npoly2) + n=ieor(n,ishft(n,-16)) + lsym=lsym+lsym+partab(iand(ieor(n,ishft(n,-8)),255)) + + if(np.ge.ntail) then + tm(0,np)=metrics(lsym,np) !We're in the tail, now all zeros + else + m0=metrics(lsym,np) + m1=metrics(ieor(3,lsym),np) + if(m0.gt.m1) then + tm(0,np)=m0 !0-branch has better metric + tm(1,np)=m1 + else + tm(0,np)=m1 !1-branch is better + tm(1,np)=m0 + nstate(np)=nstate(np) + 1 !Set low bit + endif + endif + ii(np)=0 !Start with best branch + else + do while(.true.) + noback=.false. !Threshold violated, can't go forward + if(np.eq.0) noback=.true. + if(np.gt.0) then + if(gamma(np-1).lt.nt) noback=.true. + endif + + if(noback) then !Can't back up, either + nt=nt-ndelta !Relax threshold and look forward again + if(ii(np).ne.0) then + ii(np)=0 + nstate(np)=ieor(nstate(np),1) + endif + exit + endif + + np=np-1 !Back up + if(np.lt.ntail .and. ii(np).ne.1) then + ii(np)=ii(np)+1 !Search the next best branch + nstate(np)=ieor(nstate(np),1) + exit + endif + enddo + endif + enddo + i=nbits*maxcycles + +100 metric=gamma(np) !Final path metric + nbytes=(nbits+7)/8 !Copy decoded data to user's buffer + np=7 + do j=1,nbytes-1 + i4a=nstate(np) + dat(j)=int(i4a,1) + np=np+8 + enddo + dat(nbytes)=0 + ncycles=i+1 + ierr=0 + if(i.ge.maxcycles*nbits) ierr=-1 + + return +end subroutine fano232 diff --git a/wsjtx_lib/lib/fast9.f90 b/wsjtx_lib/lib/fast9.f90 new file mode 100644 index 0000000..1214862 --- /dev/null +++ b/wsjtx_lib/lib/fast9.f90 @@ -0,0 +1,191 @@ +subroutine fast9(id2,narg,line) + +! Decoder for "fast9" modes, JT9E to JT9H. + + parameter (NMAX=30*12000,NSAVE=500) + integer*2 id2(0:NMAX) + integer narg(0:14) + integer*1 i1SoftSymbols(207) + integer*1 i1save(207,NSAVE) + integer indx(NSAVE) + integer*8 count0,count1,clkfreq + real s1(720000) !To reserve space. Logically s1(nq,jz) + real s2(240,340) !Symbol spectra at quarter-symbol steps + real ss2(0:8,85) !Folded symbol spectra + real ss3(0:7,69) !Folded spectra without sync symbols + real s(1500) + real ccfsave(NSAVE) + real t0save(NSAVE) + real t1save(NSAVE) + real freqSave(NSAVE) + real t(6) + character*22 msg !Decoded message + character*80 line(100) + data nsubmode0/-1/,ntot/0/ + save s1,nsubmode0,ntot + +! Parameters from GUI are in narg(): + nutc=narg(0) !UTC + npts=min(narg(1),NMAX) !Number of samples in id2 (12000 Hz) + nsubmode=narg(2) !0=A 1=B 2=C 3=D 4=E 5=F 6=G 7=H + if(nsubmode.lt.4) go to 900 + newdat=narg(3) !1==> new data, compute symbol spectra + minsync=narg(4) !Lower sync limit + npick=narg(5) + t0=0.001*narg(6) + t1=0.001*narg(7) + maxlines=narg(8) !Max # of decodes to return to caller + nmode=narg(9) + nrxfreq=narg(10) !Targer Rx audio frequency (Hz) + ntol=narg(11) !Search range, +/- ntol (Hz) + + tmid=npts*0.5/12000.0 + line(1:100)(1:1)=char(0) + s=0 + s2=0 + nsps=60 * 2**(7-nsubmode) !Samples per sysbol + nfft=2*nsps !FFT size + nh=nfft/2 + nq=nfft/4 + istep=nsps/4 !Symbol spectra at quarter-symbol steps + jz=npts/istep + df=12000.0/nfft !FFT bin width + db1=db(2500.0/df) + nfa=max(200,nrxfreq-ntol) !Lower frequency limit + nfb=min(nrxfreq+ntol,2500) !Upper frequency limit + nline=0 + t=0. + + if(newdat.eq.1 .or. nsubmode.ne.nsubmode0) then + call system_clock(count0,clkfreq) + call spec9f(id2,npts,nsps,s1,jz,nq) !Compute symbol spectra, s1 + call system_clock(count1,clkfreq) + t(1)=t(1)+float(count1-count0)/float(clkfreq) + endif + + nsubmode0=nsubmode + tmsg=nsps*85.0/12000.0 + limit=2000 + nlen0=0 + i1=0 + i2=0 + ccfsave=0. + do ilength=1,14 + nlen=1.4142136**(ilength-1) + if(nlen.gt.jz/340) nlen=jz/340 + if(nlen.eq.nlen0) cycle + nlen0=nlen + + db0=db(float(nlen)) + jlen=nlen*340 + jstep=jlen/4 !### Is this about right? ### + if(nsubmode.ge.6) jstep=jlen/2 + + do ja=1,jz-jlen,jstep + jb=ja+jlen-1 + call system_clock(count0,clkfreq) + call foldspec9f(s1,nq,jz,ja,jb,s2) !Fold symbol spectra into s2 + call system_clock(count1,clkfreq) + t(2)=t(2)+float(count1-count0)/float(clkfreq) + +! Find sync; put sync'ed symbol spectra into ss2 and ss3 +! Might want to do a peakup in DT and DF, then re-compute symbol spectra. + + call system_clock(count0,clkfreq) + call sync9f(s2,nq,nfa,nfb,ss2,ss3,lagpk,ipk,ccfbest) + call system_clock(count1,clkfreq) + t(3)=t(3)+float(count1-count0)/float(clkfreq) + + i1=i1+1 + if(ccfbest.lt.30.0) cycle + call system_clock(count0,clkfreq) + call softsym9f(ss2,ss3,i1SoftSymbols) !Compute soft symbols + call system_clock(count1,clkfreq) + t(4)=t(4)+float(count1-count0)/float(clkfreq) + + i2=i2+1 + ccfsave(i2)=ccfbest + i1save(1:207,i2)=i1SoftSymbols + t0=(ja-1)*istep/12000.0 + t1=(jb-1)*istep/12000.0 + t0save(i2)=t0 + t1save(i2)=t1 + freq=ipk*df + freqSave(i2)=freq + enddo + enddo + nsaved=i2 + + ccfsave(1:nsaved)=-ccfsave(1:nsaved) + call system_clock(count0,clkfreq) + indx=0 + call indexx(ccfsave,nsaved,indx) + call system_clock(count1,clkfreq) + t(5)=t(5)+float(count1-count0)/float(clkfreq) + + ccfsave(1:nsaved)=-ccfsave(1:nsaved) + + do iter=1,2 +! do isave=1,nsaved + do isave=1,50 + i2=indx(isave) + if(i2.lt.1 .or. i2.gt.nsaved) cycle !### Why needed? ### + t0=t0save(i2) + t1=t1save(i2) + if(iter.eq.1 .and. t1.lt.tmid) cycle + if(iter.eq.2 .and. t1.ge.tmid) cycle + ccfbest=ccfsave(i2) + i1SoftSymbols=i1save(1:207,i2) + freq=freqSave(i2) + call system_clock(count0,clkfreq) + call jt9fano(i1SoftSymbols,limit,nlim,msg) !Invoke Fano decoder + call system_clock(count1,clkfreq) + t(6)=t(6)+float(count1-count0)/float(clkfreq) + + i=t0*12000.0 + kz=(t1-t0)/0.02 + smax=0. + do k=1,kz + sq=0. + do n=1,240 + i=i+1 + x=id2(i) + sq=sq+x*x + enddo + s(k)=sq/240. + smax=max(s(k),smax) + enddo + call pctile(s,kz,35,base) + snr=smax/(1.1*base) - 1.0 + nsnr=-20 + if(snr.gt.0.0) nsnr=nint(db(snr)) + +! write(72,3002) nutc,iter,isave,nlen,tmid,t0,t1,ccfbest, & +! nint(freq),nlim,msg +!3002 format(i6.6,i1,i4,i3,4f6.1,i5,i7,1x,a22) + + if(msg.ne.' ') then + +! Display multiple decodes only if they differ: + do n=1,nline + if(index(line(n),msg).gt.1) go to 100 + enddo +!### Might want to use decoded message to get a complete estimate of S/N. + nline=nline+1 + write(line(nline),1000) nutc,nsnr,t0,nint(freq),msg,char(0) +1000 format(i6.6,i4,f5.1,i5,1x,'@ ',1x,a22,a1) + ntot=ntot+1 +! write(70,5001) nsaved,isave,nline,maxlines,ntot,nutc,msg +!5001 format(5i5,i7.6,1x,a22) + if(nline.ge.maxlines) go to 900 + endif +100 continue + enddo + enddo + +900 continue +! write(*,6001) t,t(6)/sum(t) +!6001 format(7f10.3) + + return +end subroutine fast9 diff --git a/wsjtx_lib/lib/fast_decode.f90 b/wsjtx_lib/lib/fast_decode.f90 new file mode 100644 index 0000000..c4326cb --- /dev/null +++ b/wsjtx_lib/lib/fast_decode.f90 @@ -0,0 +1,90 @@ +subroutine fast_decode(id2,narg,trperiod,line,mycall_12, & + hiscall_12) + + parameter (NMAX=30*12000) + integer*2 id2(NMAX) + integer*2 id2a(NMAX) + integer*2 id2b(NMAX) + integer narg(0:14) + double precision trperiod + real dat(30*12000) + complex cdat(262145),cdat2(262145) + logical pick,first + character*6 cfile6 + character*80 line(100) + character*12 mycall_12,hiscall_12 + character*6 mycall,hiscall + data first/.true./,nutca/0/,nutcb/0/ + save npts,cdat,cdat2,id2a,id2b,nutca,nutcb + + if(first) then + id2a=0 + id2b=0 + first=.false. + endif + + mycall=mycall_12(1:6) + hiscall=hiscall_12(1:6) + nutc=narg(0) + ndat0=narg(1) + nsubmode=narg(2) + newdat=narg(3) + minsync=narg(4) + npick=narg(5) + t0=0.001*narg(6) + t1=0.001*narg(7) + tmid=0.5*(t0+t1) + maxlines=narg(8) + nmode=narg(9) + nrxfreq=narg(10) + ntol=narg(11) + nhashcalls=narg(12) + + line(1:100)(1:1)=char(0) + if(t0.gt.trperiod) go to 900 + if(t0.gt.t1) go to 900 + + if(nmode.eq.102) then + call fast9(id2,narg,line) + go to 900 + endif + + if(newdat.eq.1) then + cdat2=cdat + ndat=ndat0 + call wav11(id2,ndat,dat) + nzz=11025*int(trperiod) !beware if fractional T/R period ever used here + if(ndat.lt.nzz) dat(ndat+1:nzz)=0.0 + ndat=min(ndat,30*11025) + call ana932(dat,ndat,cdat,npts) !Make downsampled analytic signal + endif + +! Now cdat() is the downsampled analytic signal. +! New sample rate = fsample = BW = 11025 * (9/32) = 3100.78125 Hz +! NB: npts, nsps, etc., are all reduced by 9/32 + + write(cfile6,'(i6.6)') nutc + nfreeze=1 + mousedf=0 + mousebutton=0 + mode4=1 + if(nsubmode.eq.1) mode4=2 + nafc=0 + ndebug=0 + t2=0. + ia=1 + ib=npts + pick=.false. + + if(npick.gt.0) then + pick=.true. + dt=1.0/11025.0 * (32.0/9.0) + ia=t0/dt + 1. + ib=t1/dt + 1. + t2=t0 + endif + jz=ib-ia+1 + line(1:100)(1:1)=char(0) + +900 return +end subroutine fast_decode diff --git a/wsjtx_lib/lib/fcal.f90 b/wsjtx_lib/lib/fcal.f90 new file mode 100644 index 0000000..c9a005e --- /dev/null +++ b/wsjtx_lib/lib/fcal.f90 @@ -0,0 +1,117 @@ +program fcal + +! Compute Intercept (A) and Slope (B) for a series of FreqCal measurements. + parameter(NZ=1000) + implicit real*8 (a-h,o-z) + real*8 fd(NZ),deltaf(NZ),r(NZ) + character infile*50 + character line*80 + character cutc*8 + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: fcal ' + print*,'Example: fcal fmtave.out' + go to 999 + endif + call getarg(1,infile) + + open(10,file=infile,status='old',err=997) + open(12,file='fcal.out',status='unknown') + open(13,file='fcal.plt',status='unknown') + + i=0 + do j=1,9999 + read(10,1000,end=10) line +1000 format(a80) + i0=index(line,' 0 ') + i1=index(line,' 1 ') + if(i0.le.0 .and. i1.le.0) then + read(line,*,err=5) f,df + ncal=1 + i=i+1 + fd(i)=f + deltaf(i)=df + else if(i1.gt.0) then + i=i+1 + read(line,*,err=5) f,df,ncal,nn,rr,cutc + fd(i)=f + deltaf(i)=df + r(i)=0.d0 + endif +5 continue + enddo + +10 iz=i + if(iz.lt.2) go to 998 + call fit(fd,deltaf,r,iz,a,b,sigmaa,sigmab,rms) + + write(*,1002) +1002 format(' Freq DF Meas Freq Resid'/ & + ' (MHz) (Hz) (MHz) (Hz)'/ & + '-----------------------------------------') + do i=1,iz + fm=fd(i) + 1.d-6*deltaf(i) + calfac=1.d0 + 1.d-6*deltaf(i)/fd(i) + write(*,1010) fd(i),deltaf(i),fm,r(i) + write(13,1010) fd(i),deltaf(i),fm,r(i) +1010 format(f8.3,f9.3,f14.9,f9.3,2x,a6) + enddo + calfac=1.d0 + 1.d-6*b + err=1.d-6*sigmab + + if(iz.ge.3) then + write(*,1100) a,b,rms +1100 format(/'A:',f8.2,' Hz B:',f9.4,' ppm StdDev:',f7.3,' Hz') + if(iz.gt.2) write(*,1110) sigmaa,sigmab +1110 format('err:',f6.2,9x,f9.4,23x,f13.9) + else + write(*,1120) a,b +1120 format(/'A:',f8.2,' Hz B:',f9.4) + endif + + write(12,1130) a,b +1130 format(f10.4) + + go to 999 + +997 print*,'Cannot open input file: ',infile + go to 999 +998 print*,'Input file must contain at least 2 valid measurement pairs' + +999 end program fcal + +subroutine fit(x,y,r,iz,a,b,sigmaa,sigmab,rms) + implicit real*8 (a-h,o-z) + real*8 x(iz),y(iz),r(iz) + + sx=0.d0 + sy=0.d0 + sxy=0.d0 + sx2=0.d0 + do i=1,iz + sx=sx + x(i) + sy=sy + y(i) + sxy=sxy + x(i)*y(i) + sx2=sx2 + x(i)*x(i) + enddo + delta=iz*sx2 - sx*sx + a=(sx2*sy - sx*sxy)/delta + b=(iz*sxy - sx*sy)/delta + + sq=0.d0 + do i=1,iz + r(i)=y(i) - (a + b*x(i)) + sq=sq + r(i)**2 + enddo + rms=0. + sigmaa=0. + sigmab=0. + if(iz.ge.3) then + rms=sqrt(sq/(iz-2)) + sigmaa=sqrt(rms*rms*sx2/delta) + sigmab=sqrt(iz*rms*rms/delta) + endif + + return +end subroutine fit diff --git a/wsjtx_lib/lib/fchisq.f90 b/wsjtx_lib/lib/fchisq.f90 new file mode 100644 index 0000000..f84898b --- /dev/null +++ b/wsjtx_lib/lib/fchisq.f90 @@ -0,0 +1,44 @@ +real function fchisq(c3,npts,fsample,a) + + parameter (NMAX=85*16) + complex c3(npts) + complex c4(NMAX) + real a(3) + complex z + data a1,a2,a3/99.,99.,99./ + include 'jt9sync.f90' + save + + if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then + a1=a(1) + a2=a(2) + a3=a(3) + call twkfreq(c3,c4,npts,fsample,a) + endif + +! Get sync power. + nspsd=16 + sum1=0. + sum0=0. + k=-1 + do i=1,85 + z=0. + do j=1,nspsd + k=k+1 + z=z+c4(k+1) + enddo + pp=real(z)**2 + aimag(z)**2 + if(isync(i).eq.1) then + sum1=sum1+pp + else + sum0=sum0+pp + endif + enddo + sync_4992=(sum1/16.0)/(sum0/69.0) - 1.0 !r4992 + sync_4993=sum1/10000.0 !r4993+ +! write(80,3001) 1.e-5*sum1,1.e-5*sum0,sync_4992,sync_4993,sync +!3001 format(5f11.4) + fchisq=-sync_4993 + + return +end function fchisq diff --git a/wsjtx_lib/lib/fchisq0.f90 b/wsjtx_lib/lib/fchisq0.f90 new file mode 100644 index 0000000..2c62f27 --- /dev/null +++ b/wsjtx_lib/lib/fchisq0.f90 @@ -0,0 +1,23 @@ +real function fchisq0(y,npts,a) + + real y(npts),a(4) + +! rewind 51 + chisq = 0. + do i=1,npts + x=i + z=(x-a(3))/(0.5*a(4)) + yfit=a(1) + if(abs(z).lt.3.0) then + d=1.0 + z*z + yfit=a(1) + a(2) * (1.0/d - 0.1) + endif + chisq=chisq + (y(i) - yfit)**2 +! write(51,3001) i,y(i),yfit,y(i)-yfit +!3001 format(i5,3f10.4) + enddo + fchisq0=chisq + + return +end function fchisq0 + diff --git a/wsjtx_lib/lib/fchisq65.f90 b/wsjtx_lib/lib/fchisq65.f90 new file mode 100644 index 0000000..ad5aeb0 --- /dev/null +++ b/wsjtx_lib/lib/fchisq65.f90 @@ -0,0 +1,68 @@ +real function fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) + + use timer_module, only: timer + + parameter (NMAX=60*12000) !Samples per 60 s + complex cx(npts) + real a(5) + complex w,wstep,z + real ss(3000) + complex csx(0:NMAX/8) + data twopi/6.283185307/a1,a2,a3/99.,99.,99./ + save + + call timer('fchisq65',0) + baud=11025.0/4096.0 + nsps=nint(fsample/baud) !Samples per symbol + nsph=nsps/2 !Samples per half-symbol + ndiv=16 !Output ss() steps per symbol + nout=ndiv*npts/nsps + dtstep=1.0/(ndiv*baud) !Time per output step + + if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then + a1=a(1) + a2=a(2) + a3=a(3) + +! Mix and integrate the complex signal + csx(0)=0. + w=1.0 + x0=0.5*(npts+1) + s=2.0/npts + do i=1,npts + x=s*(i-x0) + if(mod(i,100).eq.1) then + p2=1.5*x*x - 0.5 + dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/fsample) + wstep=cmplx(cos(dphi),sin(dphi)) + endif + w=w*wstep + csx(i)=csx(i-1) + w*cx(i) + enddo + endif + +! Compute whole-symbol powers at 1/16-symbol steps. + fac=1.e-4 + do i=1,nout + j=nsps+(i-1)*nsps/16 !steps by 8 samples (1/16 of a symbol) + k=j-nsps + ss(i)=0. + if(k.ge.0 .and. j.le.npts) then + z=csx(j)-csx(k) ! difference over span of 128 pts + ss(i)=fac*(real(z)**2 + aimag(z)**2) + endif + enddo + + ccfmax=0. + call timer('ccf2 ',0) + call ccf2(ss,nout,nflip,ccf,xlagpk) + call timer('ccf2 ',1) + if(ccf.gt.ccfmax) then + ccfmax=ccf + dtmax=xlagpk*dtstep + endif + fchisq65=-ccfmax + call timer('fchisq65',1) + + return +end function fchisq65 diff --git a/wsjtx_lib/lib/fer b/wsjtx_lib/lib/fer new file mode 100644 index 0000000..7a74bf2 --- /dev/null +++ b/wsjtx_lib/lib/fer @@ -0,0 +1,41 @@ +#!/bin/bash + +# jt65 end-to-end simulator. Run enough cases to get a given +# number of successful decodes or a given number of errors +# For better performance, copy this script and jt65, jt65sim +# executables to a ramdisk and run from there. + +mode=C +spread=4.0 + +for i in `seq 0 21`; +do +nruns=0 +ndecodes=0 +ngood=0 +nbad=0 +snr=$((-25+$i)) +#while [ $[ $nruns - $ngood ] -lt 200 ] +#while [ $ngood -lt 200 ] +while [ $nruns -lt 1000 ] +do + rm 000000_0001.wav + ./jt65sim -m $mode -n 1 -d $spread -s \\$snr > /dev/null + rm decoded.txt + ./jt65 -m $mode -a 10 -f 1500 -n 1000 -s 000000_0001.wav > decoded.txt + if [ -e decoded.txt ]; then + nd=$( wc -l < decoded.txt ) + ng=$( grep "K1ABC" decoded.txt | wc -l ) + nb=$[$nd-$ng] + ndecodes=$[$ndecodes + $nd] + ngood=$[$ngood + $ng] + nbad=$[$nbad + $nb] + fi + nruns=$[$nruns + 1] + nmissed=$[$nruns-$ngood] + pe=$( echo "scale=5; $nmissed/$nruns" | bc -l ) + ps=$( echo "scale=5; $ngood/$nruns" | bc -l ) + echo -en snr: $snr nruns: $nruns ndecodes: $ndecodes ngood: $ngood nbad: $nbad nmissed: $nmissed wer: $pe success: $ps"\r" +done +echo snr: $snr nruns: $nruns ndecodes: $ndecodes ngood: $ngood nbad: $nbad nmissed: $nmissed wer: $pe success: $ps +done diff --git a/wsjtx_lib/lib/fer65.f90 b/wsjtx_lib/lib/fer65.f90 new file mode 100644 index 0000000..1284fb5 --- /dev/null +++ b/wsjtx_lib/lib/fer65.f90 @@ -0,0 +1,195 @@ +program fer65 + +! End-to-end simulator for testing JT65. + +! Options +! jt65sim jt65 +!---------------------------------------------------------------- +! -a aggressive +! -d Doppler spread -d depth +! -f Number of files -f freq +! -m (sub)mode -m (sub)mode +! -n number of generated sigs -n ntrials +! -t Time offset (s) -r robust sync +! -p Do not seed random #s -c mycall +! -x hiscall +! -g hisgrid +! -X hinted-decode flags +! -s S/N in 2500 Hz -s single-decode mode + + implicit real*8 (a-h,o-z) + real*8 s(7),sq(7) + character arg*12,cmnd*100,decoded*22,submode*1,csync*1,f1*15,f2*15 + character*12 outfile + logical syncok + + nargs=iargc() + if(nargs.ne.7) then + print*,'Usage: fer65 submode fspread snr1 snr2 Navg DS iters' + print*,'Example: fer65 C 3.0 -28 -12 8 1 1000' + go to 999 + endif + + call getarg(1,submode) + call getarg(2,arg) + read(arg,*) d + call getarg(3,arg) + read(arg,*) snr1 + call getarg(4,arg) + read(arg,*) snr2 + call getarg(5,arg) + read(arg,*) navg + call getarg(6,arg) + read(arg,*) nds + call getarg(7,arg) + read(arg,*) iters + + write(outfile,1001) submode,d,navg,nds +1001 format(a1,f6.2,'_',i2.2,'_',i1) + if(outfile(2:2).eq.' ') outfile(2:2)='0' + if(outfile(3:3).eq.' ') outfile(3:3)='0' + + ndepth=3 + if(navg.gt.1) ndepth=ndepth+16 + if(nds.ne.0) ndepth=ndepth+32 + + dfmax=3 + if(submode.eq.'b' .or. submode.eq.'B') dfmax=6 + if(submode.eq.'c' .or. submode.eq.'C') dfmax=11 + + ntrials=1000 + naggressive=10 + + open(20,file=outfile,status='unknown') + open(21,file='fer65.21',status='unknown') + + write(20,1000) submode,iters,ntrials,naggressive,d,ndepth,navg,nds +1000 format(/'JT65',a1,' Iters:',i5,' T:',i6,' Aggr:',i3, & + ' Dop:',f6.2,' Depth:',i2,' Navg:',i3,' DS:',i2) + write(20,1002) +1002 format(/' dB nsync ngood nbad sync dsnr ', & + 'DT Freq Nsum Width'/85('-')) + flush(20) + + do isnr=0,20 + snr=snr1+isnr + if(snr.gt.snr2) exit + nsync=0 + ngood=0 + nbad=0 + s=0. + sq=0. + do iter=1,iters + write(cmnd,1010) submode,d,snr,navg +1010 format('./jt65sim -n 1 -m ',a1,' -d',f7.2,' -s \\',f5.1,' -f',i3,' >devnull') + call unlink('000000_????.wav') + call system(cmnd) + if(navg.gt.1) then + do i=navg,2,-1 + j=2*i-1 + write(f1,1011) i + write(f2,1011) j +1011 format('000000_',i4.4,'.wav') + call rename(f1,f2) + enddo + endif + call unlink('decoded.txt') + call unlink('fort.13') + isync=0 + nsnr=0 + dt=0. + nfreq=0 + ndrift=0 + nwidth=0 + cmnd='./jt65 -m A -a 10 -c K1ABC -f 1500 -n 1000 -d 5 -s 000000_????.wav > decoded.txt' + cmnd(11:11)=submode + write(cmnd(47:48),'(i2)') ndepth + call system(cmnd) + open(13,file='fort.13',status='old',err=20) + do i=1,navg + read(13,1012) nutc,isync,nsnr,dt,nfreq,ndrift,nwidth,decoded, & + nft,nsum,nsmo +1012 format(i4,i4,i5,f6.2,i5,i4,i3,1x,a22,5x,3i3) + if(nft.gt.0) exit + enddo + close(13) + syncok=abs(dt).lt.0.2 .and. float(abs(nfreq-1500)).lt.dfmax + csync=' ' + if(syncok) csync='*' + write(21,1014) nutc,isync,nsnr,dt,nfreq,ndrift,nwidth, & + nft,nsum,nsmo,csync,decoded(1:16),nft,nsum,nsmo +1014 format(i4,i4,i5,f6.2,i5,i4,3x,4i3,1x,a1,1x,a16,i2,2i3) + flush(21) + + if(syncok) then + nsync=nsync+1 + s(1)=s(1) + isync + sq(1)=sq(1) + isync*isync + s(6)=s(6) + nwidth + sq(6)=sq(6) + nwidth*nwidth + if(decoded.eq.'K1ABC W9XYZ EN37 ') then + ngood=ngood+1 + s(2)=s(2) + nsnr + s(3)=s(3) + dt + s(4)=s(4) + nfreq + s(5)=s(5) + ndrift + s(7)=s(7) + nsum + + sq(2)=sq(2) + nsnr*nsnr + sq(3)=sq(3) + dt*dt + sq(4)=sq(4) + nfreq*nfreq + sq(5)=sq(5) + ndrift*ndrift + sq(7)=sq(7) + nsum*nsum + else if(decoded.ne.' ') then + nbad=nbad+1 + print*,'Nbad:',nbad,decoded + endif + endif +20 continue + fsync=float(nsync)/iter + fgood=float(ngood)/iter + fbad=float(nbad)/iter + write(*,1020) nint(snr),iter,isync,nsnr,dt,nfreq,ndrift,nwidth,fsync, & + fgood,fbad,decoded(1:16),nft,nsum,nsmo +1020 format(i3,i5,i3,i4,f6.2,i5,i3,i3,2f6.3,f7.4,1x,a16,i2,2i3) + enddo + + if(nsync.ge.1) then + xsync=s(1)/nsync + xwidth=s(6)/nsync + endif + esync=0. + if(nsync.ge.2) then + esync=sqrt(sq(1)/nsync - xsync**2) + ewidth=sqrt(sq(6)/nsync - xwidth**2) + endif + + if(ngood.ge.1) then + xsnr=s(2)/ngood + xdt=s(3)/ngood + xfreq=s(4)/ngood + xdrift=s(5)/ngood + xsum=s(7)/ngood + endif + if(ngood.ge.2) then + esnr=sqrt(sq(2)/ngood - xsnr**2) + edt=sqrt(sq(3)/ngood - xdt**2) + efreq=sqrt(sq(4)/ngood - xfreq**2) + edrift=sqrt(sq(5)/ngood - xdrift**2) + esum=sqrt(sq(7)/ngood - xsum**2) + endif + + dsnr=xsnr-snr + dfreq=xfreq-1500.0 + if(ngood.eq.0) then + dsnr=0. + dfreq=0. + endif + write(20,1100) snr,nsync,ngood,nbad,xsync,esync,dsnr,esnr, & + xdt,edt,dfreq,efreq,xsum,esum,xwidth,ewidth +1100 format(f5.1,2i6,i4,2f6.1,f6.1,f5.1,f6.2,f5.2,6f5.1) + flush(20) + if(ngood.ge.int(0.99*iters)) exit + enddo + +999 end program fer65 diff --git a/wsjtx_lib/lib/fersum.f90 b/wsjtx_lib/lib/fersum.f90 new file mode 100644 index 0000000..4a99561 --- /dev/null +++ b/wsjtx_lib/lib/fersum.f90 @@ -0,0 +1,72 @@ +program fersum + + character mode*5 + character infile*40 + real dop(0:9) + real thresh(0:9,12),threshsync(0:9,12) + data dop/0.25,0.5,1.0,2.0,4.0,8.0,16.0,32.0,64.0,128.0/ + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: fersum ' + go to 999 + endif + call getarg(1,infile) + open(10,file=infile,status='old') + thresh=0. + threshsync=0. + + do iblk=1,999 +1 read(10,1002,end=100) mode,iters,ntot,naggr,d,navg,nds +1002 format(a5,8x,i5,4x,i6,7x,i3,6x,f6.2,17x,i3,5x,i2) + write(33,*) iblk,mode + if(mode.eq.' ') go to 1 + read(10,1002) + read(10,1002) + read(10,1002) + + nsync0=0 + ngood0=0 + xsum0=0. + do n=1,99 + read(10,1010,end=100) snr,nsync,ngood,nbad,xsync,esync,dsnr,esnr, & + xdt,edt,dfreq,efreq,xsum,esum,xwidth,ewidth +1010 format(f5.1,2i6i4,2f6.1,f6.1,f5.1,f6.2,f5.2,6f5.1) + if(snr.eq.0.0) exit + if(mode(5:5).eq.'A') nmode=1 + if(mode(5:5).eq.'B') nmode=2 + if(mode(5:5).eq.'C') nmode=3 + j=nint(log(d)/log(2.0) + 2.0) + if(navg.eq.1 .and. nds.eq.0) k=nmode + if(navg.eq.1 .and. nds.eq.1) k=nmode+3 + if(navg.gt.1 .and. nds.eq.0) k=nmode+6 + if(navg.gt.1 .and. nds.eq.1) k=nmode+9 + if(nsync0.le.iters/2 .and. nsync.ge.iters/2) then + threshsync(j,k)=snr-float(nsync-iters/2)/(nsync-nsync0) + endif + if(ngood0.le.iters/2 .and. ngood.ge.iters/2) then + threshold=snr-float(ngood-iters/2)/(ngood-ngood0) + xsumavg=max(1.0,0.5*(xsum0+xsum)) +! write(*,1020) mode,iters,ntot,naggr,d,navg,nds,threshold,xsumavg +!1020 format(a5,i7,i7,i3,f7.2,i3,i3,f7.1,f6.1) + thresh(j,k)=threshold + endif + nsync0=nsync + ngood0=ngood + xsum0=xsum + enddo + enddo + +100 write(12,1100) +1100 format(' ') + do i=0,9 + write(12,1110) dop(i),thresh(i,1:12) +1110 format(f6.2,13f6.1) + enddo + + write(12,1110) + do i=0,9 + write(12,1110) dop(i),threshsync(i,1:12) + enddo + +999 end program fersum diff --git a/wsjtx_lib/lib/fftw3.f03 b/wsjtx_lib/lib/fftw3.f03 new file mode 100644 index 0000000..b8ccc58 --- /dev/null +++ b/wsjtx_lib/lib/fftw3.f03 @@ -0,0 +1,1246 @@ +! Generated automatically. DO NOT EDIT! + + integer, parameter :: C_FFTW_R2R_KIND = C_INT32_T + + integer(C_INT), parameter :: FFTW_R2HC = 0 + integer(C_INT), parameter :: FFTW_HC2R = 1 + integer(C_INT), parameter :: FFTW_DHT = 2 + integer(C_INT), parameter :: FFTW_REDFT00 = 3 + integer(C_INT), parameter :: FFTW_REDFT01 = 4 + integer(C_INT), parameter :: FFTW_REDFT10 = 5 + integer(C_INT), parameter :: FFTW_REDFT11 = 6 + integer(C_INT), parameter :: FFTW_RODFT00 = 7 + integer(C_INT), parameter :: FFTW_RODFT01 = 8 + integer(C_INT), parameter :: FFTW_RODFT10 = 9 + integer(C_INT), parameter :: FFTW_RODFT11 = 10 + integer(C_INT), parameter :: FFTW_FORWARD = -1 + integer(C_INT), parameter :: FFTW_BACKWARD = +1 + integer(C_INT), parameter :: FFTW_MEASURE = 0 + integer(C_INT), parameter :: FFTW_DESTROY_INPUT = 1 + integer(C_INT), parameter :: FFTW_UNALIGNED = 2 + integer(C_INT), parameter :: FFTW_CONSERVE_MEMORY = 4 + integer(C_INT), parameter :: FFTW_EXHAUSTIVE = 8 + integer(C_INT), parameter :: FFTW_PRESERVE_INPUT = 16 + integer(C_INT), parameter :: FFTW_PATIENT = 32 + integer(C_INT), parameter :: FFTW_ESTIMATE = 64 + integer(C_INT), parameter :: FFTW_WISDOM_ONLY = 2097152 + integer(C_INT), parameter :: FFTW_ESTIMATE_PATIENT = 128 + integer(C_INT), parameter :: FFTW_BELIEVE_PCOST = 256 + integer(C_INT), parameter :: FFTW_NO_DFT_R2HC = 512 + integer(C_INT), parameter :: FFTW_NO_NONTHREADED = 1024 + integer(C_INT), parameter :: FFTW_NO_BUFFERING = 2048 + integer(C_INT), parameter :: FFTW_NO_INDIRECT_OP = 4096 + integer(C_INT), parameter :: FFTW_ALLOW_LARGE_GENERIC = 8192 + integer(C_INT), parameter :: FFTW_NO_RANK_SPLITS = 16384 + integer(C_INT), parameter :: FFTW_NO_VRANK_SPLITS = 32768 + integer(C_INT), parameter :: FFTW_NO_VRECURSE = 65536 + integer(C_INT), parameter :: FFTW_NO_SIMD = 131072 + integer(C_INT), parameter :: FFTW_NO_SLOW = 262144 + integer(C_INT), parameter :: FFTW_NO_FIXED_RADIX_LARGE_N = 524288 + integer(C_INT), parameter :: FFTW_ALLOW_PRUNING = 1048576 + + type, bind(C) :: fftw_iodim + integer(C_INT) n, is, os + end type fftw_iodim + type, bind(C) :: fftw_iodim64 + integer(C_INTPTR_T) n, is, os + end type fftw_iodim64 + + interface + type(C_PTR) function fftw_plan_dft(rank,n,in,out,sign,flags) bind(C, name='fftw_plan_dft') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_dft + + type(C_PTR) function fftw_plan_dft_1d(n,in,out,sign,flags) bind(C, name='fftw_plan_dft_1d') + import + integer(C_INT), value :: n + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_dft_1d + + type(C_PTR) function fftw_plan_dft_2d(n0,n1,in,out,sign,flags) bind(C, name='fftw_plan_dft_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_dft_2d + + type(C_PTR) function fftw_plan_dft_3d(n0,n1,n2,in,out,sign,flags) bind(C, name='fftw_plan_dft_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_dft_3d + + type(C_PTR) function fftw_plan_many_dft(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,sign,flags) & + bind(C, name='fftw_plan_many_dft') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_many_dft + + type(C_PTR) function fftw_plan_guru_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(C, name='fftw_plan_guru_dft') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_guru_dft + + type(C_PTR) function fftw_plan_guru_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) & + bind(C, name='fftw_plan_guru_split_dft') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: ri + real(C_DOUBLE), dimension(*), intent(out) :: ii + real(C_DOUBLE), dimension(*), intent(out) :: ro + real(C_DOUBLE), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftw_plan_guru_split_dft + + type(C_PTR) function fftw_plan_guru64_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(C, name='fftw_plan_guru64_dft') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftw_plan_guru64_dft + + type(C_PTR) function fftw_plan_guru64_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) & + bind(C, name='fftw_plan_guru64_split_dft') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: ri + real(C_DOUBLE), dimension(*), intent(out) :: ii + real(C_DOUBLE), dimension(*), intent(out) :: ro + real(C_DOUBLE), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftw_plan_guru64_split_dft + + subroutine fftw_execute_dft(p,in,out) bind(C, name='fftw_execute_dft') + import + type(C_PTR), value :: p + complex(C_DOUBLE_COMPLEX), dimension(*), intent(inout) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + end subroutine fftw_execute_dft + + subroutine fftw_execute_split_dft(p,ri,ii,ro,io) bind(C, name='fftw_execute_split_dft') + import + type(C_PTR), value :: p + real(C_DOUBLE), dimension(*), intent(inout) :: ri + real(C_DOUBLE), dimension(*), intent(inout) :: ii + real(C_DOUBLE), dimension(*), intent(out) :: ro + real(C_DOUBLE), dimension(*), intent(out) :: io + end subroutine fftw_execute_split_dft + + type(C_PTR) function fftw_plan_many_dft_r2c(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) & + bind(C, name='fftw_plan_many_dft_r2c') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + real(C_DOUBLE), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_INT), value :: flags + end function fftw_plan_many_dft_r2c + + type(C_PTR) function fftw_plan_dft_r2c(rank,n,in,out,flags) bind(C, name='fftw_plan_dft_r2c') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + real(C_DOUBLE), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_r2c + + type(C_PTR) function fftw_plan_dft_r2c_1d(n,in,out,flags) bind(C, name='fftw_plan_dft_r2c_1d') + import + integer(C_INT), value :: n + real(C_DOUBLE), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_r2c_1d + + type(C_PTR) function fftw_plan_dft_r2c_2d(n0,n1,in,out,flags) bind(C, name='fftw_plan_dft_r2c_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + real(C_DOUBLE), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_r2c_2d + + type(C_PTR) function fftw_plan_dft_r2c_3d(n0,n1,n2,in,out,flags) bind(C, name='fftw_plan_dft_r2c_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + real(C_DOUBLE), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_r2c_3d + + type(C_PTR) function fftw_plan_many_dft_c2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) & + bind(C, name='fftw_plan_many_dft_c2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_INT), value :: flags + end function fftw_plan_many_dft_c2r + + type(C_PTR) function fftw_plan_dft_c2r(rank,n,in,out,flags) bind(C, name='fftw_plan_dft_c2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_c2r + + type(C_PTR) function fftw_plan_dft_c2r_1d(n,in,out,flags) bind(C, name='fftw_plan_dft_c2r_1d') + import + integer(C_INT), value :: n + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_c2r_1d + + type(C_PTR) function fftw_plan_dft_c2r_2d(n0,n1,in,out,flags) bind(C, name='fftw_plan_dft_c2r_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_c2r_2d + + type(C_PTR) function fftw_plan_dft_c2r_3d(n0,n1,n2,in,out,flags) bind(C, name='fftw_plan_dft_c2r_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_dft_c2r_3d + + type(C_PTR) function fftw_plan_guru_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftw_plan_guru_dft_r2c') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_guru_dft_r2c + + type(C_PTR) function fftw_plan_guru_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftw_plan_guru_dft_c2r') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_guru_dft_c2r + + type(C_PTR) function fftw_plan_guru_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) & + bind(C, name='fftw_plan_guru_split_dft_r2c') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: ro + real(C_DOUBLE), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftw_plan_guru_split_dft_r2c + + type(C_PTR) function fftw_plan_guru_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) & + bind(C, name='fftw_plan_guru_split_dft_c2r') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: ri + real(C_DOUBLE), dimension(*), intent(out) :: ii + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_guru_split_dft_c2r + + type(C_PTR) function fftw_plan_guru64_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftw_plan_guru64_dft_r2c') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_guru64_dft_r2c + + type(C_PTR) function fftw_plan_guru64_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftw_plan_guru64_dft_c2r') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_guru64_dft_c2r + + type(C_PTR) function fftw_plan_guru64_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) & + bind(C, name='fftw_plan_guru64_split_dft_r2c') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: ro + real(C_DOUBLE), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftw_plan_guru64_split_dft_r2c + + type(C_PTR) function fftw_plan_guru64_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) & + bind(C, name='fftw_plan_guru64_split_dft_c2r') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: ri + real(C_DOUBLE), dimension(*), intent(out) :: ii + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftw_plan_guru64_split_dft_c2r + + subroutine fftw_execute_dft_r2c(p,in,out) bind(C, name='fftw_execute_dft_r2c') + import + type(C_PTR), value :: p + real(C_DOUBLE), dimension(*), intent(inout) :: in + complex(C_DOUBLE_COMPLEX), dimension(*), intent(out) :: out + end subroutine fftw_execute_dft_r2c + + subroutine fftw_execute_dft_c2r(p,in,out) bind(C, name='fftw_execute_dft_c2r') + import + type(C_PTR), value :: p + complex(C_DOUBLE_COMPLEX), dimension(*), intent(inout) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + end subroutine fftw_execute_dft_c2r + + subroutine fftw_execute_split_dft_r2c(p,in,ro,io) bind(C, name='fftw_execute_split_dft_r2c') + import + type(C_PTR), value :: p + real(C_DOUBLE), dimension(*), intent(inout) :: in + real(C_DOUBLE), dimension(*), intent(out) :: ro + real(C_DOUBLE), dimension(*), intent(out) :: io + end subroutine fftw_execute_split_dft_r2c + + subroutine fftw_execute_split_dft_c2r(p,ri,ii,out) bind(C, name='fftw_execute_split_dft_c2r') + import + type(C_PTR), value :: p + real(C_DOUBLE), dimension(*), intent(inout) :: ri + real(C_DOUBLE), dimension(*), intent(inout) :: ii + real(C_DOUBLE), dimension(*), intent(out) :: out + end subroutine fftw_execute_split_dft_c2r + + type(C_PTR) function fftw_plan_many_r2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,kind,flags) & + bind(C, name='fftw_plan_many_r2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + real(C_DOUBLE), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftw_plan_many_r2r + + type(C_PTR) function fftw_plan_r2r(rank,n,in,out,kind,flags) bind(C, name='fftw_plan_r2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftw_plan_r2r + + type(C_PTR) function fftw_plan_r2r_1d(n,in,out,kind,flags) bind(C, name='fftw_plan_r2r_1d') + import + integer(C_INT), value :: n + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), value :: kind + integer(C_INT), value :: flags + end function fftw_plan_r2r_1d + + type(C_PTR) function fftw_plan_r2r_2d(n0,n1,in,out,kind0,kind1,flags) bind(C, name='fftw_plan_r2r_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), value :: kind0 + integer(C_FFTW_R2R_KIND), value :: kind1 + integer(C_INT), value :: flags + end function fftw_plan_r2r_2d + + type(C_PTR) function fftw_plan_r2r_3d(n0,n1,n2,in,out,kind0,kind1,kind2,flags) bind(C, name='fftw_plan_r2r_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), value :: kind0 + integer(C_FFTW_R2R_KIND), value :: kind1 + integer(C_FFTW_R2R_KIND), value :: kind2 + integer(C_INT), value :: flags + end function fftw_plan_r2r_3d + + type(C_PTR) function fftw_plan_guru_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) & + bind(C, name='fftw_plan_guru_r2r') + import + integer(C_INT), value :: rank + type(fftw_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftw_plan_guru_r2r + + type(C_PTR) function fftw_plan_guru64_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) & + bind(C, name='fftw_plan_guru64_r2r') + import + integer(C_INT), value :: rank + type(fftw_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftw_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_DOUBLE), dimension(*), intent(out) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftw_plan_guru64_r2r + + subroutine fftw_execute_r2r(p,in,out) bind(C, name='fftw_execute_r2r') + import + type(C_PTR), value :: p + real(C_DOUBLE), dimension(*), intent(inout) :: in + real(C_DOUBLE), dimension(*), intent(out) :: out + end subroutine fftw_execute_r2r + + subroutine fftw_destroy_plan(p) bind(C, name='fftw_destroy_plan') + import + type(C_PTR), value :: p + end subroutine fftw_destroy_plan + + subroutine fftw_forget_wisdom() bind(C, name='fftw_forget_wisdom') + import + end subroutine fftw_forget_wisdom + + subroutine fftw_cleanup() bind(C, name='fftw_cleanup') + import + end subroutine fftw_cleanup + + subroutine fftw_set_timelimit(t) bind(C, name='fftw_set_timelimit') + import + real(C_DOUBLE), value :: t + end subroutine fftw_set_timelimit + + subroutine fftw_plan_with_nthreads(nthreads) bind(C, name='fftw_plan_with_nthreads') + import + integer(C_INT), value :: nthreads + end subroutine fftw_plan_with_nthreads + + integer(C_INT) function fftw_init_threads() bind(C, name='fftw_init_threads') + import + end function fftw_init_threads + + subroutine fftw_cleanup_threads() bind(C, name='fftw_cleanup_threads') + import + end subroutine fftw_cleanup_threads + + integer(C_INT) function fftw_export_wisdom_to_filename(filename) bind(C, name='fftw_export_wisdom_to_filename') + import + character(C_CHAR), dimension(*), intent(in) :: filename + end function fftw_export_wisdom_to_filename + + subroutine fftw_export_wisdom_to_file(output_file) bind(C, name='fftw_export_wisdom_to_file') + import + type(C_PTR), value :: output_file + end subroutine fftw_export_wisdom_to_file + + type(C_PTR) function fftw_export_wisdom_to_string() bind(C, name='fftw_export_wisdom_to_string') + import + end function fftw_export_wisdom_to_string + + subroutine fftw_export_wisdom(write_char,data) bind(C, name='fftw_export_wisdom') + import + type(C_FUNPTR), value :: write_char + type(C_PTR), value :: data + end subroutine fftw_export_wisdom + + integer(C_INT) function fftw_import_system_wisdom() bind(C, name='fftw_import_system_wisdom') + import + end function fftw_import_system_wisdom + + integer(C_INT) function fftw_import_wisdom_from_filename(filename) bind(C, name='fftw_import_wisdom_from_filename') + import + character(C_CHAR), dimension(*), intent(in) :: filename + end function fftw_import_wisdom_from_filename + + integer(C_INT) function fftw_import_wisdom_from_file(input_file) bind(C, name='fftw_import_wisdom_from_file') + import + type(C_PTR), value :: input_file + end function fftw_import_wisdom_from_file + + integer(C_INT) function fftw_import_wisdom_from_string(input_string) bind(C, name='fftw_import_wisdom_from_string') + import + character(C_CHAR), dimension(*), intent(in) :: input_string + end function fftw_import_wisdom_from_string + + integer(C_INT) function fftw_import_wisdom(read_char,data) bind(C, name='fftw_import_wisdom') + import + type(C_FUNPTR), value :: read_char + type(C_PTR), value :: data + end function fftw_import_wisdom + + subroutine fftw_fprint_plan(p,output_file) bind(C, name='fftw_fprint_plan') + import + type(C_PTR), value :: p + type(C_PTR), value :: output_file + end subroutine fftw_fprint_plan + + subroutine fftw_print_plan(p) bind(C, name='fftw_print_plan') + import + type(C_PTR), value :: p + end subroutine fftw_print_plan + + type(C_PTR) function fftw_sprint_plan(p) bind(C, name='fftw_sprint_plan') + import + type(C_PTR), value :: p + end function fftw_sprint_plan + + type(C_PTR) function fftw_malloc(n) bind(C, name='fftw_malloc') + import + integer(C_SIZE_T), value :: n + end function fftw_malloc + + type(C_PTR) function fftw_alloc_real(n) bind(C, name='fftw_alloc_real') + import + integer(C_SIZE_T), value :: n + end function fftw_alloc_real + + type(C_PTR) function fftw_alloc_complex(n) bind(C, name='fftw_alloc_complex') + import + integer(C_SIZE_T), value :: n + end function fftw_alloc_complex + + subroutine fftw_free(p) bind(C, name='fftw_free') + import + type(C_PTR), value :: p + end subroutine fftw_free + + subroutine fftw_flops(p,add,mul,fmas) bind(C, name='fftw_flops') + import + type(C_PTR), value :: p + real(C_DOUBLE), intent(out) :: add + real(C_DOUBLE), intent(out) :: mul + real(C_DOUBLE), intent(out) :: fmas + end subroutine fftw_flops + + real(C_DOUBLE) function fftw_estimate_cost(p) bind(C, name='fftw_estimate_cost') + import + type(C_PTR), value :: p + end function fftw_estimate_cost + + real(C_DOUBLE) function fftw_cost(p) bind(C, name='fftw_cost') + import + type(C_PTR), value :: p + end function fftw_cost + + integer(C_INT) function fftw_alignment_of(p) bind(C, name='fftw_alignment_of') + import + real(C_DOUBLE), dimension(*), intent(out) :: p + end function fftw_alignment_of + + end interface + + type, bind(C) :: fftwf_iodim + integer(C_INT) n, is, os + end type fftwf_iodim + type, bind(C) :: fftwf_iodim64 + integer(C_INTPTR_T) n, is, os + end type fftwf_iodim64 + + interface + type(C_PTR) function fftwf_plan_dft(rank,n,in,out,sign,flags) bind(C, name='fftwf_plan_dft') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_dft + + type(C_PTR) function fftwf_plan_dft_1d(n,in,out,sign,flags) bind(C, name='fftwf_plan_dft_1d') + import + integer(C_INT), value :: n + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_dft_1d + + type(C_PTR) function fftwf_plan_dft_2d(n0,n1,in,out,sign,flags) bind(C, name='fftwf_plan_dft_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_dft_2d + + type(C_PTR) function fftwf_plan_dft_3d(n0,n1,n2,in,out,sign,flags) bind(C, name='fftwf_plan_dft_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_dft_3d + + type(C_PTR) function fftwf_plan_many_dft(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,sign,flags) & + bind(C, name='fftwf_plan_many_dft') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_many_dft + + type(C_PTR) function fftwf_plan_guru_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(C, name='fftwf_plan_guru_dft') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_guru_dft + + type(C_PTR) function fftwf_plan_guru_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) & + bind(C, name='fftwf_plan_guru_split_dft') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: ri + real(C_FLOAT), dimension(*), intent(out) :: ii + real(C_FLOAT), dimension(*), intent(out) :: ro + real(C_FLOAT), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftwf_plan_guru_split_dft + + type(C_PTR) function fftwf_plan_guru64_dft(rank,dims,howmany_rank,howmany_dims,in,out,sign,flags) & + bind(C, name='fftwf_plan_guru64_dft') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: sign + integer(C_INT), value :: flags + end function fftwf_plan_guru64_dft + + type(C_PTR) function fftwf_plan_guru64_split_dft(rank,dims,howmany_rank,howmany_dims,ri,ii,ro,io,flags) & + bind(C, name='fftwf_plan_guru64_split_dft') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: ri + real(C_FLOAT), dimension(*), intent(out) :: ii + real(C_FLOAT), dimension(*), intent(out) :: ro + real(C_FLOAT), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftwf_plan_guru64_split_dft + + subroutine fftwf_execute_dft(p,in,out) bind(C, name='fftwf_execute_dft') + import + type(C_PTR), value :: p + complex(C_FLOAT_COMPLEX), dimension(*), intent(inout) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + end subroutine fftwf_execute_dft + + subroutine fftwf_execute_split_dft(p,ri,ii,ro,io) bind(C, name='fftwf_execute_split_dft') + import + type(C_PTR), value :: p + real(C_FLOAT), dimension(*), intent(inout) :: ri + real(C_FLOAT), dimension(*), intent(inout) :: ii + real(C_FLOAT), dimension(*), intent(out) :: ro + real(C_FLOAT), dimension(*), intent(out) :: io + end subroutine fftwf_execute_split_dft + + type(C_PTR) function fftwf_plan_many_dft_r2c(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) & + bind(C, name='fftwf_plan_many_dft_r2c') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + real(C_FLOAT), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_INT), value :: flags + end function fftwf_plan_many_dft_r2c + + type(C_PTR) function fftwf_plan_dft_r2c(rank,n,in,out,flags) bind(C, name='fftwf_plan_dft_r2c') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + real(C_FLOAT), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_r2c + + type(C_PTR) function fftwf_plan_dft_r2c_1d(n,in,out,flags) bind(C, name='fftwf_plan_dft_r2c_1d') + import + integer(C_INT), value :: n + real(C_FLOAT), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_r2c_1d + + type(C_PTR) function fftwf_plan_dft_r2c_2d(n0,n1,in,out,flags) bind(C, name='fftwf_plan_dft_r2c_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + real(C_FLOAT), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_r2c_2d + + type(C_PTR) function fftwf_plan_dft_r2c_3d(n0,n1,n2,in,out,flags) bind(C, name='fftwf_plan_dft_r2c_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + real(C_FLOAT), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_r2c_3d + + type(C_PTR) function fftwf_plan_many_dft_c2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,flags) & + bind(C, name='fftwf_plan_many_dft_c2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_INT), value :: flags + end function fftwf_plan_many_dft_c2r + + type(C_PTR) function fftwf_plan_dft_c2r(rank,n,in,out,flags) bind(C, name='fftwf_plan_dft_c2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_c2r + + type(C_PTR) function fftwf_plan_dft_c2r_1d(n,in,out,flags) bind(C, name='fftwf_plan_dft_c2r_1d') + import + integer(C_INT), value :: n + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_c2r_1d + + type(C_PTR) function fftwf_plan_dft_c2r_2d(n0,n1,in,out,flags) bind(C, name='fftwf_plan_dft_c2r_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_c2r_2d + + type(C_PTR) function fftwf_plan_dft_c2r_3d(n0,n1,n2,in,out,flags) bind(C, name='fftwf_plan_dft_c2r_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_dft_c2r_3d + + type(C_PTR) function fftwf_plan_guru_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftwf_plan_guru_dft_r2c') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_guru_dft_r2c + + type(C_PTR) function fftwf_plan_guru_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftwf_plan_guru_dft_c2r') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_guru_dft_c2r + + type(C_PTR) function fftwf_plan_guru_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) & + bind(C, name='fftwf_plan_guru_split_dft_r2c') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: ro + real(C_FLOAT), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftwf_plan_guru_split_dft_r2c + + type(C_PTR) function fftwf_plan_guru_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) & + bind(C, name='fftwf_plan_guru_split_dft_c2r') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: ri + real(C_FLOAT), dimension(*), intent(out) :: ii + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_guru_split_dft_c2r + + type(C_PTR) function fftwf_plan_guru64_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftwf_plan_guru64_dft_r2c') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_guru64_dft_r2c + + type(C_PTR) function fftwf_plan_guru64_dft_c2r(rank,dims,howmany_rank,howmany_dims,in,out,flags) & + bind(C, name='fftwf_plan_guru64_dft_c2r') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_guru64_dft_c2r + + type(C_PTR) function fftwf_plan_guru64_split_dft_r2c(rank,dims,howmany_rank,howmany_dims,in,ro,io,flags) & + bind(C, name='fftwf_plan_guru64_split_dft_r2c') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: ro + real(C_FLOAT), dimension(*), intent(out) :: io + integer(C_INT), value :: flags + end function fftwf_plan_guru64_split_dft_r2c + + type(C_PTR) function fftwf_plan_guru64_split_dft_c2r(rank,dims,howmany_rank,howmany_dims,ri,ii,out,flags) & + bind(C, name='fftwf_plan_guru64_split_dft_c2r') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: ri + real(C_FLOAT), dimension(*), intent(out) :: ii + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), value :: flags + end function fftwf_plan_guru64_split_dft_c2r + + subroutine fftwf_execute_dft_r2c(p,in,out) bind(C, name='fftwf_execute_dft_r2c') + import + type(C_PTR), value :: p + real(C_FLOAT), dimension(*), intent(inout) :: in + complex(C_FLOAT_COMPLEX), dimension(*), intent(out) :: out + end subroutine fftwf_execute_dft_r2c + + subroutine fftwf_execute_dft_c2r(p,in,out) bind(C, name='fftwf_execute_dft_c2r') + import + type(C_PTR), value :: p + complex(C_FLOAT_COMPLEX), dimension(*), intent(inout) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + end subroutine fftwf_execute_dft_c2r + + subroutine fftwf_execute_split_dft_r2c(p,in,ro,io) bind(C, name='fftwf_execute_split_dft_r2c') + import + type(C_PTR), value :: p + real(C_FLOAT), dimension(*), intent(inout) :: in + real(C_FLOAT), dimension(*), intent(out) :: ro + real(C_FLOAT), dimension(*), intent(out) :: io + end subroutine fftwf_execute_split_dft_r2c + + subroutine fftwf_execute_split_dft_c2r(p,ri,ii,out) bind(C, name='fftwf_execute_split_dft_c2r') + import + type(C_PTR), value :: p + real(C_FLOAT), dimension(*), intent(inout) :: ri + real(C_FLOAT), dimension(*), intent(inout) :: ii + real(C_FLOAT), dimension(*), intent(out) :: out + end subroutine fftwf_execute_split_dft_c2r + + type(C_PTR) function fftwf_plan_many_r2r(rank,n,howmany,in,inembed,istride,idist,out,onembed,ostride,odist,kind,flags) & + bind(C, name='fftwf_plan_many_r2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + integer(C_INT), value :: howmany + real(C_FLOAT), dimension(*), intent(out) :: in + integer(C_INT), dimension(*), intent(in) :: inembed + integer(C_INT), value :: istride + integer(C_INT), value :: idist + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_INT), dimension(*), intent(in) :: onembed + integer(C_INT), value :: ostride + integer(C_INT), value :: odist + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftwf_plan_many_r2r + + type(C_PTR) function fftwf_plan_r2r(rank,n,in,out,kind,flags) bind(C, name='fftwf_plan_r2r') + import + integer(C_INT), value :: rank + integer(C_INT), dimension(*), intent(in) :: n + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftwf_plan_r2r + + type(C_PTR) function fftwf_plan_r2r_1d(n,in,out,kind,flags) bind(C, name='fftwf_plan_r2r_1d') + import + integer(C_INT), value :: n + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), value :: kind + integer(C_INT), value :: flags + end function fftwf_plan_r2r_1d + + type(C_PTR) function fftwf_plan_r2r_2d(n0,n1,in,out,kind0,kind1,flags) bind(C, name='fftwf_plan_r2r_2d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), value :: kind0 + integer(C_FFTW_R2R_KIND), value :: kind1 + integer(C_INT), value :: flags + end function fftwf_plan_r2r_2d + + type(C_PTR) function fftwf_plan_r2r_3d(n0,n1,n2,in,out,kind0,kind1,kind2,flags) bind(C, name='fftwf_plan_r2r_3d') + import + integer(C_INT), value :: n0 + integer(C_INT), value :: n1 + integer(C_INT), value :: n2 + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), value :: kind0 + integer(C_FFTW_R2R_KIND), value :: kind1 + integer(C_FFTW_R2R_KIND), value :: kind2 + integer(C_INT), value :: flags + end function fftwf_plan_r2r_3d + + type(C_PTR) function fftwf_plan_guru_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) & + bind(C, name='fftwf_plan_guru_r2r') + import + integer(C_INT), value :: rank + type(fftwf_iodim), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftwf_plan_guru_r2r + + type(C_PTR) function fftwf_plan_guru64_r2r(rank,dims,howmany_rank,howmany_dims,in,out,kind,flags) & + bind(C, name='fftwf_plan_guru64_r2r') + import + integer(C_INT), value :: rank + type(fftwf_iodim64), dimension(*), intent(in) :: dims + integer(C_INT), value :: howmany_rank + type(fftwf_iodim64), dimension(*), intent(in) :: howmany_dims + real(C_FLOAT), dimension(*), intent(out) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + integer(C_FFTW_R2R_KIND), dimension(*), intent(in) :: kind + integer(C_INT), value :: flags + end function fftwf_plan_guru64_r2r + + subroutine fftwf_execute_r2r(p,in,out) bind(C, name='fftwf_execute_r2r') + import + type(C_PTR), value :: p + real(C_FLOAT), dimension(*), intent(inout) :: in + real(C_FLOAT), dimension(*), intent(out) :: out + end subroutine fftwf_execute_r2r + + subroutine fftwf_destroy_plan(p) bind(C, name='fftwf_destroy_plan') + import + type(C_PTR), value :: p + end subroutine fftwf_destroy_plan + + subroutine fftwf_forget_wisdom() bind(C, name='fftwf_forget_wisdom') + import + end subroutine fftwf_forget_wisdom + + subroutine fftwf_cleanup() bind(C, name='fftwf_cleanup') + import + end subroutine fftwf_cleanup + + subroutine fftwf_set_timelimit(t) bind(C, name='fftwf_set_timelimit') + import + real(C_DOUBLE), value :: t + end subroutine fftwf_set_timelimit + + subroutine fftwf_plan_with_nthreads(nthreads) bind(C, name='fftwf_plan_with_nthreads') + import + integer(C_INT), value :: nthreads + end subroutine fftwf_plan_with_nthreads + + integer(C_INT) function fftwf_init_threads() bind(C, name='fftwf_init_threads') + import + end function fftwf_init_threads + + subroutine fftwf_cleanup_threads() bind(C, name='fftwf_cleanup_threads') + import + end subroutine fftwf_cleanup_threads + + integer(C_INT) function fftwf_export_wisdom_to_filename(filename) bind(C, name='fftwf_export_wisdom_to_filename') + import + character(C_CHAR), dimension(*), intent(in) :: filename + end function fftwf_export_wisdom_to_filename + + subroutine fftwf_export_wisdom_to_file(output_file) bind(C, name='fftwf_export_wisdom_to_file') + import + type(C_PTR), value :: output_file + end subroutine fftwf_export_wisdom_to_file + + type(C_PTR) function fftwf_export_wisdom_to_string() bind(C, name='fftwf_export_wisdom_to_string') + import + end function fftwf_export_wisdom_to_string + + subroutine fftwf_export_wisdom(write_char,data) bind(C, name='fftwf_export_wisdom') + import + type(C_FUNPTR), value :: write_char + type(C_PTR), value :: data + end subroutine fftwf_export_wisdom + + integer(C_INT) function fftwf_import_system_wisdom() bind(C, name='fftwf_import_system_wisdom') + import + end function fftwf_import_system_wisdom + + integer(C_INT) function fftwf_import_wisdom_from_filename(filename) bind(C, name='fftwf_import_wisdom_from_filename') + import + character(C_CHAR), dimension(*), intent(in) :: filename + end function fftwf_import_wisdom_from_filename + + integer(C_INT) function fftwf_import_wisdom_from_file(input_file) bind(C, name='fftwf_import_wisdom_from_file') + import + type(C_PTR), value :: input_file + end function fftwf_import_wisdom_from_file + + integer(C_INT) function fftwf_import_wisdom_from_string(input_string) bind(C, name='fftwf_import_wisdom_from_string') + import + character(C_CHAR), dimension(*), intent(in) :: input_string + end function fftwf_import_wisdom_from_string + + integer(C_INT) function fftwf_import_wisdom(read_char,data) bind(C, name='fftwf_import_wisdom') + import + type(C_FUNPTR), value :: read_char + type(C_PTR), value :: data + end function fftwf_import_wisdom + + subroutine fftwf_fprint_plan(p,output_file) bind(C, name='fftwf_fprint_plan') + import + type(C_PTR), value :: p + type(C_PTR), value :: output_file + end subroutine fftwf_fprint_plan + + subroutine fftwf_print_plan(p) bind(C, name='fftwf_print_plan') + import + type(C_PTR), value :: p + end subroutine fftwf_print_plan + + type(C_PTR) function fftwf_sprint_plan(p) bind(C, name='fftwf_sprint_plan') + import + type(C_PTR), value :: p + end function fftwf_sprint_plan + + type(C_PTR) function fftwf_malloc(n) bind(C, name='fftwf_malloc') + import + integer(C_SIZE_T), value :: n + end function fftwf_malloc + + type(C_PTR) function fftwf_alloc_real(n) bind(C, name='fftwf_alloc_real') + import + integer(C_SIZE_T), value :: n + end function fftwf_alloc_real + + type(C_PTR) function fftwf_alloc_complex(n) bind(C, name='fftwf_alloc_complex') + import + integer(C_SIZE_T), value :: n + end function fftwf_alloc_complex + + subroutine fftwf_free(p) bind(C, name='fftwf_free') + import + type(C_PTR), value :: p + end subroutine fftwf_free + + subroutine fftwf_flops(p,add,mul,fmas) bind(C, name='fftwf_flops') + import + type(C_PTR), value :: p + real(C_DOUBLE), intent(out) :: add + real(C_DOUBLE), intent(out) :: mul + real(C_DOUBLE), intent(out) :: fmas + end subroutine fftwf_flops + + real(C_DOUBLE) function fftwf_estimate_cost(p) bind(C, name='fftwf_estimate_cost') + import + type(C_PTR), value :: p + end function fftwf_estimate_cost + + real(C_DOUBLE) function fftwf_cost(p) bind(C, name='fftwf_cost') + import + type(C_PTR), value :: p + end function fftwf_cost + + integer(C_INT) function fftwf_alignment_of(p) bind(C, name='fftwf_alignment_of') + import + real(C_FLOAT), dimension(*), intent(out) :: p + end function fftwf_alignment_of + + end interface diff --git a/wsjtx_lib/lib/fftw3.f90 b/wsjtx_lib/lib/fftw3.f90 new file mode 100644 index 0000000..440ccc2 --- /dev/null +++ b/wsjtx_lib/lib/fftw3.f90 @@ -0,0 +1,64 @@ + 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/wsjtx_lib/lib/fftw3mod.f90 b/wsjtx_lib/lib/fftw3mod.f90 new file mode 100644 index 0000000..f9e5f78 --- /dev/null +++ b/wsjtx_lib/lib/fftw3mod.f90 @@ -0,0 +1,4 @@ +module FFTW3 + use, intrinsic :: iso_c_binding + include 'fftw3.f03' +end module FFTW3 diff --git a/wsjtx_lib/lib/fil3.f90 b/wsjtx_lib/lib/fil3.f90 new file mode 100644 index 0000000..adebefd --- /dev/null +++ b/wsjtx_lib/lib/fil3.f90 @@ -0,0 +1,159 @@ +subroutine fil3(x1,n1,c2,n2) + +! FIR real-to-complex filter designed using ScopeFIR +! +!----------------------------------------------- +! fsample (Hz) 12000 Input sample rate +! Ntaps 113 Number of filter taps +! fc (Hz) 500 Cutoff frequency +! fstop (Hz) 750 Lower limit of stopband +! Ripple (dB) 0.2 Ripple in passband +! Stop Atten (dB) 50 Stopband attenuation +! fmix (HZ) 1500 Mixing frequency +! fout (Hz) 1500 Output sample rate + +! Resulting passband is 1000 - 2000 Hz + +! Suggest calling with n1 = 8*n2 + 105, where n2 is the desired number +! of 1500 Hz output samples. + + parameter (NTAPS=113) + parameter (NH=56) !NTAPS/2 + parameter (NDOWN=8) !Downsample ratio = 1/8 + real x1(n1) + complex z + complex c2(n1/NDOWN) + +! Filter coefficients: + complex ca(-NH:NH) + data ca/ & + (-0.001818142144, 0.000000000000), & + (-0.000664066641,-0.000664066640), & + (-0.000000000000,-0.001044063550), & + ( 0.000737290018,-0.000737290010), & + ( 0.000908957610,-0.000000000000), & + ( 0.000444156615, 0.000444156610), & + (-0.000000000000, 0.000202701460), & + ( 0.000244876473,-0.000244876470), & + ( 0.000978154552, 0.000000000000), & + ( 0.001155650277, 0.001155650270), & + ( 0.000000000000, 0.002243121590), & + (-0.001927618608, 0.001927618600), & + (-0.003006201675, 0.000000000000), & + (-0.002134087852,-0.002134087850), & + ( 0.000000000000,-0.002717699570), & + ( 0.001478946738,-0.001478946730), & + ( 0.001162489032, 0.000000000000), & + (-0.000005589545,-0.000005589540), & + (-0.000000000000,-0.001321554800), & + ( 0.001873767954,-0.001873767950), & + ( 0.003843608784,-0.000000000000), & + ( 0.003356874940, 0.003356874940), & + (-0.000000000000, 0.005218967040), & + (-0.003640348011, 0.003640348010), & + (-0.004470167307, 0.000000000000), & + (-0.002247131477,-0.002247131470), & + (-0.000000000000,-0.001335998900), & + (-0.000647656208, 0.000647656200), & + (-0.003386100636, 0.000000000000), & + (-0.004114456189,-0.004114456180), & + ( 0.000000000000,-0.007939147960), & + ( 0.006692816134,-0.006692816130), & + ( 0.010145641899, 0.000000000000), & + ( 0.006920770724, 0.006920770720), & + ( 0.000000000000, 0.008285915750), & + (-0.003992321524, 0.003992321520), & + (-0.001995842303, 0.000000000000), & + ( 0.001704388774, 0.001704388770), & + (-0.000000000000, 0.007202515550), & + (-0.008426458377, 0.008426458370), & + (-0.016028350845, 0.000000000000), & + (-0.013430355885,-0.013430355880), & + (-0.000000000000,-0.020297455950), & + ( 0.013791263729,-0.013791263720), & + ( 0.016298136197,-0.000000000000), & + ( 0.007443596155, 0.007443596150), & + (-0.000000000000, 0.002223837360), & + ( 0.005924356866,-0.005924356860), & + ( 0.020854478160, 0.000000000000), & + ( 0.024471928130, 0.024471928130), & + ( 0.000000000000, 0.048909701460), & + (-0.044508219241, 0.044508219240), & + (-0.075874892030, 0.000000000000), & + (-0.061450241075,-0.061450241070), & + ( 0.000000000000,-0.095332017640), & + ( 0.071148679982,-0.071148679980), & + ( 0.102420526192, 0.000000000000), & + ( 0.071148679982, 0.071148679980), & + ( 0.000000000000, 0.095332017640), & + (-0.061450241075, 0.061450241070), & + (-0.075874892030, 0.000000000000), & + (-0.044508219241,-0.044508219240), & + ( 0.000000000000,-0.048909701460), & + ( 0.024471928130,-0.024471928130), & + ( 0.020854478160, 0.000000000000), & + ( 0.005924356866, 0.005924356860), & + (-0.000000000000,-0.002223837360), & + ( 0.007443596155,-0.007443596150), & + ( 0.016298136197,-0.000000000000), & + ( 0.013791263729, 0.013791263720), & + (-0.000000000000, 0.020297455950), & + (-0.013430355885, 0.013430355880), & + (-0.016028350845, 0.000000000000), & + (-0.008426458377,-0.008426458370), & + (-0.000000000000,-0.007202515550), & + ( 0.001704388774,-0.001704388770), & + (-0.001995842303, 0.000000000000), & + (-0.003992321524,-0.003992321520), & + ( 0.000000000000,-0.008285915750), & + ( 0.006920770724,-0.006920770720), & + ( 0.010145641899, 0.000000000000), & + ( 0.006692816134, 0.006692816130), & + ( 0.000000000000, 0.007939147960), & + (-0.004114456189, 0.004114456180), & + (-0.003386100636, 0.000000000000), & + (-0.000647656208,-0.000647656200), & + (-0.000000000000, 0.001335998900), & + (-0.002247131477, 0.002247131470), & + (-0.004470167307, 0.000000000000), & + (-0.003640348011,-0.003640348010), & + (-0.000000000000,-0.005218967040), & + ( 0.003356874940,-0.003356874940), & + ( 0.003843608784,-0.000000000000), & + ( 0.001873767954, 0.001873767950), & + (-0.000000000000, 0.001321554800), & + (-0.000005589545, 0.000005589540), & + ( 0.001162489032, 0.000000000000), & + ( 0.001478946738, 0.001478946730), & + ( 0.000000000000, 0.002717699570), & + (-0.002134087852, 0.002134087850), & + (-0.003006201675, 0.000000000000), & + (-0.001927618608,-0.001927618600), & + ( 0.000000000000,-0.002243121590), & + ( 0.001155650277,-0.001155650270), & + ( 0.000978154552, 0.000000000000), & + ( 0.000244876473, 0.000244876470), & + (-0.000000000000,-0.000202701460), & + ( 0.000444156615,-0.000444156610), & + ( 0.000908957610,-0.000000000000), & + ( 0.000737290018, 0.000737290010), & + (-0.000000000000, 0.001044063550), & + (-0.000664066641, 0.000664066640), & + (-0.001818142144, 0.000000000000)/ + save ca + + n2=(n1-NTAPS+NDOWN)/NDOWN + k0=NH-NDOWN+1 + +! Loop over all output samples + do i=1,n2 + z=0. + k=k0 + NDOWN*i + do j=-NH,NH + z=z + x1(j+k)*ca(j) + enddo + c2(i)=z + enddo + + return +end subroutine fil3 diff --git a/wsjtx_lib/lib/fil3c.f90 b/wsjtx_lib/lib/fil3c.f90 new file mode 100644 index 0000000..0b4a85f --- /dev/null +++ b/wsjtx_lib/lib/fil3c.f90 @@ -0,0 +1,72 @@ +subroutine fil3c(c1,n1,c2,n2) + +! FIR complex-to-complex low-pass filter designed with ScopeFIR +! +!----------------------------------------------- +! fsample (Hz) 12000 Input sample rate +! Ntaps 113 Number of filter taps +! fc (Hz) 500 Cutoff frequency +! fstop (Hz) 750 Lower limit of stopband +! Ripple (dB) 0.2 Ripple in passband +! Stop Atten (dB) 50 Stopband attenuation +! fout (Hz) 1500 Output sample rate + +! Suggest calling with n1 = 8*n2 + 105, where n2 is the desired number +! of 1500 Hz output samples. + + parameter (NTAPS=113) + parameter (NH=56) !NTAPS/2 + parameter (NDOWN=8) !Downsample ratio = 1/8 + complex c1(n1) + complex c2(n1/NDOWN) + complex z + +! Filter coefficients: + real a(-NH:NH) + data a/ & + -0.001818142144,-0.000939132050,-0.001044063556,-0.001042685542, & + -0.000908957610,-0.000628132309,-0.000202701465, 0.000346307629, & + 0.000978154552, 0.001634336295, 0.002243121592, 0.002726064379, & + 0.003006201675, 0.003018055983, 0.002717699575, 0.002091546534, & + 0.001162489032,-0.000007904811,-0.001321554806,-0.002649908053, & + -0.003843608784,-0.004747338068,-0.005218967042,-0.005148229529, & + -0.004470167307,-0.003177923811,-0.001335998901, 0.000915924193, & + 0.003386100636, 0.005818719744, 0.007939147967, 0.009465071347, & + 0.010145641899, 0.009787447819, 0.008285915754, 0.005645995244, & + 0.001995842303,-0.002410369720,-0.007202515555,-0.011916811719, & + -0.016028350845,-0.018993391440,-0.020297455955,-0.019503792208, & + -0.016298136197,-0.010526834635,-0.002223837363, 0.008378305829, & + 0.020854478160, 0.034608532659, 0.048909701463, 0.062944127288, & + 0.075874892030, 0.086903764340, 0.095332017649, 0.100619428175, & + 0.102420526192, 0.100619428175, 0.095332017649, 0.086903764340, & + 0.075874892030, 0.062944127288, 0.048909701463, 0.034608532659, & + 0.020854478160, 0.008378305829,-0.002223837363,-0.010526834635, & + -0.016298136197,-0.019503792208,-0.020297455955,-0.018993391440, & + -0.016028350845,-0.011916811719,-0.007202515555,-0.002410369720, & + 0.001995842303, 0.005645995244, 0.008285915754, 0.009787447819, & + 0.010145641899, 0.009465071347, 0.007939147967, 0.005818719744, & + 0.003386100636, 0.000915924193,-0.001335998901,-0.003177923811, & + -0.004470167307,-0.005148229529,-0.005218967042,-0.004747338068, & + -0.003843608784,-0.002649908053,-0.001321554806,-0.000007904811, & + 0.001162489032, 0.002091546534, 0.002717699575, 0.003018055983, & + 0.003006201675, 0.002726064379, 0.002243121592, 0.001634336295, & + 0.000978154552, 0.000346307629,-0.000202701465,-0.000628132309, & + -0.000908957610,-0.001042685542,-0.001044063556,-0.000939132050, & + -0.001818142144/ + save a + + n2=(n1-NTAPS+NDOWN)/NDOWN + k0=NH-NDOWN+1 + +! Loop over all output samples + do i=1,n2 + z=0. + k=k0 + NDOWN*i + do j=-NH,NH + z=z + c1(j+k)*a(j) + enddo + c2(i)=z + enddo + + return +end subroutine fil3c diff --git a/wsjtx_lib/lib/fil4.f90 b/wsjtx_lib/lib/fil4.f90 new file mode 100644 index 0000000..4946da2 --- /dev/null +++ b/wsjtx_lib/lib/fil4.f90 @@ -0,0 +1,49 @@ +subroutine fil4(id1,n1,id2,n2) + +! FIR lowpass filter designed using ScopeFIR + +! fsample = 48000 Hz +! Ntaps = 49 +! fc = 4500 Hz +! fstop = 6000 Hz +! Ripple = 1 dB +! Stop Atten = 40 dB +! fout = 12000 Hz + + parameter (NTAPS=49) + parameter (NDOWN=4) !Downsample ratio + integer*2 id1(n1) + integer*2 id2(*) + real t(NTAPS) + data t/NTAPS*0.0/ + +! Filter coefficients: + real w(NTAPS) + data w/ & + 0.000861074040, 0.010051920210, 0.010161983649, 0.011363155076, & + 0.008706594219, 0.002613872664,-0.005202883094,-0.011720748164, & + -0.013752163325,-0.009431602741, 0.000539063909, 0.012636767098, & + 0.021494659597, 0.021951235065, 0.011564169382,-0.007656470131, & + -0.028965787341,-0.042637874109,-0.039203309748,-0.013153301537, & + 0.034320769178, 0.094717832646, 0.154224604789, 0.197758325022, & + 0.213715139513, 0.197758325022, 0.154224604789, 0.094717832646, & + 0.034320769178,-0.013153301537,-0.039203309748,-0.042637874109, & + -0.028965787341,-0.007656470131, 0.011564169382, 0.021951235065, & + 0.021494659597, 0.012636767098, 0.000539063909,-0.009431602741, & + -0.013752163325,-0.011720748164,-0.005202883094, 0.002613872664, & + 0.008706594219, 0.011363155076, 0.010161983649, 0.010051920210, & + 0.000861074040/ + save w,t + + n2=n1/NDOWN + if(n2*NDOWN.ne.n1) stop 'Error in fil4' + k=1-NDOWN + do i=1,n2 + k=k+NDOWN + t(1:NTAPS-NDOWN)=t(1+NDOWN:NTAPS) !Shift old data down in array t + t(1+NTAPS-NDOWN:NTAPS)=id1(k:k+NDOWN-1) !Insert new data at end of t + id2(i)=nint(dot_product(w,t)) + enddo + + return +end subroutine fil4 diff --git a/wsjtx_lib/lib/fil61.f90 b/wsjtx_lib/lib/fil61.f90 new file mode 100644 index 0000000..90a6fe4 --- /dev/null +++ b/wsjtx_lib/lib/fil61.f90 @@ -0,0 +1,64 @@ +12000 61 250 750 0.2 50, mix at 1500 + + +-0.000000000000 0.001944450121 +-0.000668730681 0.000668730681 +-0.000974850191 -0.000000000000 +-0.000581679123 -0.000581679123 + 0.000000000000 -0.000439648787 +-0.000148911451 0.000148911451 +-0.001140891736 -0.000000000000 +-0.001653102965 -0.001653102965 + 0.000000000000 -0.003749915818 + 0.003740834397 -0.003740834397 + 0.006834087490 0.000000000000 + 0.005812808655 0.005812808655 +-0.000000000000 0.009262713933 +-0.006900370427 0.006900370427 +-0.009503248519 -0.000000000000 +-0.005874581677 -0.005874581677 + 0.000000000000 -0.006017530719 + 0.001785268072 -0.001785268072 +-0.002214736448 -0.000000000000 +-0.005777038427 -0.005777038427 + 0.000000000000 -0.015228682747 + 0.016402831440 -0.016402831440 + 0.031806920774 0.000000000000 + 0.028800401613 0.028800401613 +-0.000000000000 0.049589395998 +-0.041000303659 0.041000303659 +-0.065514139214 -0.000000000000 +-0.050781544715 -0.050781544715 + 0.000000000000 -0.076562341482 + 0.056225821996 -0.056225821996 + 0.080516569816 0.000000000000 + 0.056225821996 0.056225821996 +-0.000000000000 0.076562341482 +-0.050781544715 0.050781544715 +-0.065514139214 -0.000000000000 +-0.041000303659 -0.041000303659 + 0.000000000000 -0.049589395998 + 0.028800401613 -0.028800401613 + 0.031806920774 0.000000000000 + 0.016402831440 0.016402831440 +-0.000000000000 0.015228682747 +-0.005777038427 0.005777038427 +-0.002214736448 -0.000000000000 + 0.001785268072 0.001785268072 +-0.000000000000 0.006017530719 +-0.005874581677 0.005874581677 +-0.009503248519 -0.000000000000 +-0.006900370427 -0.006900370427 + 0.000000000000 -0.009262713933 + 0.005812808655 -0.005812808655 + 0.006834087490 0.000000000000 + 0.003740834397 0.003740834397 +-0.000000000000 0.003749915818 +-0.001653102965 0.001653102965 +-0.001140891736 -0.000000000000 +-0.000148911451 -0.000148911451 +-0.000000000000 0.000439648787 +-0.000581679123 0.000581679123 +-0.000974850191 -0.000000000000 +-0.000668730681 -0.000668730681 + 0.000000000000 -0.001944450121 diff --git a/wsjtx_lib/lib/fil6521.f90 b/wsjtx_lib/lib/fil6521.f90 new file mode 100644 index 0000000..afa01d2 --- /dev/null +++ b/wsjtx_lib/lib/fil6521.f90 @@ -0,0 +1,45 @@ +subroutine fil6521(c1,n1,c2,n2) + +! FIR lowpass filter designed using ScopeFIR + +! Pass #1 Pass #2 +! ----------------------------------------------- +! fsample (Hz) 1378.125 Input sample rate +! Ntaps 21 Number of filter taps +! fc (Hz) 40 Cutoff frequency +! fstop (Hz) 172.266 Lower limit of stopband +! Ripple (dB) 0.1 Ripple in passband +! Stop Atten (dB) 38 Stopband attenuation +! fout (Hz) 344.531 Output sample rate + + parameter (NTAPS=21) + parameter (NH=10) !NTAPS/2 + parameter (NDOWN=4) !Downsample ratio = 1/4 + complex c1(n1) + complex c2(n1/NDOWN) + +! Filter coefficients: + real a(-NH:NH+NTAPS/3) + data a/ & + -0.011958606980,-0.013888627387,-0.015601306443,-0.010602249570, & + 0.003804023436, 0.028320058273, 0.060903935217, 0.096841904411, & + 0.129639871228, 0.152644580853, 0.160917511283, 0.152644580853, & + 0.129639871228, 0.096841904411, 0.060903935217, 0.028320058273, & + 0.003804023436,-0.010602249570,-0.015601306443,-0.013888627387, & + -0.011958606980,1.43370769e-019,2.64031087e-006,6.25548654e+028, & + 2.44565251e+020,4.74227538e+030,10497312.0e0000,7.74079654e-039/ + + n2=(n1-NTAPS+NDOWN)/NDOWN + k0=NH-NDOWN+1 + +! Loop over all output samples + do i=1,n2 + c2(i)=0. + k=k0 + NDOWN*i + do j=-NH,NH + c2(i)=c2(i) + c1(j+k)*a(j) + enddo + enddo + + return +end subroutine fil6521 diff --git a/wsjtx_lib/lib/filbig.f90 b/wsjtx_lib/lib/filbig.f90 new file mode 100644 index 0000000..4211993 --- /dev/null +++ b/wsjtx_lib/lib/filbig.f90 @@ -0,0 +1,142 @@ +subroutine filbig(dd,npts,f0,newdat,c4a,n4,sq0) + +! Filter and downsample the real data in array dd(npts), sampled at 12000 Hz. +! Output is complex, sampled at 1378.125 Hz. + + use, intrinsic :: iso_c_binding + use FFTW3 + use timer_module, only: timer + + parameter (NSZ=3413) + parameter (NFFT1=672000,NFFT2=77175,NH2=38587) + parameter (NZ2=1000) + real*4 dd(npts) !Input data + real*4 rca(NFFT1) + complex ca(NFFT1/2+1) !FFT of input + complex c4a(NFFT2) !Output data + real*4 s(NZ2) + real*8 df + real halfpulse(8) !Impulse response of filter (one sided) + complex cfilt(NFFT2) !Filter (complex; imag = 0) + real rfilt(NFFT2) !Filter (real) + type(C_PTR) :: plan1,plan2,plan3 !Pointers to FFTW plans + logical first + equivalence (rfilt,cfilt),(rca,ca) + data first/.true./ + data halfpulse/114.97547150,36.57879257,-20.93789101, & + 5.89886379,1.59355187,-2.49138308,0.60910773,-0.04248129/ + common/refspec/dfref,ref(NSZ) + common/patience/npatience,nthreads + save first,plan1,plan2,plan3,rfilt,cfilt,df,ca + + if(npts.lt.0) go to 900 !Clean up at end of program + + if(first) then + 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 + +! Plan the FFTs just once + !$omp critical(fftw) ! serialize non thread-safe FFTW3 calls + call fftwf_plan_with_nthreads(nthreads) + plan1=fftwf_plan_dft_r2c_1d(nfft1,rca,ca,nflags) + call fftwf_plan_with_nthreads(1) + plan2=fftwf_plan_dft_1d(nfft2,c4a,c4a,-1,nflags) + plan3=fftwf_plan_dft_1d(nfft2,cfilt,cfilt,+1,nflags) + !$omp end critical(fftw) + +! Convert impulse response to filter function + do i=1,nfft2 + cfilt(i)=0. + enddo + fac=0.00625/nfft1 + cfilt(1)=fac*halfpulse(1) + do i=2,8 + cfilt(i)=fac*halfpulse(i) + cfilt(nfft2+2-i)=fac*halfpulse(i) + enddo + call fftwf_execute_dft(plan3,cfilt,cfilt) + + base=real(cfilt(NH2+1)) + do i=1,nfft2 + rfilt(i)=real(cfilt(i))-base + enddo + + df=12000.d0/nfft1 + first=.false. + endif + +! When new data comes along, we need to compute a new "big FFT" +! If we just have a new f0, continue with the existing data in ca. + + if(newdat.ne.0) then + call timer('FFTbig ',0) + nz=min(npts,nfft1) + rca(1:nz)=dd(1:nz) + rca(nz+1:)=0. + call fftwf_execute_dft_r2c(plan1,rca,ca) + call timer('FFTbig ',1) + + ib=0 + do j=1,NSZ + ia=ib+1 + ib=nint(j*dfref/df) + fac=sqrt(min(30.0,1.0/ref(j))) + ca(ia:ib)=fac*conjg(ca(ia:ib)) + enddo + newdat=0 + endif + +! NB: f0 is the frequency at which we want our filter centered. +! i0 is the bin number in ca closest to f0. + call timer('loops ',0) + i0=nint(f0/df) + 1 + do i=1,NH2 !Copy data into c4a and apply + j=i0+i-1 !the filter function + if(j.ge.1 .and. j.le.nfft1/2+1) then + c4a(i)=rfilt(i)*ca(j) + else + c4a(i)=0. + endif + enddo + do i=NH2+1,nfft2 + j=i0+i-1-nfft2 +! if(j.lt.1) j=j+nfft1 !nfft1 was nfft2 + if(j.ge.1) then + c4a(i)=rfilt(i)*ca(j) + else + c4a(i)=rfilt(i)*conjg(ca(2-j)) + endif + enddo + + nadd=77 !nfft2/NZ2=77 + i=0 + do j=1,NZ2 + s(j)=0. + do n=1,nadd + i=i+1 + s(j)=s(j) + real(c4a(i))**2 + aimag(c4a(i))**2 + enddo + enddo + call pctile(s,NZ2,30,sq0) + call timer('loops ',1) + +! Do the short reverse transform, to go back to time domain. + call timer('FFTsmall',0) + call fftwf_execute_dft(plan2,c4a,c4a) + call timer('FFTsmall',1) + n4=min(npts/8,nfft2) + return + +900 continue + + !$omp critical(fftw) ! serialize non thread-safe FFTW3 calls + call fftwf_destroy_plan(plan1) + call fftwf_destroy_plan(plan2) + call fftwf_destroy_plan(plan3) + !$omp end critical(fftw) + + return +end subroutine filbig diff --git a/wsjtx_lib/lib/fitcal.f90 b/wsjtx_lib/lib/fitcal.f90 new file mode 100644 index 0000000..f85ccf4 --- /dev/null +++ b/wsjtx_lib/lib/fitcal.f90 @@ -0,0 +1,34 @@ +subroutine fitcal(x,y,r,iz,a,b,sigmaa,sigmab,rms) + implicit real*8 (a-h,o-z) + real*8 x(iz),y(iz),r(iz) + + sx=0.d0 + sy=0.d0 + sxy=0.d0 + sx2=0.d0 + do i=1,iz + sx=sx + x(i) + sy=sy + y(i) + sxy=sxy + x(i)*y(i) + sx2=sx2 + x(i)*x(i) + enddo + delta=iz*sx2 - sx*sx + a=(sx2*sy - sx*sxy)/delta + b=(iz*sxy - sx*sy)/delta + + sq=0.d0 + do i=1,iz + r(i)=y(i) - (a + b*x(i)) + sq=sq + r(i)**2 + enddo + rms=0. + sigmaa=0. + sigmab=0. + if(iz.ge.3) then + rms=sqrt(sq/(iz-2)) + sigmaa=sqrt(rms*rms*sx2/delta) + sigmab=sqrt(iz*rms*rms/delta) + endif + + return +end subroutine fitcal diff --git a/wsjtx_lib/lib/fix_contest_msg.f90 b/wsjtx_lib/lib/fix_contest_msg.f90 new file mode 100644 index 0000000..8c0345e --- /dev/null +++ b/wsjtx_lib/lib/fix_contest_msg.f90 @@ -0,0 +1,32 @@ +subroutine fix_contest_msg(mygrid,msg) + +! If distance from mygrid to grid1 is more thsn 10000 km, change "grid1" +! to "R grid2" where grid2 is the antipodes of grid1. + + character*6 mygrid + character*22 msg + character*6 g1,g2 + logical isgrid + + isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & + g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & + g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' + + n=len(trim(msg)) + if(n.lt.4) return + + g1=msg(n-3:n)//' ' + if(isgrid(g1)) then + call azdist(mygrid,g1,0.d0,nAz,nEl,nDmiles,nDkm,nHotAz,nHotABetter) + if(ndkm.gt.10000) then + call grid2deg(g1,dlong,dlat) + dlong=dlong+180.0 + if(dlong.gt.180.0) dlong=dlong-360.0 + dlat=-dlat + call deg2grid(dlong,dlat,g2) + msg=msg(1:n-4)//'R '//g2(1:4) + endif + endif + + return +end subroutine fix_contest_msg diff --git a/wsjtx_lib/lib/fixwav.f90 b/wsjtx_lib/lib/fixwav.f90 new file mode 100644 index 0000000..da113d2 --- /dev/null +++ b/wsjtx_lib/lib/fixwav.f90 @@ -0,0 +1,66 @@ +program fixwav + + use wavhdr + parameter (NBANDS=23,NMODES=11) + parameter(NMAX=120*12000) + type(hdr) h + integer*2 id2(NMAX),id(4) + character*8 mode,mode0 + character*6 band + character*12 arg + character*80 infile + character*1 c + logical ok + + nargs=iargc() + if(nargs.ne.1 .and. nargs.ne.5) then + print*,'Usage: fixwav [fMHz mode submode TRperiod] infile' + go to 999 + endif + call getarg(1,infile) + if(nargs.eq.1) go to 10 + read(infile,*) fMHz + call getarg(2,mode0) + call getarg(3,arg) + nsubmode0=-1 + do i=1,8 + if(arg(1:1).eq.char(ichar('A')-1+i)) nsubmode0=i + enddo + if(nsubmode0.lt.0) read(arg,*) nsubmode0 + call getarg(4,arg) + read(arg,*) ntrperiod0 + call getarg(5,infile) + +10 open(10,file=infile,status='old',access='stream') + read(10) h + npts=h%ndata/2 + nfsample=h%nsamrate + read(10) id2(1:npts) + write(*,1002) h%nchan2,h%nbitsam2,h%nsamrate,npts +1002 format('Channels:',i2,' Bits/sample:',i3,' Sample rate:',i6, & + ' Npts:',i8) + + call get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok) + if(nfsample.ne.11025 .and. nfsample.ne.12000) ok=.false. + if(ok) write(*,1010) band,ntrperiod,mode,char(ichar('A')-1+id2(3)) +1010 format('Band: ',a6,' T/R period:',i4,' Mode: ',a8,1x,a1) + + if(.not.ok) write(*,'(a)') 'File has no valid WSJT-X params.' + if(ok .and. nargs.eq.1) go to 999 + + write(*,'(a)',advance='no') 'Do you want to add or change them? (Y/N): ' + read*,c + if(c.ne.'y' .and. c.ne.'Y') go to 999 + + print*,fMHz,mode0,nsubmode0,ntrperiod0 + call set_wsjtx_wav_params(fMHz,mode0,nsubmode0,ntrperiod0,id2) + band="" + mode="" + nsubmode=0 + ntrperiod=0 + call get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok) + write(*,1010) band,ntrperiod,mode,char(ichar('A')-1+id2(3)) + rewind 10 + write(10) h,id2(1:npts) + +999 end program fixwav diff --git a/wsjtx_lib/lib/flat1.f90 b/wsjtx_lib/lib/flat1.f90 new file mode 100644 index 0000000..5a5f723 --- /dev/null +++ b/wsjtx_lib/lib/flat1.f90 @@ -0,0 +1,23 @@ +subroutine flat1(savg,iz,nsmo,syellow) + + real savg(iz) + real syellow(iz) + real x(8192) + + ia=nsmo/2 + 1 + ib=iz - nsmo/2 - 1 + nstep=20 + nh=nstep/2 + do i=ia,ib,nstep + call pctile(savg(i-nsmo/2),nsmo,50,x(i)) + x(i-nh:i+nh-1)=x(i) + enddo + x(1:ia-1)=x(ia) + x(ib+1:iz)=x(ib) + + x0=0.001*maxval(x(iz/10:(9*iz)/10)) + syellow(1:iz)=savg(1:iz)/(x(1:iz)+x0) + + return +end subroutine flat1 + diff --git a/wsjtx_lib/lib/flat1a.f90 b/wsjtx_lib/lib/flat1a.f90 new file mode 100644 index 0000000..b5c0b20 --- /dev/null +++ b/wsjtx_lib/lib/flat1a.f90 @@ -0,0 +1,29 @@ +subroutine flat1a(psavg,nsmo,s2,nh,nsteps,nhmax,nsmax) + + real psavg(nh) + real s2(nhmax,nsmax) + real x(8192) + + ia=nsmo/2 + 1 + ib=nh - nsmo/2 - 1 + do i=ia,ib + call pctile(psavg(i-nsmo/2),nsmo,50,x(i)) + enddo + do i=1,ia-1 + x(i)=x(ia) + enddo + do i=ib+1,nh + x(i)=x(ib) + enddo + + do i=1,nh + psavg(i)=psavg(i)/x(i) + do j=1,nsteps + s2(i,j)=s2(i,j)/x(i) + enddo + enddo + + return +end subroutine flat1a + + diff --git a/wsjtx_lib/lib/flat1b.f90 b/wsjtx_lib/lib/flat1b.f90 new file mode 100644 index 0000000..bc22b85 --- /dev/null +++ b/wsjtx_lib/lib/flat1b.f90 @@ -0,0 +1,29 @@ +subroutine flat1b(psavg,nsmo,s2,nh,nsteps,nhmax,nsmax) + + real psavg(nh) + real s2(nhmax,nsmax) + real x(8192) + + ia=nsmo/2 + 1 + ib=nh - nsmo/2 - 1 + do i=ia,ib + call pctile(psavg(i-nsmo/2),nsmo,50,x(i)) + enddo + do i=1,ia-1 + x(i)=x(ia) + enddo + do i=ib+1,nh + x(i)=x(ib) + enddo + + do i=1,nh + psavg(i)=psavg(i)/x(i) + do j=1,nsteps + s2(i,j)=s2(i,j)/x(i) + enddo + enddo + + return +end subroutine flat1b + + diff --git a/wsjtx_lib/lib/flat2.f90 b/wsjtx_lib/lib/flat2.f90 new file mode 100644 index 0000000..5b42ff7 --- /dev/null +++ b/wsjtx_lib/lib/flat2.f90 @@ -0,0 +1,18 @@ +subroutine flat2(s,nz,ref) + + parameter (NSMAX=6827) + real s(NSMAX) + real ref(NSMAX) + + nsmo=10 + ia=nsmo+1 + ib=nz-nsmo-1 + do i=ia,ib + call pctile(s(i-nsmo),2*nsmo+1,5,ref(i)) + enddo + + ref(:ia-1)=ref(ia) + ref(ib+1:)=ref(ib) + + return +end subroutine flat2 diff --git a/wsjtx_lib/lib/flat4.f90 b/wsjtx_lib/lib/flat4.f90 new file mode 100644 index 0000000..faf1545 --- /dev/null +++ b/wsjtx_lib/lib/flat4.f90 @@ -0,0 +1,53 @@ +subroutine flat4(s,npts0,nflatten) + +! Flatten a spectrum for optimum display +! Input: s(npts) Linear scale in power +! nflatten If nflatten=0, convert to dB but do not flatten +! Output: s(npts) Flattened, with dB scale + + + implicit real*8 (a-h,o-z) + real*4 s(6827) + real*4 base + real*8 x(1000),y(1000),a(5) + data nseg/10/,npct/10/ + + npts=min(6827,npts0) + if(s(1).gt.1.e29) go to 900 !Boundary between Rx intervals: do nothing + do i=1,npts + s(i)=10.0*log10(s(i)) !Convert to dB scale + enddo + + if(nflatten.gt.0) then + nterms=5 + if(nflatten.eq.2) nterms=1 + nlen=npts/nseg !Length of test segment + i0=npts/2 !Midpoint + k=0 + do n=1,nseg !Skip first segment, likely rolloff here + ib=n*nlen + ia=ib-nlen+1 + if(n.eq.nseg) ib=npts + call pctile(s(ia),ib-ia+1,npct,base) !Find lowest npct of points + do i=ia,ib + if(s(i).le.base) then + if (k.lt.1000) k=k+1 !Save these "lower envelope" points + x(k)=i-i0 + y(k)=s(i) + endif + enddo + enddo + kz=k + a=0. + + call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial + + do i=1,npts + t=i-i0 + yfit=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + s(i)=s(i)-yfit !Subtract the fitted baseline + enddo + endif + +900 return +end subroutine flat4 diff --git a/wsjtx_lib/lib/flat65.f90 b/wsjtx_lib/lib/flat65.f90 new file mode 100644 index 0000000..d7e2680 --- /dev/null +++ b/wsjtx_lib/lib/flat65.f90 @@ -0,0 +1,25 @@ +subroutine flat65(ss,nhsym,maxhsym,nsz,ref) + + real stmp(nsz) + real ss(maxhsym,nsz) + real ref(nsz) + + npct=28 !Somewhat arbitrary + do i=1,nsz + call pctile(ss(1,i),nhsym,npct,stmp(i)) + enddo + + nsmo=33 + ia=nsmo/2 + 1 + ib=nsz - nsmo/2 - 1 + do i=ia,ib + call pctile(stmp(i-nsmo/2),nsmo,npct,ref(i)) + enddo + ref(:ia-1)=ref(ia) + ref(ib+1:)=ref(ib) + ref=4.0*ref + + return +end subroutine flat65 + + diff --git a/wsjtx_lib/lib/fmeasure.f90 b/wsjtx_lib/lib/fmeasure.f90 new file mode 100644 index 0000000..b760958 --- /dev/null +++ b/wsjtx_lib/lib/fmeasure.f90 @@ -0,0 +1,75 @@ +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: fmeasure.f90 +! Description: +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- +program fmeasure + + parameter(NZ=1000) + implicit real*8 (a-h,o-z) + character infile*50 + character line*80 + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: fmeasure ' + print*,'Example: fmeasure fmtave.out' + go to 999 + endif + call getarg(1,infile) + + open(10,file=infile,status='old',err=997) + open(11,file='fcal.out',status='old',err=998) + open(12,file='fmeasure.out',status='unknown') + + read(11,*) a,b + + write(*,1000) + write(12,1000) +1000 format(' Freq DF A+B*f Corrected Offset'/ & + ' (MHz) (Hz) (Hz) (MHz) (Hz)'/ & + '-----------------------------------------------') + i=0 + do j=1,9999 + read(10,1010,end=999) line +1010 format(a80) + i0=index(line,' 0 ') + if(i0.gt.0) then + read(line,*,err=5) f,df + dial_error=a + b*f + fcor=f + 1.d-6*df - 1.d-6*dial_error + offset_hz=1.d6*(fcor-f) + write(*,1020) f,df,dial_error,fcor,offset_hz + write(12,1020) f,df,dial_error,fcor,offset_hz +1020 format(3f8.3,f15.9,f8.2) + endif +5 continue + enddo + + go to 999 + +997 print*,'Cannot open input file: ',infile + go to 999 +998 print*,'Cannot open fcal.out' + +999 end program fmeasure diff --git a/wsjtx_lib/lib/fmtave.f90 b/wsjtx_lib/lib/fmtave.f90 new file mode 100644 index 0000000..e35dbe5 --- /dev/null +++ b/wsjtx_lib/lib/fmtave.f90 @@ -0,0 +1,64 @@ +program fmtave + +! Average groups of frequency-calibration measurements. + + implicit real*8 (a-h,o-z) + character infile*80 + character*8 cutc,cutc1 + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: fmtave ' + print*,'Example: fmtave fmt.all' + go to 999 + endif + call getarg(1,infile) + + open(10,file=infile,status='old') + open(12,file='fmtave.out',status='unknown') + + write(*,1000) +1000 format(' Freq DF CAL N rms UTC Call'/ & + ' (kHz) (Hz) ? (Hz)'/ & + '----------------------------------------------------') + nkhz0=0 + sum=0.d0 + sumsq=0.d0 + n=0 + do i=1,99999 + read(10,*,end=10) cutc,nkHz,ncal,noffset,faudio,df,dblevel,snr + if((nkHz.ne.nkHz0) .and. i.ne.1) then + ave=sum/n + rms=0.d0 + if(n.gt.1) then + rms=sqrt(abs(sumsq - sum*sum/n)/(n-1.d0)) + endif + fMHz=0.001d0*nkHz0 + write(*,1010) fMHz,ave,ncal0,n,rms,cutc1 + write(12,1010) fMHz,ave,ncal0,n,rms,cutc1 +1010 format(f8.3,f9.3,i4,i5,f8.2,2x,a8,2x,a6) + sum=0.d0 + sumsq=0.d0 + n=0 + endif + dial_error=faudio-noffset + sum=sum + dial_error + sumsq=sumsq + dial_error**2 + n=n+1 + if(n.eq.1) then + cutc1=cutc + ncal0=ncal + endif + nkHz0=nkHz + enddo + +10 ave=sum/n + rms=0.d0 + if(n.gt.0) then + rms=sqrt((sumsq - sum*sum/n)/(n-1.d0)) + endif + fMHz=0.001d0*nkHz + write(*,1010) fMHz,ave,ncal,n,rms,cutc1 + write(12,1010) fMHz,ave,ncal,n,rms,cutc1 + +999 end program fmtave diff --git a/wsjtx_lib/lib/fmtmsg.f90 b/wsjtx_lib/lib/fmtmsg.f90 new file mode 100644 index 0000000..81789e2 --- /dev/null +++ b/wsjtx_lib/lib/fmtmsg.f90 @@ -0,0 +1,21 @@ +subroutine fmtmsg(msg,iz) + + character*(*) msg + +! Convert all letters to upper case + iz=len(msg) + do i=1,iz + if(msg(i:i).ge.'a' .and. msg(i:i).le.'z') & + msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a')) + if(msg(i:i).ne.' ') iz=i + enddo + + do iter=1,37 !Collapse multiple blanks into one + ib2=index(msg(1:iz),' ') + if(ib2.lt.1) go to 100 + msg=msg(1:ib2)//msg(ib2+2:) + iz=iz-1 + enddo + +100 return +end subroutine fmtmsg diff --git a/wsjtx_lib/lib/foldspec9f.f90 b/wsjtx_lib/lib/foldspec9f.f90 new file mode 100644 index 0000000..a6436eb --- /dev/null +++ b/wsjtx_lib/lib/foldspec9f.f90 @@ -0,0 +1,30 @@ +subroutine foldspec9f(s1,nq,jz,ja,jb,s2) + +! Fold symbol spectra (quarter-symbol steps) from s1 into s2 + + real s1(nq,jz) + real s2(240,340) !340 = 4*85 + integer nsum(340) + + s2=0. + nsum=0 + + do j=ja,jb + k=mod(j-1,340)+1 + nsum(k)=nsum(k)+1 + do i=1,NQ + s2(i,k)=s2(i,k) + s1(i,j) + enddo + enddo + + do k=1,340 + fac=1.0 + if(nsum(k).gt.0) fac=1.0/nsum(k) + s2(1:nq,k)=fac*s2(1:nq,k) + enddo + + ave=sum(s2)/(340.0*nq) + if(ave.gt.0.0) s2=s2/ave + + return +end subroutine foldspec9f diff --git a/wsjtx_lib/lib/four2a.f90 b/wsjtx_lib/lib/four2a.f90 new file mode 100644 index 0000000..9e08722 --- /dev/null +++ b/wsjtx_lib/lib/four2a.f90 @@ -0,0 +1,114 @@ +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. + + use fftw3 + parameter (NPMAX=2100) !Max numberf of stored plans + parameter (NSMALL=16385) !Max half complex 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 + 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.le.0) jz=nfft/2+1 + 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.le.0) jz=nfft/2+1 + 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/wsjtx_lib/lib/fox_rx.f90 b/wsjtx_lib/lib/fox_rx.f90 new file mode 100644 index 0000000..6794ac8 --- /dev/null +++ b/wsjtx_lib/lib/fox_rx.f90 @@ -0,0 +1,66 @@ +subroutine fox_rx(fail,called,fm,hm) + +! Given fm, recently transmitted by Fox, determine hm -- the next +! message for Hound to transmit + + parameter (MAXSIG=5,NCALLS=268) + character*6 xcall(NCALLS) +! character*8 mycall_plus + character*4 xgrid(NCALLS) + integer isnr(NCALLS) + character*32 fm + character*22 hm + character*6 cx,called,MyCall + character*4 gx + common/dxpfifo/nc,isnr,xcall,xgrid + data MyCall/'KH1DX'/ + save + + call random_number(r) + if(r.lt.fail) fm='' !Hound fails to copy + i1=index(fm,MyCall) + if(fm(1:3).eq.'CQ ' .and. i1.ge.4) then + call dxped_fifo(cx,gx,isnrx) + ntimes=1 + write(hm,1000) MyCall,cx,gx +1000 format(a6,1x,a6,1x,a4) + endif + +! Check for a "RR73" message + ia=index(fm,trim(cx)) + ib=index(fm,';') + ic=index(fm,trim(called)) + id=index(fm,'RR73;') + if((ia.eq.1 .or. ic.eq.ib+2) .and. id.ge.4) then + i1=index(fm,';')+2 + i2=index(fm,'<')-2 + cx=fm(i1:i2) !Callsign for next QSO + call random_number(r) + ireport=nint(-20+40*r) +! Send report to next caller + write(hm,1004) MyCall,cx,ireport +1004 format(a6,1x,a6,' R',i3.2) + if(hm(16:16).eq.' ') hm(16:16)='+' + endif + +! Check for a message with a report to Hound + i1=index(fm,trim(called)) + i2=index(fm,MyCall) + if(i1.eq.1 .and. i2.ge.5 .and. & + (index(fm,'+').ge.8 .or. index(fm,'-').ge.8)) then +! Send "R+rpt" to Fox + write(hm,1004) MyCall,called,isnrx + if(hm(16:16).eq.' ') hm(16:16)='+' + endif + +! Collapse multiple blanks in message + iz=len(trim(hm)) + do iter=1,5 + ib2=index(hm(1:iz),' ') + if(ib2.lt.1) exit + hm=hm(1:ib2)//hm(ib2+2:) + iz=iz-1 + enddo + + return +end subroutine fox_rx diff --git a/wsjtx_lib/lib/fox_sim.f90 b/wsjtx_lib/lib/fox_sim.f90 new file mode 100644 index 0000000..ebc6d8c --- /dev/null +++ b/wsjtx_lib/lib/fox_sim.f90 @@ -0,0 +1,165 @@ +program fox_sim + +! Simulates QSO exchanges using the proposed FT8 "DXpedition" mode. + parameter (MAXSIG=5,NCALLS=268) + character*6 xcall(NCALLS) + character*4 xgrid(NCALLS) + integer isnr(NCALLS) + + character*32 fmsg(MAXSIG),fm + character*22 hmsg(MAXSIG),hm + character*16 log + character*6 called(MAXSIG) + character*4 gcalled(MAXSIG) + character*6 MyCall + character*4 MyGrid + character*8 arg + character*1 c1,c2,c3,c4 + integer ntot(MAXSIG),irate(MAXSIG),ntimes(MAXSIG) + logical logit + common/dxpfifo/nc,isnr,xcall,xgrid + + nargs=iargc() + if(nargs.ne.2 .and. nargs.ne.4) then + print*,'Usage: fox_sim nseq maxtimes' + print*,' fox_sim nseq maxtimes nsig fail' + print*,' ' + print*,' nseq: number of T/R sequences to execute' + print*,' maxtimes: number of repeats of same Tx message' + print*,' nsig: number of simultaneous Tx sigals' + print*,' fail: receiving error rate' + go to 999 + endif + ii1=1 + ii2=5 + jj1=0 + jj2=5 + nseq=80 + if(nargs.ge.2) then + call getarg(1,arg) + read(arg,*) nseq + call getarg(2,arg) + read(arg,*) maxtimes + endif + if(nargs.eq.4) then + call getarg(3,arg) + read(arg,*) nsig + call getarg(4,arg) + read(arg,*) fail + ii1=nsig + ii2=nsig + jj1=nint(10*fail) + jj2=nint(10*fail) + endif + +! Read a file with calls and grids; insert random S/N values. +! This is used in place of an operator-selected FIFO + open(10,file='xcall.txt',status='old') + do i=1,NCALLS + read(10,1000) xcall(i),xgrid(i) +1000 format(a6,7x,a4) + if(i.ne.-99) cycle + j=mod(i-1,26) + c1=char(ichar('A')+j) + k=mod((i-1)/26,26) + c2=char(ichar('A')+k) + n=mod((i-1)/260,10) + c3=char(ichar('0')+n) + xcall(i)='K'//c2//c3//c1//c1//c1 + + j=mod(i-1,18) + c1=char(ichar('A')+j) + k=mod((i-1)/18,18) + c2=char(ichar('A')+k) + n=mod((i-1)/10,10) + c4=char(ichar('0')+n) + n=mod((i-1)/100,10) + c3=char(ichar('0')+n) + xgrid(i)=c1//c2//c3//c4 + + call random_number(x) + isnr(i)=-20+int(40*x) + enddo +! close(10) + +! Write headings for the summary file + minutes=nseq/4 + write(13,1002) nseq,minutes,maxtimes +1002 format(/'Nseq:',i4,' Minutes:',i3,' Maxtimes:',i2// & + 18x,'Logged QSOs',22x,'Rate (QSOs/hour)'/ & + 'fail Nsig: 1 2 3 4 5 1 2 3 4 5'/ & + 71('-')) + + write(*,1003) +1003 format('Seq s n Fox messages Hound messages Logged info i Rate'/87('-')) + + ntot=0 + irate=0 + MyCall='KH1DX' + MyGrid='AJ10' + + do jj=jj1,jj2 !Loop over Rx failure rates + fail=0.1*jj + do ii=ii1,ii2 !Loop over range of nsig + nc=0 !Set FIFO pointer to top + ntimes=1 + nsig=ii + nlogged=0 + fmsg="CQ KH1DX AJ10" + hmsg="" + called=" " + do iseq=0,nseq !Loop over specified number of sequences + if(iand(iseq,1).eq.0) then + do j=1,nsig !Loop over Fox's Tx slots + fm=fmsg(j) + hm=hmsg(j) + +! Call fox_tx to determine the next Tx message for this slot + call fox_tx(maxtimes,fail,called(j),gcalled(j),hm,fm, & + ntimes(j),log,logit) + + fmsg(j)=fm + if(logit) then +! Log this QSO + nlogged=nlogged+1 + nrate=0 + if(iseq.gt.0) nrate=nint(nlogged*240.0/iseq) + write(*,1010) iseq,j,ntimes(j),fmsg(j),log,nlogged,nrate +1010 format(i4.4,2i2,1x,a32,20x,a16,2i4) + ! call log_routine() + else + write(*,1010) iseq,j,ntimes(j),fmsg(j) + endif + enddo + ! call transmit() + endif + + if(iand(iseq,1).eq.1) then + do j=1,nsig !Listen for expected responses + fm=fmsg(j) + call fox_rx(fail,called(j),fm,hm) + if(j.ge.2) then + if(hm.eq.hmsg(j-1)) hm="" + endif + hmsg(j)=hm + write(*,1020) iseq,j,hmsg(j) +1020 format(i4.4,i2,37x,a22) + enddo + endif + write(*,1021) +1021 format(87('-')) + enddo + ntot(ii)=nlogged + irate(ii)=0 + if(iseq.gt.0) irate(ii)=nint(nlogged*3600.0/(15*iseq)) + write(*,1030) nsig,fail,nlogged,nc +1030 format(/'Nsig:',i3,' Fail:',f4.1,' Logged QSOs:',i4, & + ' Final nc:',i4) + enddo + +! Write the summary file + write(13,1100) fail,ntot,irate +1100 format(f4.1,2x,5i6,5x,5i6) + enddo + +999 end program fox_sim diff --git a/wsjtx_lib/lib/fox_tx.f90 b/wsjtx_lib/lib/fox_tx.f90 new file mode 100644 index 0000000..13d0eaa --- /dev/null +++ b/wsjtx_lib/lib/fox_tx.f90 @@ -0,0 +1,92 @@ +subroutine fox_tx(maxtimes,fail,called,gcalled,hm,fm,ntimes,log,logit) + +! Determine fm, the next message for Fox to transmit in this slot + + character*32 fm + character*22 hm + character*4 g4,MyGrid,gcalled,gx,gy + character*6 MyCall,called,cx,cy + character*16 log + logical isgrid,logit + data MyCall/'KH1DX'/,MyGrid/'AJ10'/ + save + + isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. & + g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. & + g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73' + + logit=.false. + n=len(trim(hm)) + g4="" + if(n.gt.8) g4=hm(n-3:n) + call random_number(r) + if(r.lt.fail .and. .not.isgrid(g4)) hm="" !Fox failed to copy + + i2=len(trim(hm)) + if(i2.gt.10) then + i1=index(hm,' ') + i3=index(hm(i1+1:),' ') + i1 + cx=hm(i1+1:i3) + gx=hm(i2-3:i2) + i4=index(hm,MyCall) + +! Check for a new caller + if(i4.eq.1 .and. isgrid(gx)) then + call random_number(r) + isent=nint(-20+40*r) + write(fm,1002) cx,MyCall,isent +1002 format(a6,1x,a6,i4.2) + if(fm(15:15).eq.' ') fm(15:15)='+' + called=cx + gcalled=gx + endif + log='' + +! Check for message with R+rpt + if(i4.eq.1 .and. cx.eq.called .and. & + (index(hm,'R+').ge.8 .or. index(hm,'R-').ge.8)) then + write(log,1006) called,gcalled,isent !Format a log entry +1006 format(a6,2x,a4,i4.2) + if(log(14:14).eq.' ') log(14:14)='+' + logit=.true. + call dxped_fifo(cy,gy,isnry) +! If FIFO is empty we should call CQ in this slot + ntimes=1 + write(fm,1008) cx,cy,isnry +1008 format(a6,' RR73; ',a6,1x,'',i4.2) + if(fm(29:29).eq.' ') fm(29:29)='+' + called=cy + gcalled=gy + endif + endif + + if(hm.eq.'') then + if(fm(1:3).ne.'CQ ') then +! if(ntimes.lt.maxtimes) then + ntimes=ntimes+1 +! else +! ntimes=1 +! If FIFO is empty we should call CQ in this slot +! call dxped_fifo(cy,gy,isnry) +! call random_number(r) +! isnr=nint(-20+40*r) +! write(fm,1010) cy,gy,isnr + write(fm,1010) called,MyCall,isent +1010 format(a6,1x,a6,i4.2) + if(fm(15:15).eq.' ') fm(15:15)='+' +! endif + endif + endif + +! Collapse multiple blanks in message + iz=len(trim(fm)) + do iter=1,5 + ib2=index(fm(1:iz),' ') + if(ib2.lt.1) exit + fm=fm(1:ib2)//fm(ib2+2:) + iz=iz-1 + enddo + +! Generate waveform for fm + return +end subroutine fox_tx diff --git a/wsjtx_lib/lib/fqso_first.f90 b/wsjtx_lib/lib/fqso_first.f90 new file mode 100644 index 0000000..e553e3e --- /dev/null +++ b/wsjtx_lib/lib/fqso_first.f90 @@ -0,0 +1,32 @@ +subroutine fqso_first(nfqso,ntol,ca,ncand) + +! If a candidate was found within +/- ntol of nfqso, move it into ca(1). + + type candidate + real freq + real dt + real sync + real flip + end type candidate + type(candidate) ca(300),cb + + dmin=1.e30 + i0=0 + do i=1,ncand + d=abs(ca(i)%freq-nfqso) + if(d.lt.dmin) then + i0=i + dmin=d + endif + enddo + + if(dmin.lt.float(ntol)) then + cb=ca(i0) + do i=i0,2,-1 + ca(i)=ca(i-1) + enddo + ca(1)=cb + endif + + return +end subroutine fqso_first diff --git a/wsjtx_lib/lib/freqcal.f90 b/wsjtx_lib/lib/freqcal.f90 new file mode 100644 index 0000000..2d2679a --- /dev/null +++ b/wsjtx_lib/lib/freqcal.f90 @@ -0,0 +1,92 @@ +subroutine freqcal(id2,k,nkhz,noffset,ntol,line) + + parameter (NZ=30*12000,NFFT=55296,NH=NFFT/2) + integer*2 id2(0:NZ-1) + complex sp,sn + real x(0:NFFT-1) + real xi(0:NFFT-1) + real w(0:NFFT-1) !Window function + real s(0:NH) + character line*80,cflag*1 + logical first + complex cx(0:NH) + equivalence (x,cx) + data n/0/,k0/9999999/,first/.true./ + save n,k0,w,first,pi,fs,xi + + if(first) then + pi=4.0*atan(1.0) + fs=12000.0 + do i=0,NFFT-1 + ww=sin(i*pi/NFFT) + w(i)=ww*ww/NFFT + xi(i)=2.0*pi*i + enddo + first=.false. + endif + + if(k.lt.NFFT) go to 900 + if(k.lt.k0) n=0 + k0=k + + x=w*id2(k-NFFT:k-1) !Apply window + call four2a(x,NFFT,1,-1,0) !Compute spectrum, r2c + df=fs/NFFT + if (ntol.gt.noffset) then + ia=0 + ib=nint((noffset*2)/df) + else + ia=nint((noffset-ntol)/df) + ib=nint((noffset+ntol)/df) + endif + smax=0. + s=0. + ipk=-99 + do i=ia,ib + s(i)=real(cx(i))**2 + aimag(cx(i))**2 + if(s(i).gt.smax) then + smax=s(i) + ipk=i + endif + enddo + + if(ipk.ge.1) then + call peakup(s(ipk-1),s(ipk),s(ipk+1),dx) + fpeak=df * (ipk+dx) + ap=(fpeak/fs+1.0/(2.0*NFFT)) + an=(fpeak/fs-1.0/(2.0*NFFT)) + sp=sum(id2((k-NFFT):k-1)*cmplx(cos(xi*ap),-sin(xi*ap))) + sn=sum(id2((k-NFFT):k-1)*cmplx(cos(xi*an),-sin(xi*an))) + fpeak=fpeak+fs*(abs(sp)-abs(sn))/(abs(sp)+abs(sn))/(2*NFFT) + xsum=0. + nsum=0 + do i=ia,ib + if(abs(i-ipk).gt.10) then + xsum=xsum+s(i) + nsum=nsum+1 + endif + enddo + ave=xsum/nsum + snr=db(smax/ave) + pave=db(ave) + 8.0 + else + snr=-99.9 + pave=-99.9 + fpeak=-99.9 + ferr=-99.9 + endif + cflag=' ' + if(snr.lt.20.0) cflag='*' + n=n+1 + nsec=mod(time(),86400) + nhr=nsec/3600 + nmin=mod(nsec/60,60) + nsec=mod(nsec,60) + ncal=1 + ferr=fpeak-noffset + write(line,1100) nhr,nmin,nsec,nkhz,ncal,noffset,fpeak,ferr,pave, & + snr,cflag,char(0) +1100 format(i2.2,':',i2.2,':',i2.2,i7,i3,i6,2f10.3,2f7.1,2x,a1,a1) + +900 return +end subroutine freqcal diff --git a/wsjtx_lib/lib/fspread_lorentz.f90 b/wsjtx_lib/lib/fspread_lorentz.f90 new file mode 100644 index 0000000..697d308 --- /dev/null +++ b/wsjtx_lib/lib/fspread_lorentz.f90 @@ -0,0 +1,47 @@ +subroutine fspread_lorentz(cdat,fspread) + + parameter (NZ=3*12000) + complex cdat(0:NZ-1) + complex cspread(0:NZ-1) + complex z + + twopi=8.0*atan(1.0) + nfft=NZ + nh=nfft/2 + df=12000.0/nfft + cspread(0)=1.0 + cspread(nh)=0. + b=6.0 !Use truncated Lorenzian shape for fspread + 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 amplitude + phi1=twopi*rran() !Random phase + z=a*cmplx(cos(phi1),sin(phi1)) + endif + cspread(i)=z + z=0. + if(x.lt.3.0) then !Same thing for negative freqs + phi2=twopi*rran() + z=a*cmplx(cos(phi2),sin(phi2)) + endif + cspread(nfft-i)=z + 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 + cdat=cspread*cdat !Apply Rayleigh fading + + return +end subroutine fspread_lorentz diff --git a/wsjtx_lib/lib/fst280_decode.f90 b/wsjtx_lib/lib/fst280_decode.f90 new file mode 100644 index 0000000..5969146 --- /dev/null +++ b/wsjtx_lib/lib/fst280_decode.f90 @@ -0,0 +1,562 @@ +module fst280_decode + type :: fst280_decoder + procedure(fst280_decode_callback), pointer :: callback + contains + procedure :: decode + end type fst280_decoder + + abstract interface + subroutine fst280_decode_callback (this,nutc,sync,nsnr,dt,freq, & + decoded,nap,qual,ntrperiod) + import fst280_decoder + implicit none + class(fst280_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: sync + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + integer, intent(in) :: ntrperiod + end subroutine fst280_decode_callback + end interface + +contains + + subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfqso, & + nfa,nfb,nsubmode,ndeep,ntrperiod,nexp_decode,ntol) + + use timer_module, only: timer + use packjt77 + include 'fst280/fst280_params.f90' + parameter (MAXCAND=100) + class(fst280_decoder), intent(inout) :: this + procedure(fst280_decode_callback) :: callback + character*37 decodes(100) + character*37 msg + character*77 c77 + complex, allocatable :: c2(:) + complex, allocatable :: cframe(:) + complex, allocatable :: c_bigfft(:) !Complex waveform + real, allocatable :: r_data(:) + real llr(280),llra(280),llrb(280),llrc(280),llrd(280) + real candidates(100,4) + real bitmetrics(328,4) + real s4(0:3,NN) + integer itone(NN) + integer hmod + integer*1 apmask(280),cw(280) + integer*1 hbits(328) + integer*1 message101(101),message74(74) + logical badsync,unpk77_success,single_decode + integer*2 iwave(300*12000) + + this%callback => callback + hmod=2**nsubmode + if(nfqso+nqsoprogress.eq.-999) return + Keff=91 + iwspr=0 + nmax=15*12000 + single_decode=iand(nexp_decode,32).eq.32 + if(ntrperiod.eq.15) then + nsps=800 + nmax=15*12000 + ndown=20/hmod + if(hmod.eq.8) ndown=2 + else if(ntrperiod.eq.30) then + nsps=1680 + nmax=30*12000 + ndown=42/hmod + if(hmod.eq.4) ndown=10 + if(hmod.eq.8) ndown=5 + else if(ntrperiod.eq.60) then + nsps=3888 + nmax=60*12000 + ndown=96/hmod + if(hmod.eq.1) ndown=108 + else if(ntrperiod.eq.120) then + nsps=8200 + nmax=120*12000 + if(hmod.eq.1) ndown=205 + ndown=100/hmod + else if(ntrperiod.eq.300) then + nsps=21168 + nmax=300*12000 + ndown=504/hmod + end if + nss=nsps/ndown + fs=12000.0 !Sample rate + fs2=fs/ndown + nspsec=nint(fs2) + dt=1.0/fs !Sample interval (s) + dt2=1.0/fs2 + tt=nsps*dt !Duration of "itone" symbols (s) + baud=1.0/tt + nfft1=2*int(nmax/2) + nh1=nfft1/2 + allocate( r_data(1:nfft1+2) ) + allocate( c_bigfft(0:nfft1/2) ) + + nfft2=nfft1/ndown + allocate( c2(0:nfft2-1) ) + allocate( cframe(0:164*nss-1) ) + + npts=nmax + if(single_decode) then + fa=max(100,nint(nfqso+1.5*hmod*baud-ntol)) + fb=min(4800,nint(nfqso+1.5*hmod*baud+ntol)) + else + fa=max(100,nfa) + fb=min(4800,nfb) + endif + + if(ndeep.eq.3) then + ntmax=4 ! number of block sizes to try + jittermax=2 + norder=3 + elseif(ndeep.eq.2) then + ntmax=3 + jittermax=2 + norder=3 + elseif(ndeep.eq.1) then + ntmax=1 + jittermax=2 + norder=2 + endif + + ! The big fft is done once and is used for calculating the smoothed spectrum +! and also for downconverting/downsampling each candidate. + r_data(1:nfft1)=iwave(1:nfft1) + r_data(nfft1+1:nfft1+2)=0.0 + call four2a(r_data,nfft1,1,-1,0) + c_bigfft=cmplx(r_data(1:nfft1+2:2),r_data(2:nfft1+2:2)) + +! Get first approximation of candidate frequencies + call get_candidates_fst280(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, & + ncand,candidates,base) + + ndecodes=0 + decodes=' ' + + isbest1=0 + isbest8=0 + fc21=0. + fc28=0. + do icand=1,ncand + fc0=candidates(icand,1) + detmet=candidates(icand,2) + +! Downconvert and downsample a slice of the spectrum centered on the +! rough estimate of the candidates frequency. +! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. +! The size of the downsampled c2 array is nfft2=nfft1/ndown + + call fst280_downsample(c_bigfft,nfft1,ndown,fc0,c2) + + call timer('sync280 ',0) + do isync=0,1 + if(isync.eq.0) then + fc1=0.0 + is0=1.5*nint(fs2) + ishw=1.5*is0 + isst=4*hmod + ifhw=12 + df=.1*baud + else if(isync.eq.1) then + fc1=fc21 + if(hmod.eq.1) fc1=fc28 + is0=isbest1 + if(hmod.eq.1) is0=isbest8 + ishw=4*hmod + isst=1*hmod + ifhw=7 + df=.02*baud + endif + + smax1=0.0 + smax8=0.0 + do if=-ifhw,ifhw + fc=fc1+df*if + do istart=max(1,is0-ishw),is0+ishw,isst + call sync_fst280(c2,istart,fc,hmod,1,nfft2,nss,fs2,sync1) + call sync_fst280(c2,istart,fc,hmod,8,nfft2,nss,fs2,sync8) + if(sync8.gt.smax8) then + fc28=fc + isbest8=istart + smax8=sync8 + endif + if(sync1.gt.smax1) then + fc21=fc + isbest1=istart + smax1=sync1 + endif + enddo + enddo + enddo + call timer('sync280 ',1) + + if(smax8/smax1 .lt. 0.65 ) then + fc2=fc21 + isbest=isbest1 + if(hmod.gt.1) ntmax=1 + njitter=2 + else + fc2=fc28 + isbest=isbest8 + if(hmod.gt.1) ntmax=1 + njitter=2 + endif + fc_synced = fc0 + fc2 + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates(icand,3)=fc_synced + candidates(icand,4)=isbest + enddo +! remove duplicate candidates + do icand=1,ncand + fc=candidates(icand,3) + isbest=nint(candidates(icand,4)) + do ic2=1,ncand + fc2=candidates(ic2,3) + isbest2=nint(candidates(ic2,4)) + if(ic2.ne.icand .and. fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.05*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates(ic2,3)=-1 + endif + endif + endif + enddo + enddo + + ic=0 + do icand=1,ncand + if(candidates(icand,3).gt.0) then + ic=ic+1 + candidates(ic,:)=candidates(icand,:) + endif + enddo + ncand=ic + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + + call fst280_downsample(c_bigfft,nfft1,ndown,fc_synced,c2) + + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + if(is0.lt.0) cycle + cframe=c2(is0:is0+164*nss-1) + bitmetrics=0 + call get_fst280_bitmetrics(cframe,nss,hmod,ntmax,bitmetrics,s4,badsync) + if(badsync) cycle + + hbits=0 + where(bitmetrics(:,1).ge.0) hbits=1 + ns1=count(hbits( 71: 78).eq.(/0,0,0,1,1,0,1,1/)) + ns2=count(hbits( 79: 86).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(243:250).eq.(/0,0,0,1,1,0,1,1/)) + ns6=count(hbits(251:258).eq.(/0,1,0,0,1,1,1,0/)) + nsync_qual=ns1+ns2+ns3+ns4+ns5+ns6 + if(nsync_qual.lt. 26) cycle !### Value ?? ### + + scalefac=2.83 + llra( 1: 14)=bitmetrics( 1: 14, 1) + llra( 15: 28)=bitmetrics(315:328, 1) + llra( 29: 42)=bitmetrics( 15: 28, 1) + llra( 43: 56)=bitmetrics(301:314, 1) + llra( 57: 98)=bitmetrics( 29: 70, 1) + llra( 99:168)=bitmetrics( 87:156, 1) + llra(169:238)=bitmetrics(173:242, 1) + llra(239:280)=bitmetrics(259:300, 1) + llra=scalefac*llra + llrb( 1: 14)=bitmetrics( 1: 14, 2) + llrb( 15: 28)=bitmetrics(315:328, 2) + llrb( 29: 42)=bitmetrics( 15: 28, 2) + llrb( 43: 56)=bitmetrics(301:314, 2) + llrb( 57: 98)=bitmetrics( 29: 70, 2) + llrb( 99:168)=bitmetrics( 87:156, 2) + llrb(169:238)=bitmetrics(173:242, 2) + llrb(239:280)=bitmetrics(259:300, 2) + llrb=scalefac*llrb + llrc( 1: 14)=bitmetrics( 1: 14, 3) + llrc( 15: 28)=bitmetrics(315:328, 3) + llrc( 29: 42)=bitmetrics( 15: 28, 3) + llrc( 43: 56)=bitmetrics(301:314, 3) + llrc( 57: 98)=bitmetrics( 29: 70, 3) + llrc( 99:168)=bitmetrics( 87:156, 3) + llrc(169:238)=bitmetrics(173:242, 3) + llrc(239:280)=bitmetrics(259:300, 3) + llrc=scalefac*llrc + llrd( 1: 14)=bitmetrics( 1: 14, 4) + llrd( 15: 28)=bitmetrics(315:328, 4) + llrd( 29: 42)=bitmetrics( 15: 28, 4) + llrd( 43: 56)=bitmetrics(301:314, 4) + llrd( 57: 98)=bitmetrics( 29: 70, 4) + llrd( 99:168)=bitmetrics( 87:156, 4) + llrd(169:238)=bitmetrics(173:242, 4) + llrd(239:280)=bitmetrics(259:300, 4) + llrd=scalefac*llrd + apmask=0 + + do itry=1,ntmax + if(itry.eq.1) llr=llra + if(itry.eq.2) llr=llrb + if(itry.eq.3) llr=llrc + if(itry.eq.4) llr=llrd + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + call timer('d280_101',0) + call decode280_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d280_101',1) + else + maxosd=2 + call timer('d280_74 ',0) + call decode280_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d280_74 ',1) + endif + if(nharderrors .ge.0) then + if(iwspr.eq.0) then + write(c77,'(77i1)') message101(1:77) + call unpack77(c77,0,msg,unpk77_success) + else + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,0,msg,unpk77_success) + endif + if(unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) exit + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + if(iwspr.eq.0) then + call get_fst280_tones_from_bits(message101,itone,iwspr) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i)**2 + enddo + arg=400.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-21.0-11.7*log10(nsps/800.0) + else + xsnr=-99.9 + endif + endif + nsnr=nint(xsnr) + iaptype=0 + qual=0. + fsig=fc_synced - 1.5*hmod*baud +!write(21,'(8i4,f7.1,f7.2,3f7.1,1x,a37)') & +! nutc,icand,itry,iaptype,ijitter,ntype,nsync_qual,nharderrors,dmin,sync,xsnr,xdt,fsig,msg + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod) + goto 2002 + else + cycle + endif + endif + enddo ! metrics + enddo ! istart jitter +2002 continue + enddo !candidate list!ws + + return + end subroutine decode + + subroutine sync_fst280(cd0,i0,f0,hmod,ncoh,np,nss,fs,sync) + +! Compute sync power for a complex, downsampled FST280 signal. + + include 'fst280/fst280_params.f90' + complex cd0(0:np-1) + complex, allocatable, save :: csync(:) + complex, allocatable, save :: csynct(:) + complex ctwk(8*nss) + complex z1,z2,z3 + logical first + integer hmod,isyncword(0:7) + real f0save + data isyncword/0,1,3,2,1,0,2,3/ + data first/.true./,f0save/0.0/,nss0/-1/ + save first,twopi,dt,fac,f0save,nss0 + p(z1)=(real(z1*fac)**2 + aimag(z1*fac)**2)**0.5 !Compute power + + if(nss.ne.nss0 .and. allocated(csync)) deallocate(csync,csynct) + if(first .or. nss.ne.nss0) then + allocate( csync(8*nss) ) + allocate( csynct(8*nss) ) + twopi=8.0*atan(1.0) + dt=1/fs + k=1 + phi=0.0 + do i=0,7 + dphi=twopi*hmod*(isyncword(i)-1.5)/real(nss) + do j=1,nss + csync(k)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + k=k+1 + enddo + enddo + first=.false. + nss0=nss + fac=1.0/(8.0*nss) + endif + + if(f0.ne.f0save) then + 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 + csynct=ctwk*csync + f0save=f0 + endif + + i1=i0+35*nss !Costas arrays + i2=i0+78*nss + i3=i0+121*nss + + s1=0.0 + s2=0.0 + s3=0.0 + nsec=8/ncoh + do i=1,nsec + is=(i-1)*ncoh*nss + z1=0 + if(i1+is.ge.1) then + z1=sum(cd0(i1+is:i1+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + endif + z2=sum(cd0(i2+is:i2+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + z3=0 + if(i3+is+ncoh*nss-1.le.np) then + z3=sum(cd0(i3+is:i3+is+ncoh*nss-1)*conjg(csynct(is+1:is+ncoh*nss))) + endif + s1=s1+abs(z1)/(8*nss) + s2=s2+abs(z2)/(8*nss) + s3=s3+abs(z3)/(8*nss) + enddo + + sync = s1+s2+s3 + + return + end subroutine sync_fst280 + + subroutine fst280_downsample(c_bigfft,nfft1,ndown,f0,c1) + +! Output: Complex data in c(), sampled at 12000/ndown Hz + + complex c_bigfft(0:nfft1/2) + complex c1(0:nfft1/ndown-1) + + df=12000.0/nfft1 + i0=nint(f0/df) + c1(0)=c_bigfft(i0) + nfft2=nfft1/ndown + do i=1,nfft2/2 + if(i0+i.le.nfft1/2) c1(i)=c_bigfft(i0+i) + if(i0-i.ge.0) c1(nfft2-i)=c_bigfft(i0-i) + enddo + c1=c1/nfft2 + call four2a(c1,nfft2,1,1,1) !c2c FFT back to time domain + return + + end subroutine fst280_downsample + + subroutine get_candidates_fst280(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, & + ncand,candidates,base) + + complex c_bigfft(0:nfft1/2) + integer hmod + integer indx(100) + real candidates(100,4) + real candidates0(100,4) + real snr_cand(100) + real s(18000) + real s2(18000) + data nfft1z/-1/ + save nfft1z + + nh1=nfft1/2 + df1=fs/nfft1 + baud=fs/nsps + df2=baud/2.0 + nd=df2/df1 + ndh=nd/2 + ia=nint(max(100.0,fa)/df2) + ib=nint(min(4800.0,fb)/df2) + signal_bw=4*(12000.0/nsps)*hmod + analysis_bw=min(4800.0,fb)-max(100.0,fa) + noise_bw=10.0*signal_bw + if(analysis_bw.gt.noise_bw) then + ina=ia + inb=ib + else + fcenter=(fa+fb)/2.0 + fl = max(100.0,fcenter-noise_bw/2.)/df2 + fh = min(4800.0,fcenter+noise_bw/2.)/df2 + ina=nint(fl) + inb=nint(fh) + endif + s=0. + do i=ina,inb ! noise analysis window includes signal analysis window + j0=nint(i*df2/df1) + do j=j0-ndh,j0+ndh + s(i)=s(i) + real(c_bigfft(j))**2 + aimag(c_bigfft(j))**2 + enddo + enddo + ina=max(ina,1+3*hmod) + inb=min(inb,18000-3*hmod) + s2=0. + do i=ina,inb + s2(i)=s(i-hmod*3) + s(i-hmod) +s(i+hmod) +s(i+hmod*3) + enddo + call pctile(s2(ina+hmod*3:inb-hmod*3),inb-ina+1-hmod*6,30,base) + s2=s2/base + thresh=1.25 + + ncand=0 + candidates=0 + if(ia.lt.3) ia=3 + if(ib.gt.18000-2) ib=18000-2 + do i=ia,ib + if((s2(i).gt.s2(i-2)).and. & + (s2(i).gt.s2(i+2)).and. & + (s2(i).gt.thresh).and.ncand.lt.100) then + ncand=ncand+1 + candidates(ncand,1)=df2*i + candidates(ncand,2)=s2(i) + endif + enddo + + snr_cand=0. + snr_cand(1:ncand)=candidates(1:ncand,2) + call indexx(snr_cand,ncand,indx) + nmax=min(ncand,20) + do i=1,nmax + j=indx(ncand+1-i) + candidates0(i,1:4)=candidates(j,1:4) + enddo + ncand=nmax + candidates(1:ncand,1:4)=candidates0(1:ncand,1:4) + candidates(ncand+1:,1:4)=0. + return + end subroutine get_candidates_fst280 + +end module fst280_decode diff --git a/wsjtx_lib/lib/fst4/bpdecode240_101.f90 b/wsjtx_lib/lib/fst4/bpdecode240_101.f90 new file mode 100644 index 0000000..1e2adbb --- /dev/null +++ b/wsjtx_lib/lib/fst4/bpdecode240_101.f90 @@ -0,0 +1,111 @@ +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/wsjtx_lib/lib/fst4/decode240_101.f90 b/wsjtx_lib/lib/fst4/decode240_101.f90 new file mode 100644 index 0000000..4271a46 --- /dev/null +++ b/wsjtx_lib/lib/fst4/decode240_101.f90 @@ -0,0 +1,155 @@ +subroutine decode240_101(llr,Keff,maxosd,norder,apmask,message101,cw,ntype,nharderror,dmin) +! +! A hybrid bp/osd decoder for the (240,101) code. +! +! maxosd<0: do bp only +! maxosd=0: do bp and then call osd once with channel llrs +! maxosd>1: do bp and then call osd maxosd times with saved bp outputs +! norder : osd decoding depth +! + integer, parameter:: N=240, K=101, M=N-K + integer*1 cw(N),apmask(N) + integer*1 nxor(N),hdec(N) + integer*1 message101(101),m101(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),zsave(N,3) + real llr(N) + real Tmn + + include "ldpc_240_101_parity.f90" + + maxiterations=30 + nosd=0 + if(maxosd.gt.3) maxosd=3 + if(maxosd.eq.0) then ! osd with channel llrs + nosd=1 + zsave(:,1)=llr + elseif(maxosd.gt.0) then ! + nosd=maxosd + elseif(maxosd.lt.0) then ! just bp + nosd=0 + endif + + 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 + zsum=0.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 + zsum=zsum+zn + if(iter.gt.0 .and. iter.le.maxosd) then + zsave(:,iter)=zsum + endif + +! 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 + enddo + if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it + m101=0 + m101(1:101)=cw(1:101) + call get_crc24(m101,101,nbadcrc) + if(nbadcrc.eq.0) then + message101=cw(1:101) + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + nharderror=sum(nxor) + dmin=sum(nxor*abs(llr)) + ntype=1 + 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 + exit + 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 + + do i=1,nosd + zn=zsave(:,i) + call osd240_101(zn,Keff,apmask,norder,message101,cw,nharderror,dminosd) + if(nharderror.gt.0) then + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + nharderror=sum(nxor) ! re-calculate nharderror based on input llrs + dmin=sum(nxor*abs(llr)) + ntype=1+i + return + endif + enddo + + ntype=0 + nharderror=-1 + dminosd=0.0 + + return +end subroutine decode240_101 diff --git a/wsjtx_lib/lib/fst4/decode240_74.f90 b/wsjtx_lib/lib/fst4/decode240_74.f90 new file mode 100644 index 0000000..f5aac2e --- /dev/null +++ b/wsjtx_lib/lib/fst4/decode240_74.f90 @@ -0,0 +1,161 @@ +subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharderror,dmin) +! +! A hybrid bp/osd decoder for the (240,74) code. +! +! maxosd<0: do bp only +! maxosd=0: do bp and then call osd once with channel llrs +! maxosd>1: do bp and then call osd maxosd times with saved bp outputs +! norder : osd decoding depth +! + integer, parameter:: N=240, K=74, M=N-K + integer*1 cw(N),apmask(N) + integer*1 nxor(N),hdec(N) + integer*1 message74(74),m74(74) + integer nrw(M),ncw + integer Nm(5,M) + integer Mn(3,N) ! 3 checks per bit + integer synd(M) + real tov(3,N) + real toc(5,M) + real tanhtoc(5,M) + real zn(N),zsum(N),zsave(N,3) + real llr(N) + real Tmn + + include "ldpc_240_74_parity.f90" + + maxiterations=30 + if(Keff.eq.50) maxiterations=1 + + nosd=0 + if(maxosd.gt.3) maxosd=3 + if(maxosd.eq.0) then ! osd with channel llrs + nosd=1 + zsave(:,1)=llr + elseif(maxosd.gt.0) then ! + nosd=maxosd + elseif(maxosd.lt.0) then ! just bp + nosd=0 + endif + + if(maxosd.eq.0) goto 73 + + 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 + zsum=0.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 + zsum=zsum+zn + if(iter.gt.0 .and. iter.le.maxosd) then + zsave(:,iter)=zsum + endif + +! 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 + enddo + if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it + m74=0 + m74(1:74)=cw(1:74) + call get_crc24(m74,74,nbadcrc) + if(nbadcrc.eq.0) then + message74=cw(1:74) + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + nharderror=sum(nxor) + dmin=sum(nxor*abs(llr)) + ntype=1 + 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 + exit + 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:5,i)=tanh(-toc(1:5,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 + +73 continue + do i=1,nosd + zn=zsave(:,i) +! call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) + call fastosd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) + if(nharderror.gt.0) then + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + nharderror=sum(nxor) ! nharderror based on input llrs + dmin=sum(nxor*abs(llr)) + ntype=1+i + return + endif + enddo + + ntype=0 + nharderror=-1 + dminosd=0.0 + + return +end subroutine decode240_74 diff --git a/wsjtx_lib/lib/fst4/encode240_101.f90 b/wsjtx_lib/lib/fst4/encode240_101.f90 new file mode 100644 index 0000000..bd16b3c --- /dev/null +++ b/wsjtx_lib/lib/fst4/encode240_101.f90 @@ -0,0 +1,44 @@ +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 + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message(K) + integer*1 pchecks(M) + 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/wsjtx_lib/lib/fst4/encode240_74.f90 b/wsjtx_lib/lib/fst4/encode240_74.f90 new file mode 100644 index 0000000..4590414 --- /dev/null +++ b/wsjtx_lib/lib/fst4/encode240_74.f90 @@ -0,0 +1,44 @@ +subroutine encode240_74(message,codeword) + use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_loc,c_size_t + use crc + + integer, parameter:: N=240, K=74, M=N-K + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message(K) + integer*1 pchecks(M) + include "ldpc_240_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 encode240_74 diff --git a/wsjtx_lib/lib/fst4/fastosd240_74.f90 b/wsjtx_lib/lib/fst4/fastosd240_74.f90 new file mode 100644 index 0000000..aa14506 --- /dev/null +++ b/wsjtx_lib/lib/fst4/fastosd240_74.f90 @@ -0,0 +1,292 @@ +subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (240,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 77+p1. +! +! Valid values for k are in the range [50,74]. +! + 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(:),temprow(:),m0(:),me(:),mi(:) + integer indices(N),indices2(N),nxor(N) + integer*1 cw(N),ce(N),c0(N),hdec(N) + integer*1, allocatable :: decoded(:) + integer*1 message74(74) + integer*1, allocatable :: sp(:) + integer indx(N),ksave + real llr(N),rx(N),absrx(N) + + logical first + data first/.true./,ksave/64/ + save first,ksave + + allocate( genmrb(k,N), g2(N,k) ) + allocate( temp(k), temprow(n), m0(k), me(k), mi(k) ) + allocate( decoded(k) ) + + if( first .or. k.ne.ksave) 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. +! + if( allocated(gen) ) deallocate(gen) + 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 encode240_74(message74,cw) + gen(i,:)=cw + enddo + + first=.false. + ksave=k + endif + +! Use best k elements from the sorted list for the first basis. For the 2nd basis replace +! the nswap lowest quality symbols with the best nswap elements from the parity symbols. + nswap=20 + + do ibasis=1,2 + 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(llr) + 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 + + if(ibasis.eq.2) then + do i=k-nswap+1,k + temp(1:k)=genmrb(1:k,i) + genmrb(1:k,i)=genmrb(1:k,i+nswap) + genmrb(1:k,i+nswap)=temp(1:k) + itmp=indices(i) + indices(i)=indices(i+nswap) + indices(i+nswap)=itmp + enddo + endif + +! 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). + + icol=1 + indices2=0 + nskipped=0 + do id=1,k + iflag=0 + do while(iflag.eq.0) + if(genmrb(id,icol).ne.1) then + do j=id+1,k + if(genmrb(j,icol).eq.1) then + temprow=genmrb(id,:) + genmrb(id,:)=genmrb(j,:) + genmrb(j,:)=temprow + iflag=1 + endif + enddo + if(iflag.eq.0) then ! skip this column + nskipped=nskipped+1 + indices2(k+nskipped)=icol ! put icol where skipped columns go + icol=icol+1 ! look at the next column + endif + else + iflag=1 + endif + enddo + indices2(id)=icol + do j=1,k + if(id.ne.j .and. genmrb(j,icol).eq.1) then + genmrb(j,:)=ieor(genmrb(id,:),genmrb(j,:)) + endif + enddo + icol=icol+1 + enddo + do i=k+nskipped+1,240 + indices2(i)=i + enddo + genmrb(1:k,:)=genmrb(1:k,indices2) + indices=indices(indices2) + +!************************************ + 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=abs(llr) + 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) + np=32 + if(ibasis.eq.1) allocate(sp(np)) + + cw=c0 + ntotal=0 + nrejected=0 + xlambda=0.0 + + if(ndeep.eq.0) goto 998 ! norder=0 + if(ndeep.gt.4) ndeep=4 + if( ndeep.eq. 1) then + nord=1 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.2) then + nord=2 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.3) then + nord=3 + xlambda=4.0 + nsyncmax=11 + elseif(ndeep.eq.4) then + nord=4 + xlambda=3.4 + nsyndmax=12 + endif + + s1=sum(absrx(1:k)) + s2=sum(absrx(k+1:N)) + rho=s1/(s1+xlambda*s2) + rhodmin=rho*dmin + nerr64=-1 + do iorder=1,nord +!beta=0.0 +!if(iorder.ge.3) beta=0.4 +!spnc_order=sum(absrx(k-iorder+1:k))+beta*(N-k) +!if(dmin.lt.spnc_order) cycle + mi(1:k-iorder)=0 + mi(k-iorder+1:k)=1 + iflag=k-iorder+1 + do while(iflag .ge.0) + ntotal=ntotal+1 + me=ieor(m0,mi) + d1=sum(mi(1:k)*absrx(1:k)) + if(d1.gt.rhodmin) exit + call partial_syndrome(me,sp,np,g2,N,K) + nwhsp=sum(ieor(sp(1:np),hdec(k:k+np-1))) + if(nwhsp.le.nsyndmax) then + call mrbencode74(me,ce,g2,N,k) + nxor=ieor(ce,hdec) + dd=sum(nxor*absrx(1:N)) + if( dd .lt. dmin ) then + dmin=dd + rhodmin=rho*dmin + cw=ce + nhardmin=sum(nxor) + nwhspmin=nwhsp + nerr64=sum(nxor(1:K)) + endif + endif +! Get the next test error pattern, iflag will go negative +! when the last pattern with weight iorder has been generated. + call nextpat74(mi,k,iorder,iflag) + enddo + enddo + +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.eq.0) exit + nhardmin=-nhardmin + enddo ! basis loop + return +end subroutine fastosd240_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 partial_syndrome(me,sp,np,g2,N,K) + integer*1 me(K),sp(np),g2(N,K) +! compute partial syndrome + sp=0 + do i=1,K + if( me(i) .eq. 1 ) then + sp=ieor(sp,g2(K:K+np-1,i)) + endif + enddo + return +end subroutine partial_syndrome + +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 + diff --git a/wsjtx_lib/lib/fst4/fst4_baseline.f90 b/wsjtx_lib/lib/fst4/fst4_baseline.f90 new file mode 100644 index 0000000..0000fa6 --- /dev/null +++ b/wsjtx_lib/lib/fst4/fst4_baseline.f90 @@ -0,0 +1,48 @@ +subroutine fst4_baseline(s,np,ia,ib,npct,sbase) + +! Fit baseline to spectrum (for FST4) +! Input: s(npts) Linear scale in power +! Output: sbase(npts) Baseline + + implicit real*8 (a-h,o-z) + real*4 s(np),sw(np) + real*4 sbase(np) + real*4 base + real*8 x(1000),y(1000),a(5) + data nseg/8/ + + do i=ia,ib + sw(i)=10.0*log10(s(i)) !Convert to dB scale + enddo + + nterms=3 + nlen=(ib-ia+1)/nseg !Length of test segment + i0=(ib-ia+1)/2 !Midpoint + k=0 + do n=1,nseg !Loop over all segments + ja=ia + (n-1)*nlen + jb=ja+nlen-1 + call pctile(sw(ja),nlen,npct,base) !Find lowest npct of points + do i=ja,jb + if(sw(i).le.base) then + if (k.lt.1000) k=k+1 !Save all "lower envelope" points + x(k)=i-i0 + y(k)=sw(i) + endif + enddo + enddo + kz=k + a=0. + call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial + sbase=0.0 + do i=ia,ib + t=i-i0 + sbase(i)=a(1)+t*(a(2)+t*(a(3))) + 0.2 +! write(51,3051) i,sw(i),sbase(i) +!3051 format(i8,2f12.3) + enddo + + sbase=10**(sbase/10.0) + + return +end subroutine fst4_baseline diff --git a/wsjtx_lib/lib/fst4/fst4_params.f90 b/wsjtx_lib/lib/fst4/fst4_params.f90 new file mode 100644 index 0000000..72f3884 --- /dev/null +++ b/wsjtx_lib/lib/fst4/fst4_params.f90 @@ -0,0 +1,7 @@ +! FST4 +! LDPC(240,101)/CRC24 code, five 8x4 sync + +parameter (KK=77) !Information bits (77 + CRC24) +parameter (ND=120) !Data symbols +parameter (NS=40) !Sync symbols +parameter (NN=NS+ND) !Sync and data symbols (160) diff --git a/wsjtx_lib/lib/fst4/fst4sim.f90 b/wsjtx_lib/lib/fst4/fst4sim.f90 new file mode 100644 index 0000000..936c4b6 --- /dev/null +++ b/wsjtx_lib/lib/fst4/fst4sim.f90 @@ -0,0 +1,159 @@ +program fst4sim + +! Generate simulated signals for experimental slow FT4 mode + + use wavhdr + use packjt77 + include 'fst4_params.f90' !Set various constants + type(hdr) h !Header for .wav file + logical*1 wspr_hint + character arg*12,fname*17 + character msg37*37,msgsent37*37,c77*77 + complex, allocatable :: c0(:) + complex, allocatable :: c(:) + real, allocatable :: wave(:) + integer hmod + integer itone(NN) + integer*1 msgbits(101) + integer*2, allocatable :: iwave(:) !Generated full-length waveform + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.9) then + print*,'Need 9 arguments, got ',nargs + print*,'Usage: fst4sim "message" TRsec f0 DT fdop del nfiles snr W' + print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 0.1 1.0 10 -15 F' + print*,'W (T or F) argument is hint to encoder to use WSPR message when there is abiguity' + go to 999 + endif + call getarg(1,msg37) !Message to be transmitted + call getarg(2,arg) + read(arg,*) nsec !TR sequence length, seconds + call getarg(3,arg) + read(arg,*) f00 !Frequency (only used for single-signal) + call getarg(4,arg) + read(arg,*) xdt !Time offset from nominal (s) + 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 + call getarg(9,arg) + read(arg,*) wspr_hint !0:break ties as 77-bit 1:break ties as 50-bit + + nfiles=abs(nfiles) + twopi=8.0*atan(1.0) + fs=12000.0 !Sample rate (Hz) + dt=1.0/fs !Sample interval (s) + nsps=0 + if(nsec.eq.15) nsps=720 + if(nsec.eq.30) nsps=1680 + if(nsec.eq.60) nsps=3888 + if(nsec.eq.120) nsps=8200 + if(nsec.eq.300) nsps=21504 + if(nsec.eq.900) nsps=66560 + if(nsec.eq.1800) nsps=134400 + if(nsps.eq.0) then + print*,'Invalid TR sequence length.' + go to 999 + endif + baud=12000.0/nsps !Keying rate (baud) + nmax=nsec*12000 + nz=nsps*NN + txt=nz*dt !Transmission length (s) + tt=nsps*dt !Duration of symbols (s) + nwave=max(nmax,(NN+2)*nsps) + allocate( c0(0:nwave-1) ) + allocate( c(0:nwave-1) ) + allocate( wave(nwave) ) + allocate( iwave(nmax) ) + + 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 + + if(wspr_hint) then + i3=0 + n3=6 + else + i3=-1 + n3=-1 + endif + call pack77(msg37,i3,n3,c77) + if(i3.eq.0.and.n3.eq.6) iwspr=1 + call genfst4(msg37,0,msgsent37,msgbits,itone,iwspr) + write(*,*) + write(*,'(a9,a37,a3,L2,a7,i2)') 'Message: ',msgsent37,'W:',wspr_hint,' iwspr:',iwspr + write(*,1000) f00,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) + elseif(i3.eq.0 .and. n3.eq.6) then + write(*,'(a15,37x,a5)') '50-bit message','CRC24' + write(*,'(50i1,1x,24i1)') msgbits(1:50),msgbits(51:74) + write(*,'(a50)') '01234567890123456789012345678901234567890123456789' + else + write(*,'(a14)') 'Message bits: ' + write(*,'(77i1,1x,24i1)') msgbits + endif + write(*,*) + write(*,'(a17)') 'Channel symbols: ' + write(*,'(10i1)') itone + write(*,*) + +! call sgran() + + fsample=12000.0 + hmod=1 + icmplx=1 + f0=f00+1.5*hmod*baud + call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,f0,icmplx,c0,wave) + k=nint((xdt+1.0)/dt) + if(nsec.eq.15) k=nint((xdt+0.5)/dt) + 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.gt.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.lt.0.0) call lorentzian_fading(c,nwave,fs,-fspread) + c=sig*c + wave=aimag(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(:size(iwave))) + h=default_header(12000,nmax) + if(nmax/12000.le.30) then + write(fname,1102) ifile +1102 format('000000_',i6.6,'.wav') + else + write(fname,1104) ifile +1104 format('000000_',i4.4,'.wav') + endif + open(10,file=trim(fname),status='unknown',access='stream') + write(10) h,iwave !Save to *.wav file + close(10) + write(*,1110) ifile,xdt,f00,snrdb,fname +1110 format(i4,f7.2,f8.2,f7.1,2x,a17) + enddo + +999 end program fst4sim diff --git a/wsjtx_lib/lib/fst4/gen_fst4wave.f90 b/wsjtx_lib/lib/fst4/gen_fst4wave.f90 new file mode 100644 index 0000000..74a9b34 --- /dev/null +++ b/wsjtx_lib/lib/fst4/gen_fst4wave.f90 @@ -0,0 +1,93 @@ +subroutine gen_fst4wave(itone,nsym,nsps,nwave,fsample,hmod,f0, & + icmplx,cwave,wave) + + use prog_args + parameter(NTAB=65536) + real wave(nwave) + complex cwave(nwave),ctab(0:NTAB-1) + character(len=1) :: cvalue + real, allocatable, save :: pulse(:) + real, allocatable :: dphi(:) + integer hmod + integer itone(nsym) + logical first, lshape + data first/.true./ + data nsps0/-99/ + data lshape/.true./ + save first,twopi,dt,tsym,nsps0,ctab,lshape + + if(first) then + twopi=8.0*atan(1.0) + do i=0,NTAB-1 + phi=i*twopi/NTAB + ctab(i)=cmplx(cos(phi),sin(phi)) + enddo + call get_environment_variable("FST4_NOSHAPING",cvalue,nlen) + if(nlen.eq.1 .and. cvalue.eq."1") lshape=.false. + endif + + if(first.or.nsps.ne.nsps0) then + if(allocated(pulse)) deallocate(pulse) + allocate(pulse(1:3*nsps)) + 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(2.0,tt) + enddo + first=.false. + nsps0=nsps + 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 + if(icmplx.eq.0) wave=0. + if(icmplx.eq.1) cwave=0. + k=0 + do j=nsps,(nsym+1)*nsps-1 + k=k+1 + i=phi*float(NTAB)/twopi + i=iand(i,NTAB-1) + if(icmplx.eq.0) then + wave(k)=aimag(ctab(i)) + else + cwave(k)=ctab(i) + endif + phi=phi+dphi(j) + if(phi.gt.twopi) phi=phi-twopi + enddo + +! Compute the ramp-up and ramp-down symbols + if(icmplx.eq.0) then + if(lshape) then + wave(1:nsps/4)=wave(1:nsps/4) * & + (1.0-cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0 + k1=(nsym-1)*nsps+3*nsps/4+1 + wave(k1:k1+nsps/4)=wave(k1:k1+nsps/4) * & + (1.0+cos(twopi*(/(i,i=0,nsps/4)/)/real(nsps/2)))/2.0 + endif + else + if(lshape) then + cwave(1:nsps/4)=cwave(1:nsps/4) * & + (1.0-cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0 + k1=(nsym-1)*nsps+3*nsps/4+1 + cwave(k1:k1+nsps/4)=cwave(k1:k1+nsps/4) * & + (1.0+cos(twopi*(/(i,i=0,nsps/4)/)/real(nsps/2)))/2.0 + endif + endif + + return +end subroutine gen_fst4wave diff --git a/wsjtx_lib/lib/fst4/genfst4.f90 b/wsjtx_lib/lib/fst4/genfst4.f90 new file mode 100644 index 0000000..4295055 --- /dev/null +++ b/wsjtx_lib/lib/fst4/genfst4.f90 @@ -0,0 +1,111 @@ +subroutine genfst4(msg0,ichk,msgsent,msgbits,i4tone,iwspr) + +! 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} +! - iwspr in: 0: FST4 1: FST4W +! out 0: (240,101)/crc24, 1: (240,74)/crc24 +! +! Frame structure: +! s8 d30 s8 d30 s8 d30 s8 d30 s8 + + use packjt77 + include 'fst4_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 isyncword1(8),isyncword2(8) + integer ncrc24 + logical unpk77_success + data isyncword1/0,1,3,2,1,0,2,3/ + data isyncword2/2,3,1,0,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 + if(iwspr.eq.1) then + i3=0 + n3=6 + endif + call pack77(message,i3,n3,c77) + call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent + msgbits=0 + iwspr=0 + if(i3.eq.0.and.n3.eq.6) then + iwspr=1 + read(c77,'(50i1)') msgbits(1:50) + call get_crc24(msgbits,74,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') msgbits(51:74) + else + read(c77,'(77i1)') msgbits(1:77) + msgbits(1:77)=mod(msgbits(1:77)+rvec,2) + call get_crc24(msgbits,101,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') msgbits(78:101) + endif + + if(ichk.eq.1) go to 999 + if(unpk77_success) go to 2 + msgbits=0 + itone=0 + msgsent='*** bad message *** ' + go to 999 + + entry get_fst4_tones_from_bits(msgbits,i4tone,iwspr) + +2 continue + if(iwspr.eq.0) then + call encode240_101(msgbits,codeword) + else + call encode240_74(msgbits(1:74),codeword) + endif + +! 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: 8)=isyncword1 + i4tone( 9: 38)=itmp( 1: 30) + i4tone( 39: 46)=isyncword2 + i4tone( 47: 76)=itmp( 31: 60) + i4tone( 77: 84)=isyncword1 + i4tone( 85:114)=itmp( 61: 90) + i4tone(115:122)=isyncword2 + i4tone(123:152)=itmp( 91:120) + i4tone(153:160)=isyncword1 + +999 return + +end subroutine genfst4 diff --git a/wsjtx_lib/lib/fst4/get_crc24.f90 b/wsjtx_lib/lib/fst4/get_crc24.f90 new file mode 100644 index 0000000..cb7f3a0 --- /dev/null +++ b/wsjtx_lib/lib/fst4/get_crc24.f90 @@ -0,0 +1,25 @@ +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/wsjtx_lib/lib/fst4/get_fst4_bitmetrics.f90 b/wsjtx_lib/lib/fst4/get_fst4_bitmetrics.f90 new file mode 100644 index 0000000..0ae747c --- /dev/null +++ b/wsjtx_lib/lib/fst4/get_fst4_bitmetrics.f90 @@ -0,0 +1,190 @@ +subroutine get_fst4_bitmetrics(cd,nss,bitmetrics,s4,nsync_qual,badsync) + + use timer_module, only: timer + include 'fst4_params.f90' + complex cd(0:NN*nss-1) + complex cs(0:3,NN) + complex csymb(nss) + complex, allocatable, save :: ci(:,:) ! ideal waveforms, 20 samples per symbol, 4 tones + complex c1(4,8),c2(16,4),c4(256,2) + integer isyncword1(0:7),isyncword2(0:7) + integer graymap(0:3) + integer ip(1) + integer hbits(2*NN) + 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 isyncword1/0,1,3,2,1,0,2,3/ + data isyncword2/2,3,1,0,3,2,0,1/ + data graymap/0,1,3,2/ + data first/.true./,nss0/-1/ + save first,one,nss0 + + if(nss.ne.nss0 .and. allocated(ci)) deallocate(ci) + + if(first .or. nss.ne.nss0) then + allocate(ci(nss,0:3)) + 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/nss + do itone=0,3 + dp=(itone-1.5)*dphi + phi=0.0 + do j=1,nss + ci(j,itone)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dp,twopi) + enddo + 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(ci(:,itone))) + enddo + s4(0:3,k)=abs(cs(0:3,k))**2 + enddo + +! Sync quality check + is1=0 + is2=0 + is3=0 + is4=0 + is5=0 + badsync=.false. + ibmax=0 + + do k=1,8 + ip=maxloc(s4(:,k)) + if(isyncword1(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s4(:,k+38)) + if(isyncword2(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s4(:,k+76)) + if(isyncword1(k-1).eq.(ip(1)-1)) is3=is3+1 + ip=maxloc(s4(:,k+114)) + if(isyncword2(k-1).eq.(ip(1)-1)) is4=is4+1 + ip=maxloc(s4(:,k+152)) + if(isyncword1(k-1).eq.(ip(1)-1)) is5=is5+1 + enddo + nsync=is1+is2+is3+is4+is5 !Number of correct hard sync symbols, 0-40 + badsync=.false. + if(nsync .lt. 16) then + badsync=.true. + return + endif + + call timer('seqcorrs',0) + bitmetrics=0.0 + +! Process the frame in 8-symbol chunks. Use 1-symbol correlations to calculate +! 2-symbol correlations. Then use 2-symbol correlations to calculate 4-symbol +! correlations. Finally, use 4-symbol correlations to calculate 8-symbol corrs. +! This eliminates redundant calculations. + + do k=1,NN,8 + + do m=1,8 ! do 4 1-symbol correlations for each of 8 symbs + s2=0 + do n=1,4 + c1(n,m)=cs(graymap(n-1),k+m-1) + s2(n-1)=abs(c1(n,m)) + enddo + ipt=(k-1)*2+2*(m-1)+1 + do ib=0,1 + bm=maxval(s2(0:3),one(0:3,1-ib)) - & + maxval(s2(0:3),.not.one(0:3,1-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,1)=bm + enddo + enddo + + do m=1,4 ! do 16 2-symbol correlations for each of 4 2-symbol groups + s2=0 + do i=1,4 + do j=1,4 + is=(i-1)*4+j + c2(is,m)=c1(i,2*m-1)-c1(j,2*m) + s2(is-1)=abs(c2(is,m)) + enddo + enddo + ipt=(k-1)*2+4*(m-1)+1 + do ib=0,3 + bm=maxval(s2(0:15),one(0:15,3-ib)) - & + maxval(s2(0:15),.not.one(0:15,3-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,2)=bm + enddo + enddo + + do m=1,2 ! do 256 4-symbol corrs for each of 2 4-symbol groups + s2=0 + do i=1,16 + do j=1,16 + is=(i-1)*16+j + c4(is,m)=c2(i,2*m-1)+c2(j,2*m) + s2(is-1)=abs(c4(is,m)) + enddo + enddo + ipt=(k-1)*2+8*(m-1)+1 + do ib=0,7 + bm=maxval(s2(0:255),one(0:255,7-ib)) - & + maxval(s2(0:255),.not.one(0:255,7-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,3)=bm + enddo + enddo + + s2=0 ! do 65536 8-symbol correlations for the entire group + do i=1,256 + do j=1,256 + is=(i-1)*256+j + s2(is-1)=abs(c4(i,1)+c4(j,2)) + enddo + enddo + ipt=(k-1)*2+1 + do ib=0,15 + bm=maxval(s2(0:65535),one(0:65535,15-ib)) - & + maxval(s2(0:65535),.not.one(0:65535,15-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,4)=bm + enddo + + enddo + + call timer('seqcorrs',1) + + hbits=0 + where(bitmetrics(:,1).ge.0) hbits=1 + ns1=count(hbits( 1: 16).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + ns2=count(hbits( 77: 92).eq.(/1,1,1,0,0,1,0,0,1,0,1,1,0,0,0,1/)) + ns3=count(hbits(153:168).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + ns4=count(hbits(229:244).eq.(/1,1,1,0,0,1,0,0,1,0,1,1,0,0,0,1/)) + ns5=count(hbits(305:320).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/)) + nsync_qual=ns1+ns2+ns3+ns4+ns5 + + if(nsync_qual.lt. 46) then + badsync=.true. + return + endif + + call normalizebmet(bitmetrics(:,1),2*NN) + call normalizebmet(bitmetrics(:,2),2*NN) + call normalizebmet(bitmetrics(:,3),2*NN) + call normalizebmet(bitmetrics(:,4),2*NN) + + scalefac=2.83 + bitmetrics=scalefac*bitmetrics + + return + +end subroutine get_fst4_bitmetrics diff --git a/wsjtx_lib/lib/fst4/get_fst4_bitmetrics2.f90 b/wsjtx_lib/lib/fst4/get_fst4_bitmetrics2.f90 new file mode 100644 index 0000000..96557d2 --- /dev/null +++ b/wsjtx_lib/lib/fst4/get_fst4_bitmetrics2.f90 @@ -0,0 +1,127 @@ +subroutine get_fst4_bitmetrics2(cd,nss,hmod,nsizes,bitmetrics,s4snr,badsync) + + include 'fst4_params.f90' + complex cd(0:NN*nss-1) + complex csymb(nss) + complex, allocatable, save :: c1(:,:) ! ideal waveforms, 4 tones + complex cp(0:3) ! accumulated phase shift over symbol types 0:3 + integer isyncword1(0:7),isyncword2(0:7) + integer graymap(0:3) + integer ip(1) + integer hmod + 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,4),s4snr(0:3,NN) + data isyncword1/0,1,3,2,1,0,2,3/ + data isyncword2/2,3,1,0,3,2,0,1/ + data graymap/0,1,3,2/ + data first/.true./,nss0/-1/ + save first,one,cp,nss0 + + if(nss.ne.nss0 .and. allocated(c1)) deallocate(c1) + if(first .or. nss.ne.nss0) then + allocate(c1(nss,0:3)) + 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 + s4(itone,k,1)=abs(sum(csymb*conjg(c1(:,itone))))**2 + s4(itone,k,2)=abs(sum(csymb( 1:nss/2)*conjg(c1( 1:nss/2,itone))))**2 + & + abs(sum(csymb(nss/2+1: nss)*conjg(c1(nss/2+1: nss,itone))))**2 + s4(itone,k,3)=abs(sum(csymb( 1: nss/4)*conjg(c1( 1: nss/4,itone))))**2 + & + abs(sum(csymb( nss/4+1: nss/2)*conjg(c1( nss/4+1: nss/2,itone))))**2 + & + abs(sum(csymb( nss/2+1:3*nss/4)*conjg(c1( nss/2+1:3*nss/4,itone))))**2 + & + abs(sum(csymb(3*nss/4+1: nss)*conjg(c1(3*nss/4+1: nss,itone))))**2 + s4(itone,k,4)=abs(sum(csymb( 1: nss/8)*conjg(c1( 1: nss/8,itone))))**2 + & + abs(sum(csymb( nss/8+1: nss/4)*conjg(c1( nss/8+1: nss/4,itone))))**2 + & + abs(sum(csymb( nss/4+1:3*nss/8)*conjg(c1( nss/4+1:3*nss/8,itone))))**2 + & + abs(sum(csymb(3*nss/8+1: nss/2)*conjg(c1(3*nss/8+1: nss/2,itone))))**2 + & + abs(sum(csymb( nss/2+1:5*nss/8)*conjg(c1( nss/2+1:5*nss/8,itone))))**2 + & + abs(sum(csymb(5*nss/8+1:3*nss/4)*conjg(c1(5*nss/8+1:3*nss/4,itone))))**2 + & + abs(sum(csymb(3*nss/4+1:7*nss/8)*conjg(c1(3*nss/4+1:7*nss/8,itone))))**2 + & + abs(sum(csymb(7*nss/8+1: nss)*conjg(c1(7*nss/8+1: nss,itone))))**2 + + enddo + enddo + +! Sync quality check + is1=0 + is2=0 + is3=0 + is4=0 + is5=0 + badsync=.false. + ibmax=0 + + is1=0; is2=0; is3=0; is4=0; is5=0 + do k=1,8 + ip=maxloc(s4(:,k,1)) + if(isyncword1(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s4(:,k+38,1)) + if(isyncword2(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s4(:,k+76,1)) + if(isyncword1(k-1).eq.(ip(1)-1)) is3=is3+1 + ip=maxloc(s4(:,k+114,1)) + if(isyncword2(k-1).eq.(ip(1)-1)) is4=is4+1 + ip=maxloc(s4(:,k+152,1)) + if(isyncword1(k-1).eq.(ip(1)-1)) is5=is5+1 + enddo + nsync=is1+is2+is3+is4+is5 !Number of correct hard sync symbols, 0-40 + badsync=.false. + + if(nsync .lt. 16) then + badsync=.true. + return + endif + + bitmetrics=0.0 + do nsub=1,nsizes + do ks=1,NN + s2=0 + do i=0,3 + s2(i)=s4(graymap(i),ks,nsub) + enddo + ipt=1+(ks-1)*2 + ibmax=1 + do ib=0,ibmax + bm=maxval(s2(0:3),one(0:3,ibmax-ib)) - & + maxval(s2(0:3),.not.one(0:3,ibmax-ib)) + if(ipt+ib.gt.2*NN) cycle + bitmetrics(ipt+ib,nsub)=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 the s4 array corresponding to N=1. Will be used for SNR calculation + s4snr(:,:)=s4(:,:,1) + return + +end subroutine get_fst4_bitmetrics2 diff --git a/wsjtx_lib/lib/fst4/ldpc_240_101_generator.f90 b/wsjtx_lib/lib/fst4/ldpc_240_101_generator.f90 new file mode 100644 index 0000000..782e0a2 --- /dev/null +++ b/wsjtx_lib/lib/fst4/ldpc_240_101_generator.f90 @@ -0,0 +1,142 @@ +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/wsjtx_lib/lib/fst4/ldpc_240_101_parity.f90 b/wsjtx_lib/lib/fst4/ldpc_240_101_parity.f90 new file mode 100644 index 0000000..d3c1280 --- /dev/null +++ b/wsjtx_lib/lib/fst4/ldpc_240_101_parity.f90 @@ -0,0 +1,393 @@ +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/wsjtx_lib/lib/fst4/ldpc_240_74_generator.f90 b/wsjtx_lib/lib/fst4/ldpc_240_74_generator.f90 new file mode 100644 index 0000000..0cd5db0 --- /dev/null +++ b/wsjtx_lib/lib/fst4/ldpc_240_74_generator.f90 @@ -0,0 +1,170 @@ +character*19 g(166) + +data g/ & + "de8b3201e3c59f55a14", & + "2e06d352ebc5b74c4fc", & + "2e16d6cf5a725c3244c", & + "84f5587edca6d777de4", & + "e152b1e2b5965093ecc", & + "244b4828a2ccf2b5f58", & + "5fbbaade810e123c730", & + "6b7e92a99a918df3d44", & + "bbcec6a63ab757a7278", & + "f5f3f0b89a21ceccdb0", & + "a248c5f1ec2bc816290", & + "c84bbad839a5fe76d0c", & + "ad724129bbf4c7f4570", & + "91adb56e7623a2575cc", & + "cbe995bdf156df2c9e4", & + "92ff6ea492c08c150e0", & + "c4ddbe5a02f6a933384", & + "d2e9befc131dc483858", & + "68567543d1eebcb080c", & + "21fa61d559f9baf6abc", & + "911c4fbbafc72e3db28", & + "7c0b534af4b7d583d50", & + "12ce371b90ee9dfe72c", & + "15a604148872e251ec4", & + "3a3c9f3eb0e0f96edc0", & + "705919ffb636f96b390", & + "43daaaa8163d6bc2bd4", & + "96e11ea798b74b10e98", & + "811150609c9dee8230c", & + "be713f85ab34380f4b0", & + "5a02c4abaaccb8f24c4", & + "67bdebb8863d04768cc", & + "5a449cd90c3dbdfe844", & + "9c7a54d1c4ef7418b84", & + "cd82fefaaf9cd28cd8c", & + "ca47e847fabb0054a38", & + "f0b30cef6aab9e37f98", & + "d948d912fbcc1708710", & + "cce1a7b355053d98270", & + "4cf227c225a9063dd48", & + "2db92612e9ba1418e24", & + "3d215c04c762c3d6a28", & + "77de65500b5624ceb0c", & + "fd1a1df99ded2fb9d88", & + "2a19392c71438410fb8", & + "a9b486a9d26ed579754", & + "b698d244ac78d97a498", & + "3d7975b74d727a5e704", & + "38094225a2bce0e1940", & + "3d3e58fae40fac342b0", & + "7732e839a066e337714", & + "69356c082b7753a47b0", & + "3e868a55dc403a802ac", & + "a0157a14a6bf7fdbbcc", & + "1ab628e11a7ab4a7c44", & + "9da3a2247d7449052f4", & + "199a8a7b114816b97f4", & + "b1c5cde2542061704cc", & + "432fa8d3a153eafbdc8", & + "c4ece7e400d8a89c448", & + "316ecf74e4b983f007c", & + "6a14fa8e713bb5e8adc", & + "da4b957ded8374e3640", & + "0a804dba7c7e4533300", & + "52c342ed033f86580e0", & + "1667da8d6fcf4272470", & + "da2f7038d550fa88d8c", & + "685bcbab1d9dd2c2a44", & + "4c93008b3156b3636bc", & + "726998d6327ac797c3c", & + "44ece7e400d8a8dc448", & + "01f9add00dfe823a948", & + "dbb95f5ce9e371ad720", & + "fc746ee5c76827a8728", & + "b25408029506467f4b4", & + "9b5c9219e21126b7cf8", & + "39ae9f48ba9d1a24f04", & + "7de2699623eb507f938", & + "b9c6e903ee91dd32934", & + "397510d2c6cb5e81de8", & + "20157a14aebf7fdbbec", & + "067f76ea5817a465980", & + "9248f3cea0869feb994", & + "23cde2678004ebe5f80", & + "5b81fe6848f58e3cfa8", & + "a9099ace96bff092904", & + "4afa4b0802b33215438", & + "f4f740396b030360858", & + "fc613f77a35ee1163b8", & + "1a4dc27d7e8cc835ff4", & + "e9b056f153b39def7ec", & + "b62eb777a2f953c7efc", & + "388ae4de514b62d238c", & + "891529af40e85317160", & + "474f1afeb724dbd2ba8", & + "11d70880fd88fdd307c", & + "29f26a3acb76e6a517c", & + "df3e902ff9cadcf776c", & + "e3c42da8445965c09f0", & + "ce277a6aeccc316dc58", & + "4d7841fb71543abd9b8", & + "e63230d2d465fb44750", & + "b6e11fa798b74b14e98", & + "05f189d37c5616547b4", & + "ebdb51a81d1e883baa8", & + "bf5bc736663bcd53ae0", & + "2f8d1cc0936142c08fc", & + "436b22fc36d917b6928", & + "044b482822ccf2b5f58", & + "37b2e839a066e3b7714", & + "2a9b4b765c581f0c51c", & + "10a7d44cecf8e6628dc", & + "ad95f02df6d5502dd4c", & + "bbd34f8afd63deaf564", & + "cabddfeb01fce632788", & + "66b57babeedd6124114", & + "7813e0454fbd462be8c", & + "b6105ed6f01ea621d04", & + "9f68bbcec679d1c088c", & + "673da96e414fc7a0f40", & + "5568adb935e11084abc", & + "f6dd308de5e5c4f6fb0", & + "3b49e80d40ae596c7b4", & + "a3cde2478004ebe5f80", & + "dd8e4f309e919d5ed94", & + "5a4020d387757d7bc28", & + "64f9e02ae32362a255c", & + "630d5942d392334b0dc", & + "0bd7e9f4229b2dee210", & + "bca549a9467d3a2550c", & + "2fef7b1f578c5e28d04", & + "f35e0fdda1be4b3b35c", & + "69ed575e7cc537d2394", & + "7dfdcfbfd5ef3093680", & + "b3b2921af97f251d328", & + "5622d0fe90363522364", & + "fcd4fc7fa04a69d2ac4", & + "1119ea451502ed9ab34", & + "970ee777ec969a41754", & + "688d14f8afec76783dc", & + "4d0b8a1028578407420", & + "d3d2138d9fa268da3e8", & + "df1bdbff898e006394c", & + "8ac478a916bb0b77684", & + "93881997428e2c17a94", & + "4aa510e746245e90c08", & + "e00cb8543f85a5d58b8", & + "9100d8eb74031073044", & + "38710e4235bd1e4003c", & + "6aef311cac4c4dccfd4", & + "58430f577f51c36b3e0", & + "12082fa5d4268a95b4c", & + "7a7435a0aca071e64d0", & + "cd8250ebadc95de15b0", & + "debad40c852e99d64dc", & + "4e6caa5e7c86efef748", & + "a5d4cbb97e726e3c580", & + "7e3a0a2c73ef8553640", & + "b60bfc2fd2bd8f530dc", & + "32dbef097a5f84b0318", & + "4cc7c1cf434300be380", & + "896840945be8eabf7f0", & + "36c9b10ec694819a0a0", & + "349f46a799ef95a47c8", & + "9bdcd4ce2563e560b74", & + "b19fcd7111a335c52ec"/ + diff --git a/wsjtx_lib/lib/fst4/ldpc_240_74_parity.f90 b/wsjtx_lib/lib/fst4/ldpc_240_74_parity.f90 new file mode 100644 index 0000000..6d41fde --- /dev/null +++ b/wsjtx_lib/lib/fst4/ldpc_240_74_parity.f90 @@ -0,0 +1,423 @@ +data Mn/ & + 84, 101, 144, & + 10, 14, 138, & + 87, 148, 166, & + 1, 50, 67, & + 2, 53, 74, & + 3, 83, 113, & + 4, 90, 121, & + 5, 63, 128, & + 6, 124, 138, & + 8, 22, 108, & + 11, 28, 159, & + 12, 18, 142, & + 13, 24, 145, & + 15, 131, 149, & + 16, 44, 93, & + 17, 41, 47, & + 19, 37, 129, & + 20, 33, 94, & + 21, 100, 154, & + 23, 71, 141, & + 25, 89, 95, & + 26, 105, 153, & + 27, 36, 58, & + 29, 59, 166, & + 30, 52, 126, & + 31, 61, 77, & + 32, 84, 111, & + 34, 97, 155, & + 38, 98, 127, & + 39, 76, 143, & + 40, 55, 92, & + 42, 147, 158, & + 43, 82, 148, & + 45, 49, 109, & + 46, 70, 86, & + 48, 78, 139, & + 51, 101, 104, & + 54, 63, 96, & + 56, 81, 125, & + 57, 117, 164, & + 60, 75, 107, & + 39, 62, 132, & + 64, 110, 118, & + 24, 65, 146, & + 66, 80, 134, & + 68, 91, 114, & + 69, 123, 162, & + 72, 88, 152, & + 79, 99, 130, & + 85, 112, 124, & + 99, 103, 157, & + 106, 115, 133, & + 116, 120, 140, & + 119, 161, 165, & + 64, 122, 137, & + 34, 89, 135, & + 136, 138, 163, & + 93, 144, 159, & + 35, 130, 150, & + 62, 151, 164, & + 104, 153, 160, & + 1, 106, 166, & + 2, 132, 152, & + 3, 11, 105, & + 4, 18, 160, & + 5, 53, 91, & + 6, 109, 141, & + 7, 111, 113, & + 8, 54, 136, & + 9, 61, 92, & + 10, 40, 101, & + 12, 30, 146, & + 13, 37, 82, & + 14, 29, 95, & + 1, 47, 131, & + 2, 8, 139, & + 3, 58, 130, & + 4, 96, 115, & + 5, 119, 129, & + 6, 60, 148, & + 7, 95, 163, & + 2, 35, 56, & + 9, 67, 79, & + 10, 75, 122, & + 11, 17, 121, & + 12, 137, 145, & + 13, 36, 152, & + 14, 15, 155, & + 15, 134, 143, & + 16, 106, 125, & + 11, 106, 157, & + 18, 99, 118, & + 19, 50, 94, & + 20, 126, 158, & + 21, 41, 135, & + 22, 24, 71, & + 23, 42, 136, & + 22, 109, 161, & + 25, 39, 46, & + 26, 45, 55, & + 27, 77, 82, & + 28, 73, 166, & + 29, 69, 76, & + 30, 108, 150, & + 31, 91, 146, & + 14, 32, 147, & + 33, 35, 107, & + 34, 103, 111, & + 8, 94, 122, & + 13, 70, 151, & + 32, 37, 142, & + 3, 38, 87, & + 25, 51, 92, & + 40, 57, 72, & + 21, 108, 153, & + 23, 26, 142, & + 43, 44, 48, & + 30, 43, 62, & + 7, 45, 154, & + 16, 46, 149, & + 1, 53, 75, & + 33, 44, 160, & + 49, 86, 157, & + 19, 80, 159, & + 51, 116, 138, & + 52, 92, 98, & + 6, 12, 47, & + 54, 83, 101, & + 24, 55, 102, & + 56, 63, 120, & + 17, 57, 82, & + 38, 154, 162, & + 59, 74, 151, & + 53, 144, 164, & + 61, 85, 117, & + 62, 66, 90, & + 48, 113, 145, & + 64, 65, 128, & + 27, 29, 65, & + 58, 63, 134, & + 9, 74, 83, & + 68, 109, 113, & + 41, 61, 69, & + 36, 60, 155, & + 42, 64, 144, & + 40, 90, 130, & + 28, 110, 135, & + 20, 59, 112, & + 70, 110, 124, & + 54, 76, 105, & + 4, 77, 111, & + 78, 104, 143, & + 66, 67, 91, & + 80, 81, 88, & + 50, 101, 132, & + 71, 97, 120, & + 72, 131, 158, & + 84, 133, 141, & + 5, 85, 99, & + 49, 89, 133, & + 87, 132, 140, & + 34, 88, 104, & + 89, 105, 147, & + 6, 76, 102, & + 18, 31, 163, & + 52, 96, 140, & + 93, 102, 165, & + 79, 104, 165, & + 81, 100, 126, & + 95, 121, 152, & + 97, 123, 153, & + 37, 98, 114, & + 8, 91, 155, & + 100, 114, 160, & + 2, 26, 28, & + 93, 116, 150, & + 68, 103, 166, & + 78, 117, 125, & + 86, 107, 127, & + 4, 59, 136, & + 9, 37, 97, & + 7, 30, 75, & + 80, 148, 153, & + 73, 138, 164, & + 10, 39, 103, & + 39, 146, 156, & + 48, 129, 136, & + 5, 17, 51, & + 112, 149, 161, & + 11, 24, 126, & + 1, 70, 78, & + 14, 113, 118, & + 10, 119, 141, & + 13, 33, 105, & + 19, 57, 89, & + 12, 25, 56, & + 16, 18, 54, & + 84, 124, 162, & + 20, 41, 134, & + 15, 45, 82, & + 115, 118, 123, & + 128, 139, 149, & + 127, 156, 159, & + 21, 141, 152, & + 23, 130, 156, & + 3, 160, 164, & + 22, 90, 110, & + 35, 61, 109, & + 31, 87, 158, & + 42, 60, 106, & + 137, 140, 157, & + 27, 114, 124, & + 32, 62, 125, & + 34, 38, 128, & + 40, 123, 139, & + 29, 66, 86, & + 36, 52, 161, & + 43, 63, 133, & + 46, 73, 108, & + 44, 135, 146, & + 47, 115, 127, & + 49, 74, 116, & + 58, 102, 122, & + 55, 85, 132, & + 50, 65, 150, & + 67, 145, 162, & + 53, 71, 77, & + 69, 88, 142, & + 68, 72, 93, & + 9, 64, 95, & + 92, 94, 111, & + 81, 83, 119, & + 98, 143, 163, & + 73, 79, 96, & + 35, 129, 131, & + 99, 100, 151, & + 7, 112, 159, & + 117, 137, 156, & + 120, 147, 154, & + 107, 121, 165/ + +data Nm/ & + 4, 62, 75, 121, 191, & + 5, 63, 76, 82, 175, & + 6, 64, 77, 112, 206, & + 7, 65, 78, 151, 180, & + 8, 66, 79, 159, 188, & + 9, 67, 80, 127, 164, & + 68, 81, 119, 182, 237, & + 10, 69, 76, 109, 173, & + 70, 83, 141, 181, 230, & + 2, 71, 84, 185, 193, & + 11, 64, 85, 91, 190, & + 12, 72, 86, 127, 196, & + 13, 73, 87, 110, 194, & + 2, 74, 88, 106, 192, & + 14, 88, 89, 200, 0, & + 15, 90, 120, 197, 0, & + 16, 85, 131, 188, 0, & + 12, 65, 92, 165, 197, & + 17, 93, 124, 195, 0, & + 18, 94, 148, 199, 0, & + 19, 95, 115, 204, 0, & + 10, 96, 98, 207, 0, & + 20, 97, 116, 205, 0, & + 13, 44, 96, 129, 190, & + 21, 99, 113, 196, 0, & + 22, 100, 116, 175, 0, & + 23, 101, 139, 212, 0, & + 11, 102, 147, 175, 0, & + 24, 74, 103, 139, 216, & + 25, 72, 104, 118, 182, & + 26, 105, 165, 209, 0, & + 27, 106, 111, 213, 0, & + 18, 107, 122, 194, 0, & + 28, 56, 108, 162, 214, & + 59, 82, 107, 208, 235, & + 23, 87, 144, 217, 0, & + 17, 73, 111, 172, 181, & + 29, 112, 132, 214, 0, & + 30, 42, 99, 185, 186, & + 31, 71, 114, 146, 215, & + 16, 95, 143, 199, 0, & + 32, 97, 145, 210, 0, & + 33, 117, 118, 218, 0, & + 15, 117, 122, 220, 0, & + 34, 100, 119, 200, 0, & + 35, 99, 120, 219, 0, & + 16, 75, 127, 221, 0, & + 36, 117, 137, 187, 0, & + 34, 123, 160, 222, 0, & + 4, 93, 155, 225, 0, & + 37, 113, 125, 188, 0, & + 25, 126, 166, 217, 0, & + 5, 66, 121, 134, 227, & + 38, 69, 128, 150, 197, & + 31, 100, 129, 224, 0, & + 39, 82, 130, 196, 0, & + 40, 114, 131, 195, 0, & + 23, 77, 140, 223, 0, & + 24, 133, 148, 180, 0, & + 41, 80, 144, 210, 0, & + 26, 70, 135, 143, 208, & + 42, 60, 118, 136, 213, & + 8, 38, 130, 140, 218, & + 43, 55, 138, 145, 230, & + 44, 138, 139, 225, 0, & + 45, 136, 153, 216, 0, & + 4, 83, 153, 226, 0, & + 46, 142, 177, 229, 0, & + 47, 103, 143, 228, 0, & + 35, 110, 149, 191, 0, & + 20, 96, 156, 227, 0, & + 48, 114, 157, 229, 0, & + 102, 184, 219, 234, 0, & + 5, 133, 141, 222, 0, & + 41, 84, 121, 182, 0, & + 30, 103, 150, 164, 0, & + 26, 101, 151, 227, 0, & + 36, 152, 178, 191, 0, & + 49, 83, 168, 234, 0, & + 45, 124, 154, 183, 0, & + 39, 154, 169, 232, 0, & + 33, 73, 101, 131, 200, & + 6, 128, 141, 232, 0, & + 1, 27, 158, 198, 0, & + 50, 135, 159, 224, 0, & + 35, 123, 179, 216, 0, & + 3, 112, 161, 209, 0, & + 48, 154, 162, 228, 0, & + 21, 56, 160, 163, 195, & + 7, 136, 146, 207, 0, & + 46, 66, 105, 153, 173, & + 31, 70, 113, 126, 231, & + 15, 58, 167, 176, 229, & + 18, 93, 109, 231, 0, & + 21, 74, 81, 170, 230, & + 38, 78, 166, 234, 0, & + 28, 156, 171, 181, 0, & + 29, 126, 172, 233, 0, & + 49, 51, 92, 159, 236, & + 19, 169, 174, 236, 0, & + 1, 37, 71, 128, 155, & + 129, 164, 167, 223, 0, & + 51, 108, 177, 185, 0, & + 37, 61, 152, 162, 168, & + 22, 64, 150, 163, 194, & + 52, 62, 90, 91, 210, & + 41, 107, 179, 240, 0, & + 10, 104, 115, 219, 0, & + 34, 67, 98, 142, 208, & + 43, 147, 149, 207, 0, & + 27, 68, 108, 151, 231, & + 50, 148, 189, 237, 0, & + 6, 68, 137, 142, 192, & + 46, 172, 174, 212, 0, & + 52, 78, 201, 221, 0, & + 53, 125, 176, 222, 0, & + 40, 135, 178, 238, 0, & + 43, 92, 192, 201, 0, & + 54, 79, 193, 232, 0, & + 53, 130, 156, 239, 0, & + 7, 85, 170, 240, 0, & + 55, 84, 109, 223, 0, & + 47, 171, 201, 215, 0, & + 9, 50, 149, 198, 212, & + 39, 90, 178, 213, 0, & + 25, 94, 169, 190, 0, & + 29, 179, 203, 221, 0, & + 8, 138, 202, 214, 0, & + 17, 79, 187, 235, 0, & + 49, 59, 77, 146, 205, & + 14, 75, 157, 235, 0, & + 42, 63, 155, 161, 224, & + 52, 158, 160, 218, 0, & + 45, 89, 140, 199, 0, & + 56, 95, 147, 220, 0, & + 57, 69, 97, 180, 187, & + 55, 86, 211, 238, 0, & + 2, 9, 57, 125, 184, & + 36, 76, 202, 215, 0, & + 53, 161, 166, 211, 0, & + 20, 67, 158, 193, 204, & + 12, 111, 116, 228, 0, & + 30, 89, 152, 233, 0, & + 1, 58, 134, 145, 0, & + 13, 86, 137, 226, 0, & + 44, 72, 105, 186, 220, & + 32, 106, 163, 239, 0, & + 3, 33, 80, 183, 0, & + 14, 120, 189, 202, 0, & + 59, 104, 176, 225, 0, & + 60, 110, 133, 236, 0, & + 48, 63, 87, 170, 204, & + 22, 61, 115, 171, 183, & + 19, 119, 132, 239, 0, & + 28, 88, 144, 173, 0, & + 186, 203, 205, 238, 0, & + 51, 91, 123, 211, 0, & + 32, 94, 157, 209, 0, & + 11, 58, 124, 203, 237, & + 61, 65, 122, 174, 206, & + 54, 98, 189, 217, 0, & + 47, 132, 198, 226, 0, & + 57, 81, 165, 233, 0, & + 40, 60, 134, 184, 206, & + 54, 167, 168, 240, 0, & + 3, 24, 62, 102, 177/ + +data nrw/ & +5,5,5,5,5,5,5,5,5,5,5,5,5,5,4,4,4,5,4,4, & +4,4,4,5,4,4,4,4,5,5,4,4,4,5,5,4,5,4,5,5, & +4,4,4,4,4,4,4,4,4,4,4,4,5,5,4,4,4,4,4,4, & +5,5,5,5,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, & +4,5,4,4,4,4,4,4,5,4,5,5,5,4,5,4,4,4,5,4, & +5,4,4,5,5,5,4,4,5,4,5,4,5,4,4,4,4,4,4,4, & +4,4,4,5,4,4,4,4,4,5,4,5,4,4,4,5,4,5,4,4, & +5,4,4,4,4,5,4,4,4,4,4,5,5,4,4,4,4,4,5,5, & +4,4,4,5,4,5/ + +ncw=3 + diff --git a/wsjtx_lib/lib/fst4/ldpcsim240_101.f90 b/wsjtx_lib/lib/fst4/ldpcsim240_101.f90 new file mode 100644 index 0000000..e201ac4 --- /dev/null +++ b/wsjtx_lib/lib/fst4/ldpcsim240_101.f90 @@ -0,0 +1,137 @@ +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) + 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,*) norder + 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(*,*) "norder : ",norder + 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 + dmin=0.0 + maxosd=2 + call decode240_101(llr, Keff, maxosd, norder, apmask, message101, cw, ntype, nharderror, dmin) + if(nharderror.ge.0) then + n2err=0 + do i=1,N + if( cw(i).ne.codeword(i) ) 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/wsjtx_lib/lib/fst4/ldpcsim240_74.f90 b/wsjtx_lib/lib/fst4/ldpcsim240_74.f90 new file mode 100644 index 0000000..de3ffa8 --- /dev/null +++ b/wsjtx_lib/lib/fst4/ldpcsim240_74.f90 @@ -0,0 +1,125 @@ +program ldpcsim240_74 + +! End-to-end test of the (240,74)/crc24 encoder and decoders. + + use packjt77 + + parameter(N=240, K=74, M=N-K) + character*8 arg + character*37 msg0 + character*77 c77 + character*24 c24 + integer*1 msgbits(74) + integer*1 apmask(240) + integer*1 cw(240) + integer*1 codeword(N),message74(74) + integer ncrc24 + real rxdata(N),llr(N) + logical first + 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_74 20 5 1000 0.85 64 "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 [50,74]' + print*,'WSPR-format message is optional' + return + endif + call getarg(1,arg) + read(arg,*) max_iterations + call getarg(2,arg) + read(arg,*) norder + 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(*,*) "norder : ",norder + write(*,*) "s : ",s + write(*,*) "K : ",Keff + + msgbits=0 + read(c77,'(50i1)') msgbits(1:50) + write(*,*) 'message' + write(*,'(50i1)') msgbits(1:50) + + call get_crc24(msgbits,74,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') msgbits(51:74) +write(*,'(24i1)') msgbits(51:74) + write(*,*) 'message with crc24' + write(*,'(74i1)') msgbits(1:74) + call encode240_74(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 + dmin=0.0 + maxosd=2 + call decode240_74(llr, Keff, maxosd, norder, apmask, message74, cw, ntype, nharderror, dmin) + if(nharderror.ge.0) then + n2err=0 + do i=1,N + if( cw(i).ne.codeword(i) ) 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,e10.3)") db,esn0,ngood,nue,pberr + + enddo + +end program ldpcsim240_74 diff --git a/wsjtx_lib/lib/fst4/lorentzian_fading.f90 b/wsjtx_lib/lib/fst4/lorentzian_fading.f90 new file mode 100644 index 0000000..38510b7 --- /dev/null +++ b/wsjtx_lib/lib/fst4/lorentzian_fading.f90 @@ -0,0 +1,43 @@ +subroutine lorentzian_fading(c,npts,fs,fspread) +! +! npts is the total length of the simulated data vector +! + complex c(0:npts-1) + complex cspread(0:npts-1) + complex z + + twopi=8.0*atan(1.0) + df=fs/npts + nh=npts/2 + cspread(0)=1.0 + cspread(nh)=0. + b=6.0 + do i=1,nh + f=i*df + x=b*f/fspread + z=0. + a=0. + if(x.lt.3.0) then + a=sqrt(1.111/(1.0+x*x)-0.1) + phi1=twopi*rran() + z=a*cmplx(cos(phi1),sin(phi1)) + endif + cspread(i)=z + z=0. + if(x.lt.3.0) then + phi2=twopi*rran() + z=a*cmplx(cos(phi2),sin(phi2)) + endif + cspread(npts-i)=z + enddo + + call four2a(cspread,npts,1,1,1) + + s=sum(abs(cspread)**2) + avep=s/npts + fac=sqrt(1.0/avep) + cspread=fac*cspread + c=cspread*c + + return +end subroutine lorentzian_fading diff --git a/wsjtx_lib/lib/fst4/osd240_101.f90 b/wsjtx_lib/lib/fst4/osd240_101.f90 new file mode 100644 index 0000000..9d97e8b --- /dev/null +++ b/wsjtx_lib/lib/fst4/osd240_101.f90 @@ -0,0 +1,404 @@ +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 + nt=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 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/wsjtx_lib/lib/fst4/osd240_74.f90 b/wsjtx_lib/lib/fst4/osd240_74.f90 new file mode 100644 index 0000000..a54e767 --- /dev/null +++ b/wsjtx_lib/lib/fst4/osd240_74.f90 @@ -0,0 +1,404 @@ +subroutine osd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (240,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 77+p1. +! +! Valid values for k are in the range [50,74]. +! + 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 message74(74) + 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=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 encode240_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 + nt=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 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 osd240_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/wsjtx_lib/lib/fst4_decode.f90 b/wsjtx_lib/lib/fst4_decode.f90 new file mode 100644 index 0000000..18e9c5c --- /dev/null +++ b/wsjtx_lib/lib/fst4_decode.f90 @@ -0,0 +1,1025 @@ +module fst4_decode + + type :: fst4_decoder + procedure(fst4_decode_callback), pointer :: callback + contains + procedure :: decode + end type fst4_decoder + + abstract interface + subroutine fst4_decode_callback (this,nutc,sync,nsnr,dt,freq, & + decoded,nap,qual,ntrperiod,fmid,w50) + import fst4_decoder + implicit none + class(fst4_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: sync + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + integer, intent(in) :: ntrperiod + real, intent(in) :: fmid + real, intent(in) :: w50 + end subroutine fst4_decode_callback + end interface + +contains + + subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfa,nfb,nfqso, & + ndepth,ntrperiod,nexp_decode,ntol,emedelay,lagain,lapcqonly,mycall, & + hiscall,iwspr,lprinthash22) + + use prog_args + use timer_module, only: timer + use packjt77 + use, intrinsic :: iso_c_binding + include 'fst4/fst4_params.f90' + parameter (MAXCAND=100,MAXWCALLS=100) + class(fst4_decoder), intent(inout) :: this + procedure(fst4_decode_callback) :: callback + character*37 decodes(100) + character*37 msg,msgsent + character*20 wcalls(MAXWCALLS), wpart + character*77 c77 + character*12 mycall,hiscall + character*12 mycall0,hiscall0 + complex, allocatable :: c2(:) + complex, allocatable :: cframe(:) + complex, allocatable :: c_bigfft(:) !Complex waveform + real llr(240),llrs(240,4) + real candidates0(200,5),candidates(200,5) + real bitmetrics(320,4) + real s4(0:3,NN) + real minsync + logical lagain,lapcqonly + integer itone(NN) + integer hmod + integer*1 apmask(240),cw(240),hdec(240) + integer*1 message101(101),message74(74),message77(77) + integer*1 rvec(77) + integer apbits(240) + integer nappasses(0:5) ! # of decoding passes for QSO states 0-5 + integer naptypes(0:5,4) ! (nQSOProgress,decoding pass) + integer mcq(29),mrrr(19),m73(19),mrr73(19) + + logical badsync,unpk77_success,single_decode + logical first,nohiscall + logical new_callsign,plotspec_exists,wcalls_exists,do_k50_decode + logical decdata_exists + logical lprinthash22 + + integer*2 iwave(30*60*12000) + + data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ + data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ + data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ + data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,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/ + data first/.true./,hmod/1/ + save first,apbits,nappasses,naptypes,mycall0,hiscall0 + save wcalls,nwcalls + + this%callback => callback + dxcall13=hiscall ! initialize for use in packjt77 + mycall13=mycall + + if(iwspr.ne.0 .and. iwspr.ne.1) return + + if(lagain) continue ! use lagain to keep compiler happy + + if(first) then +! read the fst4_calls.txt file + inquire(file=trim(data_dir)//'/fst4w_calls.txt',exist=wcalls_exists) + if( wcalls_exists ) then + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,MAXWCALLS + wcalls(i)='' + read(42,fmt='(a)',end=2867) wcalls(i) + wcalls(i)=adjustl(wcalls(i)) + if(len(trim(wcalls(i))).eq.0) exit + enddo +2867 nwcalls=i-1 + close(42) + endif + + mcq=2*mod(mcq+rvec(1:29),2)-1 + mrrr=2*mod(mrrr+rvec(59:77),2)-1 + m73=2*mod(m73+rvec(59:77),2)-1 + mrr73=2*mod(mrr73+rvec(59:77),2)-1 + + nappasses(0)=2 + nappasses(1)=2 + nappasses(2)=2 + nappasses(3)=2 + nappasses(4)=2 + nappasses(5)=3 + +! iaptype +!------------------------ +! 1 CQ ??? ??? (29 ap bits) +! 2 MyCall ??? ??? (29 ap bits) +! 3 MyCall DxCall ??? (58 ap bits) +! 4 MyCall DxCall RRR (77 ap bits) +! 5 MyCall DxCall 73 (77 ap bits) +! 6 MyCall DxCall RR73 (77 ap bits) +!******** + + naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ) + naptypes(1,1:4)=(/2,3,0,0/) ! Tx1 + naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 + naptypes(3,1:4)=(/3,6,0,0/) ! Tx3 + naptypes(4,1:4)=(/3,6,0,0/) ! Tx4 + naptypes(5,1:4)=(/3,1,2,0/) ! Tx5 + + mycall0='' + hiscall0='' + first=.false. + endif + + l1=index(mycall,char(0)) + if(l1.ne.0) mycall(l1:)=" " + l1=index(hiscall,char(0)) + if(l1.ne.0) hiscall(l1:)=" " + if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0) then + apbits=0 + apbits(1)=99 + apbits(30)=99 + + if(len(trim(mycall)) .lt. 3) go to 10 + + nohiscall=.false. + hiscall0=hiscall + if(len(trim(hiscall0)).lt.3) then + hiscall0=mycall ! use mycall for dummy hiscall - mycall won't be hashed. + nohiscall=.true. + endif + msg=trim(mycall)//' '//trim(hiscall0)//' RR73' + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + call unpack77(c77,1,msgsent,unpk77_success) + if(i3.ne.1 .or. (msg.ne.msgsent) .or. .not.unpk77_success) go to 10 + read(c77,'(77i1)') message77 + message77=mod(message77+rvec,2) + apbits(1:77)=2*message77-1 + if(nohiscall) apbits(30)=99 + +10 continue + mycall0=mycall + hiscall0=hiscall + endif +!************************************ + + if(nfqso+nqsoprogress.eq.-999) return + Keff=91 + nmax=15*12000 + if(ntrperiod.eq.15) then + nsps=720 + nmax=15*12000 + ndown=18 !nss=40,80,160,400 + nfft1=int(nmax/ndown)*ndown + else if(ntrperiod.eq.30) then + nsps=1680 + nmax=30*12000 + ndown=42 !nss=40,80,168,336 + nfft1=359856 !nfft2=8568=2^3*3^2*7*17 + else if(ntrperiod.eq.60) then + nsps=3888 + nmax=60*12000 + ndown=108 + nfft1=7500*96 ! nfft2=7500=2^2*3*5^4 + else if(ntrperiod.eq.120) then + nsps=8200 + nmax=120*12000 + ndown=205 !nss=40,82,164,328 + nfft1=7200*200 ! nfft2=7200=2^5*3^2*5^2 + else if(ntrperiod.eq.300) then + nsps=21504 + nmax=300*12000 + ndown=512 !nss=42,84,168,336 + nfft1=7020*512 ! nfft2=7020=2^2*3^3*5*13 + else if(ntrperiod.eq.900) then + nsps=66560 + nmax=900*12000 + ndown=1664 !nss=40,80,160,320 + nfft1=6480*1664 ! nfft2=6480=2^4*3^4*5 + else if(ntrperiod.eq.1800) then + nsps=134400 + nmax=1800*12000 + ndown=3360 !nss=40,80,160,320 + nfft1=6426*3360 ! nfft2=6426=2*3^3*7*17 + end if + nss=nsps/ndown + fs=12000.0 !Sample rate + fs2=fs/ndown + nspsec=nint(fs2) + dt=1.0/fs !Sample interval (s) + dt2=1.0/fs2 + tt=nsps*dt !Duration of "itone" symbols (s) + baud=1.0/tt + sigbw=4.0*baud + nfft2=nfft1/ndown !make sure that nfft1 is exactly nfft2*ndown + nfft1=nfft2*ndown + nh1=nfft1/2 + + allocate( c_bigfft(0:nfft1/2) ) + allocate( c2(0:nfft2-1) ) + allocate( cframe(0:160*nss-1) ) + + jittermax=2 + do_k50_decode=.false. + if(ndepth.eq.3) then + nblock=4 + jittermax=2 + do_k50_decode=.true. + elseif(ndepth.eq.2) then + nblock=4 + jittermax=2 + do_k50_decode=.false. + elseif(ndepth.eq.1) then + nblock=4 + jittermax=0 + do_k50_decode=.false. + endif + +! Noise blanker setup + ndropmax=1 + single_decode=iand(nexp_decode,32).ne.0 + npct=0 + nb=nexp_decode/256 - 3 + if(nb.ge.0) npct=nb + inb1=20 + inb2=5 + if(nb.eq.-1) then + inb2=5 !Try NB = 0, 5, 10, 15, 20% + else if(nb.eq.-2) then + inb2=2 !Try NB = 0, 2, 4,... 20% + else if(nb.eq.-3) then + inb2=1 !Try NB = 0, 1, 2,... 20% + else + inb1=0 !Fixed NB value, 0 to 25% + endif + + +! nfa,nfb: define the noise-baseline analysis window +! fa, fb: define the signal search window +! We usually make nfafb so that noise baseline analysis +! window extends outside of the [fa,fb] window where we think the signals are. +! + if(iwspr.eq.1) then !FST4W + nfa=max(100,nfqso-ntol-100) + nfb=min(4800,nfqso+ntol+100) + fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window + fb=min(4800,nint(nfqso+1.5*baud+ntol)) + else if(iwspr.eq.0) then + if(single_decode) then + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + else + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + endif + endif + + ndecodes=0 + decodes=' ' + new_callsign=.false. + do inb=0,inb1,inb2 + if(nb.lt.0) npct=inb ! we are looping over blanker settings + call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) + +! The big fft is done once and is used for calculating the smoothed spectrum +! and also for downconverting/downsampling each candidate. + call four2a(c_bigfft,nfft1,1,-1,0) !r2c + nhicoh=1 + nsyncoh=8 + minsync=1.20 + if(ntrperiod.eq.15) minsync=1.15 + +! Get first approximation of candidate frequencies + call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & + minsync,ncand,candidates0) + isbest=0 + fc2=0. + do icand=1,ncand + fc0=candidates0(icand,1) + if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso + detmet=candidates0(icand,2) + +! Downconvert and downsample a slice of the spectrum centered on the +! rough estimate of the candidates frequency. +! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. +! The size of the downsampled c2 array is nfft2=nfft1/ndown + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) + call timer('dwnsmpl ',1) + + call timer('sync240 ',0) + call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) + call timer('sync240 ',1) + + fc_synced = fc0 + fcbest + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates0(icand,3)=fc_synced + candidates0(icand,4)=isbest + enddo + +! remove duplicate candidates + do icand=1,ncand + fc=candidates0(icand,3) + isbest=nint(candidates0(icand,4)) + do ic2=icand+1,ncand + fc2=candidates0(ic2,3) + isbest2=nint(candidates0(ic2,4)) + if(fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.10*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates0(ic2,3)=-1 + endif + endif + endif + enddo + enddo + ic=0 + do icand=1,ncand + if(candidates0(icand,3).gt.0) then + ic=ic+1 + candidates0(ic,:)=candidates0(icand,:) + endif + enddo + ncand=ic + +! If FST4 mode and Single Decode is not checked, then find candidates +! within 20 Hz of nfqso and put them at the top of the list + if(iwspr.eq.0 .and. .not.single_decode) then + nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) + k=0 + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + else + candidates=candidates0 + endif + + xsnr=0. + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) + call timer('dwnsmpl ',1) + + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) + bitmetrics=0 + call timer('bitmetrc',0) + call get_fst4_bitmetrics(cframe,nss,bitmetrics, & + s4,nsync_qual,badsync) + call timer('bitmetrc',1) + if(badsync) cycle + + do il=1,4 + llrs( 1: 60,il)=bitmetrics( 17: 76, il) + llrs( 61:120,il)=bitmetrics( 93:152, il) + llrs(121:180,il)=bitmetrics(169:228, il) + llrs(181:240,il)=bitmetrics(245:304, il) + enddo + + apmag=maxval(abs(llrs(:,4)))*1.1 + ntmax=nblock+nappasses(nQSOProgress) + if(lapcqonly) ntmax=nblock+1 + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 + apmask=0 + + if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding + nblock=4 + ntmax=nblock + endif + + do itry=1,ntmax + if(itry.eq.1) llr=llrs(:,1) + if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) + if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) + if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) + if(itry.le.nblock) then + apmask=0 + iaptype=0 + endif + + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes + llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes + iaptype=naptypes(nQSOProgress,itry-nblock) + if(lapcqonly) iaptype=1 + if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall + if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall + if(iaptype.eq.1) then ! CQ + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*mcq(1:29) + endif + + if(iaptype.eq.2) then ! MyCall ??? ??? + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*apbits(1:29) + endif + + if(iaptype.eq.3) then ! MyCall DxCall ??? + apmask=0 + apmask(1:58)=1 + llr(1:58)=apmag*apbits(1:58) + endif + + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then + apmask=0 + apmask(1:77)=1 + llr(1:58)=apmag*apbits(1:58) + if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) + if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) + if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) + endif + endif + + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + Keff=91 + norder=3 + call timer('d240_101',0) + call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d240_101',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then +! Try decoding with Keff=66 + maxosd=2 + call timer('d240_74 ',0) + Keff=66 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) + if(lprinthash22 .and. unpk77_success .and. index(msg,'<...>').gt.0) then + read(c77,'(b22.22)') n22tmp + i1=index(msg,' ') + wpart=trim(msg(i1+1:)) + write(msg,'(a1,i7.7,a1)') '<',n22tmp,'>' + msg=trim(msg)//' '//trim(wpart) + endif + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif + endif + endif + endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_k50_decode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) +! No CRC in this mode, so only accept the decode if call/grid have been seen before + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo + endif + endif + + endif + + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) + else + call get_fst4_tones_from_bits(message74,itone,1) + endif + inquire(file='plotspec',exist=plotspec_exists) + fmid=-999.0 + call timer('dopsprd ',0) + if(plotspec_exists) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + select case(ntrperiod) + case(15) + snr_calfac=800.0 + case(30) + snr_calfac=600.0 + case(60) + snr_calfac=430.0 + case(120) + snr_calfac=390.0 + case(300) + snr_calfac=340.0 + case(900) + snr_calfac=320.0 + case(1800) + snr_calfac=320.0 + case default + snr_calfac=430.0 + end select + arg=snr_calfac*xsig/base - 1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)+10*log10(1.46/2500)+10*log10(8200.0/nsps) + else + xsnr=-99.9 + endif + nsnr=nint(xsnr) + qual=0.0 + fsig=fc_synced - 1.5*baud + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) + if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') + write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & + ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & + sync,xsnr,xdt,fsig,w50,trim(msg) +3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) + close(21) + endif + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod,fmid,w50) + goto 800 + endif + enddo ! metrics + enddo ! istart jitter +800 enddo !candidate list + enddo ! noise blanker loop + + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif + + return + end subroutine decode + + subroutine sync_fst4(cd0,i0,f0,hmod,ncoh,np,nss,ntr,fs,sync) + +! Compute sync power for a complex, downsampled FST4 signal. + + use timer_module, only: timer + include 'fst4/fst4_params.f90' + complex cd0(0:np-1) + complex csync1,csync2,csynct1,csynct2 + complex ctwk(3200) + complex z1,z2,z3,z4,z5 + integer hmod,isyncword1(0:7),isyncword2(0:7) + real f0save + common/sync240com/csync1(3200),csync2(3200),csynct1(3200),csynct2(3200) + data isyncword1/0,1,3,2,1,0,2,3/ + data isyncword2/2,3,1,0,3,2,0,1/ + data f0save/-99.9/,nss0/-1/,ntr0/-1/ + save twopi,dt,fac,f0save,nss0,ntr0 + + p(z1)=(real(z1*fac)**2 + aimag(z1*fac)**2)**0.5 !Compute power + + nz=8*nss + call timer('sync240a',0) + if(nss.ne.nss0 .or. ntr.ne.ntr0) then + twopi=8.0*atan(1.0) + dt=1/fs + k=1 + phi1=0.0 + phi2=0.0 + do i=0,7 + dphi1=twopi*hmod*(isyncword1(i)-1.5)/real(nss) + dphi2=twopi*hmod*(isyncword2(i)-1.5)/real(nss) + do j=1,nss + csync1(k)=cmplx(cos(phi1),sin(phi1)) + csync2(k)=cmplx(cos(phi2),sin(phi2)) + phi1=mod(phi1+dphi1,twopi) + phi2=mod(phi2+dphi2,twopi) + k=k+1 + enddo + enddo + fac=1.0/(8.0*nss) + nss0=nss + ntr0=ntr + f0save=-1.e30 + endif + + if(f0.ne.f0save) then + dphi=twopi*f0*dt + phi=0.0 + do i=1,nz + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + csynct1(1:nz)=ctwk(1:nz)*csync1(1:nz) + csynct2(1:nz)=ctwk(1:nz)*csync2(1:nz) + f0save=f0 + nss0=nss + endif + call timer('sync240a',1) + + i1=i0 !Costas arrays + i2=i0+38*nss + i3=i0+76*nss + i4=i0+114*nss + i5=i0+152*nss + + s1=0.0 + s2=0.0 + s3=0.0 + s4=0.0 + s5=0.0 + + if(ncoh.gt.0) then + nsec=8/ncoh + do i=1,nsec + is=(i-1)*ncoh*nss + z1=0 + if(i1+is.ge.1) then + z1=sum(cd0(i1+is:i1+is+ncoh*nss-1)*conjg(csynct1(is+1:is+ncoh*nss))) + endif + z2=sum(cd0(i2+is:i2+is+ncoh*nss-1)*conjg(csynct2(is+1:is+ncoh*nss))) + z3=sum(cd0(i3+is:i3+is+ncoh*nss-1)*conjg(csynct1(is+1:is+ncoh*nss))) + z4=sum(cd0(i4+is:i4+is+ncoh*nss-1)*conjg(csynct2(is+1:is+ncoh*nss))) + z5=0 + if(i5+is+ncoh*nss-1.le.np) then + z5=sum(cd0(i5+is:i5+is+ncoh*nss-1)*conjg(csynct1(is+1:is+ncoh*nss))) + endif + s1=s1+abs(z1)/nz + s2=s2+abs(z2)/nz + s3=s3+abs(z3)/nz + s4=s4+abs(z4)/nz + s5=s5+abs(z5)/nz + enddo + else + nsub=-ncoh + nps=nss/nsub + do i=1,8 + do isub=1,nsub + is=(i-1)*nss+(isub-1)*nps + z1=0.0 + if(i1+is.ge.1) then + z1=sum(cd0(i1+is:i1+is+nps-1)*conjg(csynct1(is+1:is+nps))) + endif + z2=sum(cd0(i2+is:i2+is+nps-1)*conjg(csynct2(is+1:is+nps))) + z3=sum(cd0(i3+is:i3+is+nps-1)*conjg(csynct1(is+1:is+nps))) + z4=sum(cd0(i4+is:i4+is+nps-1)*conjg(csynct2(is+1:is+nps))) + z5=0.0 + if(i5+is+ncoh*nss-1.le.np) then + z5=sum(cd0(i5+is:i5+is+nps-1)*conjg(csynct1(is+1:is+nps))) + endif + s1=s1+abs(z1)/(8*nss) + s2=s2+abs(z2)/(8*nss) + s3=s3+abs(z3)/(8*nss) + s4=s4+abs(z4)/(8*nss) + s5=s5+abs(z5)/(8*nss) + enddo + enddo + endif + sync = s1+s2+s3+s4+s5 + return + end subroutine sync_fst4 + + subroutine fst4_downsample(c_bigfft,nfft1,ndown,f0,sigbw,c1) + +! Output: Complex data in c(), sampled at 12000/ndown Hz + + complex c_bigfft(0:nfft1/2) + complex c1(0:nfft1/ndown-1) + + df=12000.0/nfft1 + i0=nint(f0/df) + ih=nint( ( f0 + 1.3*sigbw/2.0 )/df) + nbw=ih-i0+1 + c1=0. + c1(0)=c_bigfft(i0) + nfft2=nfft1/ndown + do i=1,nbw + if(i0+i.le.nfft1/2) c1(i)=c_bigfft(i0+i) + if(i0-i.ge.0) c1(nfft2-i)=c_bigfft(i0-i) + enddo + c1=c1/nfft2 + call four2a(c1,nfft2,1,1,1) !c2c FFT back to time domain + return + + end subroutine fst4_downsample + + subroutine get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & + minsync,ncand,candidates) + + complex c_bigfft(0:nfft1/2) !Full length FFT of raw data + integer hmod !Modulation index (submode) + integer im(1) !For maxloc + real candidates(200,5) !Candidate list + real, allocatable :: s(:) !Low resolution power spectrum + real, allocatable :: s2(:) !CCF of s() with 4 tones + real, allocatable :: sbase(:) !noise baseline estimate + real xdb(-3:3) !Model 4-tone CCF peaks + real minsync + data xdb/0.25,0.50,0.75,1.0,0.75,0.50,0.25/ + + nh1=nfft1/2 + df1=fs/nfft1 + baud=fs/nsps !Keying rate + df2=baud/2.0 + nd=df2/df1 !s() sums this many bins of big FFT + ndh=nd/2 + ia=nint(max(100.0,fa)/df2) !Low frequency search limit + ib=nint(min(4800.0,fb)/df2) !High frequency limit + ina=nint(max(100.0,real(nfa))/df2) !Low freq limit for noise baseline fit + inb=nint(min(4800.0,real(nfb))/df2) !High freq limit for noise fit + if(ia.lt.ina) ia=ina + if(ib.gt.inb) ib=inb + + nnw=nint(48000.*nsps*2./fs) + allocate (s(nnw)) + s=0. !Compute low-resolution power spectrum + do i=ina,inb ! noise analysis window includes signal analysis window + j0=nint(i*df2/df1) + do j=j0-ndh,j0+ndh + s(i)=s(i) + real(c_bigfft(j))**2 + aimag(c_bigfft(j))**2 + enddo + enddo + + ina=max(ina,1+3*hmod) !Don't run off the ends + inb=min(inb,nnw-3*hmod) + allocate (s2(nnw)) + allocate (sbase(nnw)) + s2=0. + do i=ina,inb !Compute CCF of s() and 4 tones + s2(i)=s(i-hmod*3) + s(i-hmod) +s(i+hmod) +s(i+hmod*3) + enddo + npctile=30 + call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npctile,sbase) + if(any(sbase(ina:inb).le.0.0)) return + s2(ina:inb)=s2(ina:inb)/sbase(ina:inb) !Normalize wrt noise level + + ncand=0 + candidates=0 + if(ia.lt.3) ia=3 + if(ib.gt.nnw-2) ib=nnw-2 + +! Find candidates, using the CLEAN algorithm to remove a model of each one +! from s2() after it has been found. + pval=99.99 + do while(ncand.lt.200) + im=maxloc(s2(ia:ib)) + iploc=ia+im(1)-1 !Index of CCF peak + pval=s2(iploc) !Peak value + if(pval.lt.minsync) exit + do i=-3,+3 !Remove 0.9 of a model CCF at + k=iploc+2*hmod*i !this frequency from s2() + if(k.ge.ia .and. k.le.ib) then + s2(k)=max(0.,s2(k)-0.9*pval*xdb(i)) + endif + enddo + ncand=ncand+1 + candidates(ncand,1)=df2*iploc !Candidate frequency + candidates(ncand,2)=pval !Rough estimate of SNR + candidates(ncand,5)=sbase(iploc) + enddo + return + end subroutine get_candidates_fst4 + + subroutine fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) + complex c2(0:nfft2-1) + integer hmod + nspsec=int(fs2) + baud=fs2/real(nss) + fc1=0.0 + if(emedelay.lt.0.1) then ! search offsets from 0 s to 2 s + is0=1.5*nspsec + ishw=1.5*nspsec + else ! search plus or minus 1.5 s centered on emedelay + is0=nint((emedelay+1.0)*nspsec) + ishw=1.5*nspsec + endif + + sbest=-1.e30 + do if=-12,12 + fc=fc1 + 0.1*baud*if + do istart=max(1,is0-ishw),is0+ishw,4*hmod + call sync_fst4(c2,istart,fc,hmod,nsyncoh,nfft2,nss, & + ntrperiod,fs2,sync) + if(sync.gt.sbest) then + fcbest=fc + isbest=istart + sbest=sync + endif + enddo + enddo + + fc1=fcbest + is0=isbest + ishw=4*hmod + isst=1*hmod + + sbest=0.0 + do if=-7,7 + fc=fc1 + 0.02*baud*if + do istart=max(1,is0-ishw),is0+ishw,isst + call sync_fst4(c2,istart,fc,hmod,nsyncoh,nfft2,nss, & + ntrperiod,fs2,sync) + if(sync.gt.sbest) then + fcbest=fc + isbest=istart + sbest=sync + endif + enddo + enddo + end subroutine fst4_sync_search + + subroutine dopspread(itone,iwave,nsps,nmax,ndown,hmod,i0,fc,fmid,w50) + +! On "plotspec" special request, compute Doppler spread for a decoded signal + + include 'fst4/fst4_params.f90' + complex, allocatable :: cwave(:) !Reconstructed complex signal + complex, allocatable :: g(:) !Channel gain, g(t) in QEX paper + real,allocatable :: ss(:) !Computed power spectrum of g(t) + integer itone(160) !Tones for this message + integer*2 iwave(nmax) !Raw Rx data + integer hmod !Modulation index + data ncall/0/ + save ncall + + ncall=ncall+1 + nfft=2*nmax + nwave=max(nmax,(NN+2)*nsps) + allocate(cwave(0:nwave-1)) + allocate(g(0:nfft-1)) + wave=0 + fsample=12000.0 + call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,fc,1,cwave,wave) + cwave=cshift(cwave,-i0*ndown) + fac=1.0/32768 + g(0:nmax-1)=fac*float(iwave)*conjg(cwave(:nmax-1)) + g(nmax:)=0. + call four2a(g,nfft,1,-1,1) !Forward c2c FFT + + df=12000.0/nfft + ia=1.0/df + smax=0. + do i=-ia,ia !Find smax in +/- 1 Hz around 0. + j=i + if(j.lt.0) j=i+nfft + s=real(g(j))**2 + aimag(g(j))**2 + smax=max(s,smax) + enddo + + ia=10.1/df + allocate(ss(-ia:ia)) !Allocate space for +/- 10 Hz + sum1=0. + sum2=0. + nns=0 + do i=-ia,ia + j=i + if(j.lt.0) j=i+nfft + ss(i)=(real(g(j))**2 + aimag(g(j))**2)/smax + f=i*df + if(f.ge.-4.0 .and. f.le.-2.0) then + sum1=sum1 + ss(i) !Power between -2 and -4 Hz + nns=nns+1 + else if(f.ge.2.0 .and. f.le.4.0) then + sum2=sum2 + ss(i) !Power between +2 and +4 Hz + endif + enddo + avg=min(sum1/nns,sum2/nns) !Compute avg from smaller sum + + sum1=0. + do i=-ia,ia + f=i*df + if(abs(f).le.1.0) sum1=sum1 + ss(i)-avg !Power in abs(f) < 1 Hz + enddo + + ia=nint(1.0/df) + 1 + sum2=0.0 + xi1=-999 + xi2=-999 + xi3=-999 + sum2z=0. + do i=-ia,ia !Find freq range that has 50% of signal power + sum2=sum2 + ss(i)-avg + if(sum2.ge.0.25*sum1 .and. xi1.eq.-999.0) then + xi1=i - 1 + (sum2-0.25*sum1)/(sum2-sum2z) + endif + if(sum2.ge.0.50*sum1 .and. xi2.eq.-999.0) then + xi2=i - 1 + (sum2-0.50*sum1)/(sum2-sum2z) + endif + if(sum2.ge.0.75*sum1) then + xi3=i - 1 + (sum2-0.75*sum1)/(sum2-sum2z) + exit + endif + sum2z=sum2 + enddo + xdiff=sqrt(1.0+(xi3-xi1)**2) !Keep small values from fluctuating too widely + w50=xdiff*df !Compute Doppler spread + fmid=xi2*df !Frequency midpoint of signal powere + + do i=-ia,ia !Save the spectrum for plotting + y=ncall-1 + j=i+nint(xi2) + if(abs(j*df).lt.10.0) y=0.99*ss(i+nint(xi2)) + ncall-1 + write(52,1010) i*df,y +1010 format(f12.6,f12.6) + enddo + + return + end subroutine dopspread + +end module fst4_decode diff --git a/wsjtx_lib/lib/ft2/cdatetime.f90 b/wsjtx_lib/lib/ft2/cdatetime.f90 new file mode 100644 index 0000000..33deaf3 --- /dev/null +++ b/wsjtx_lib/lib/ft2/cdatetime.f90 @@ -0,0 +1,6 @@ +character*17 function cdatetime() + character cdate*8,ctime*10 + call date_and_time(cdate,ctime) + cdatetime=cdate(3:8)//'_'//ctime + return +end function cdatetime diff --git a/wsjtx_lib/lib/ft2/ft2.f90 b/wsjtx_lib/lib/ft2/ft2.f90 new file mode 100644 index 0000000..e5c389f --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2.f90 @@ -0,0 +1,279 @@ +program ft2 + + use packjt77 + include 'gcom1.f90' + integer ft2audio,ptt + logical allok + character*20 pttport + character*8 arg + character*80 fname + integer*2 id2(30000) + + open(12,file='all_ft2.txt',status='unknown',position='append') + nargs=iargc() + if(nargs.eq.1) then + call getarg(1,fname) + open(10,file=fname,status='old',access='stream') + read(10) id2(1:22) !Read (and ignore) the header + read(10) id2 !Read the Rx data + close(10) + call ft2_decode(fname(1:17),nfqso,id2,ndecodes,mycall,hiscall,nrx) + go to 999 + endif + + allok=.true. +! Get home-station details + open(10,file='ft2.ini',status='old',err=1) + go to 2 +1 print*,'Cannot open ft2.ini' + allok=.false. +2 read(10,*,err=3) mycall,mygrid,ndevin,ndevout,pttport,exch + go to 4 +3 print*,'Error reading ft2.ini' + allok=.false. +4 if(index(pttport,'/').lt.1) read(pttport,*) nport + hiscall=' ' + hiscall_next=' ' + idevin=ndevin + idevout=ndevout + call padevsub(idevin,idevout) + if(idevin.ne.ndevin .or. idevout.ne.ndevout) allok=.false. + i1=0 + i1=ptt(nport,1,1,iptt) + i1=ptt(nport,1,0,iptt) + if(i1.lt.0 .and. nport.ne.0) allok=.false. + if(.not.allok) then + write(*,"('Please fix setup error(s) and restart.')") + go to 999 + endif + + nright=1 + iwrite=0 + iwave=0 + nwave=NTZ + nfsample=12000 + ngo=1 + npabuf=1152 + ntxok=0 + ntransmitting=0 + tx_once=.false. + snrdb=99.0 + txmsg='CQ K1JT FN20' + ltx=.false. + lrx=.false. + autoseq=.false. + QSO_in_progress=.false. + ntxed=0 + + if(nargs.eq.3) then + call getarg(1,txmsg) + call getarg(2,arg) + read(arg,*) f0 + call getarg(3,arg) + read(arg,*) snrdb + tx_once=.true. + ftx=1500.0 + call transmit(-1,ftx,iptt) + snrdb=99.0 + endif + +! Start the audio streams + ierr=ft2audio(idevin,idevout,npabuf,nright,y1,y2,NRING,iwrite,itx, & + iwave,nwave+3*1152,nfsample,nTxOK,nTransmitting,ngo) + if(ierr.ne.0) then + print*,'Error',ierr,' starting audio input and/or output.' + endif + +999 end program ft2 + +subroutine update(total_time,ic1,ic2) + + use wavhdr + type(hdr) h + real*8 total_time + integer*8 count0,count1,clkfreq + integer ptt + integer*2 id(30000) + logical transmitted,level,ok + character*70 line + character cdatetime*17,fname*17,mode*8,band*6 + include 'gcom1.f90' + data nt0/-1/,transmitted/.false./,snr/-99.0/ + data level/.false./ + save nt0,transmitted,level,snr,iptt + + if(ic1.ne.0 .or. ic2.ne.0) then + if(ic1.eq.27 .and. ic2.eq.0) ngo=0 !ESC + if(nTxOK.eq.0 .and. ntransmitting.eq.0) then + nfunc=0 + if(ic1.eq.0 .and. ic2.eq.59) nfunc=1 !F1 + if(ic1.eq.0 .and. ic2.eq.60) nfunc=2 !F2 + if(ic1.eq.0 .and. ic2.eq.61) nfunc=3 !F3 + if(ic1.eq.0 .and. ic2.eq.62) nfunc=4 !F4 + if(ic1.eq.0 .and. ic2.eq.63) nfunc=5 !F5 + if(nfunc.eq.1 .or. (nfunc.ge.2 .and. hiscall.ne.' ')) then + ftx=1500.0 + call transmit(nfunc,ftx,iptt) + endif + endif + if(ic1.eq.13 .and. ic2.eq.0) hiscall=hiscall_next + if((ic1.eq.97 .or. ic1.eq.65) .and. ic2.eq.0) autoseq=.not.autoseq + if((ic1.eq.108 .or. ic1.eq.76) .and. ic2.eq.0) level=.not.level + endif + + if(ntransmitting.eq.1) transmitted=.true. + if(transmitted .and. ntransmitting.eq.0) then + i1=0 + if(iptt.eq.1 .and. nport.gt.0) i1=ptt(nport,0,1,iptt) + if(tx_once .and. transmitted) stop + transmitted=.false. + endif + + nt=2*total_time + if(nt.gt.nt0 .or. ic1.ne.0 .or. ic2.ne.0) then + if(level) then +! Measure and display the average level of signal plus noise in past 0.5 s + k=iwrite-6000 + if(k.lt.1) k=k+NRING + sq=0. + do i=1,6000 + k=k+1 + if(k.gt.NRING) k=k-NRING + x=y1(k) + sq=sq + x*x + enddo + sigdb=0. + if(sq.gt.0.0) sigdb=db(sq/6000.0) + n=sigdb + if(n.lt.1) n=1 + if(n.gt.70) n=70 + line=' ' + line(n:n)='*' + write(*,1030) sigdb,ntxed,autoseq,QSO_in_progress,(line(i:i),i=1,n) +1030 format(f4.1,i3,2L2,1x,70a1) +! write(*,1020) nt,total_time,iwrite,itx,ntxok,ntransmitting,ndecodes, & +! snr,sigdb,line +!1020 format(i6,f9.3,i10,i6,3i3,f6.0,f6.1,1x,a30) + endif + k=iwrite-30000 + if(k.lt.1) k=k+NRING + do i=1,30000 + k=k+1 + if(k.gt.NRING) k=k-NRING + id(i)=y1(k) + enddo + nutc=0 + nfqso=1500 + ndecodes=0 + if(maxval(abs(id)).gt.0) then + call system_clock(count0,clkfreq) + nrx=-1 + call ft2_decode(cdatetime(),nfqso,id,ndecodes,mycall,hiscall,nrx) + call system_clock(count1,clkfreq) +! tdecode=float(count1-count0)/float(clkfreq) + + if(ndecodes.ge.1) then + fMHz=7.074 + mode='FT2' + nsubmode=1 + ntrperiod=0 + h=default_header(12000,30000) + k=0 + do i=1,250 + sq=0 + do n=1,120 + k=k+1 + x=id(k) + sq=sq + x*x + enddo + write(43,3043) i,0.01*i,1.e-4*sq +3043 format(i7,f12.6,f12.3) + enddo + call set_wsjtx_wav_params(fMHz,mode,nsubmode,ntrperiod,id) + band="" + mode="" + nsubmode=-1 + ntrperiod=-1 + call get_wsjtx_wav_params(id,band,mode,nsubmode,ntrperiod,ok) +! write(*,1010) band,ntrperiod,mode,char(ichar('A')-1+id(3)) +!1010 format('Band: ',a6,' T/R period:',i4,' Mode: ',a8,1x,a1) + + fname=cdatetime() + fname(14:17)='.wav' + open(13,file=fname,status='unknown',access='stream') + write(13) h,id + close(13) + endif + if(autoseq .and.nrx.eq.2) QSO_in_progress=.true. + if(autoseq .and. QSO_in_progress .and. nrx.ge.1 .and. nrx.le.4) then + lrx(nrx)=.true. + ftx=1500.0 + if(ntxed.eq.1) then + if(nrx.eq.2) then + call transmit(3,ftx,iptt) + else + call transmit(1,ftx,iptt) + endif + endif + if(ntxed.eq.2) then + if(nrx.eq.3) then + call transmit(4,ftx,iptt) + QSO_in_progress=.false. + write(*,1032) +1032 format('QSO complete: S+P side') + else + call transmit(2,ftx,iptt) + endif + endif + if(ntxed.eq.3) then + if(nrx.eq.4) then + QSO_in_progress=.false. + write(*,1034) +1034 format('QSO complete: CQ side') + else + call transmit(3,ftx,iptt) + endif + endif + endif + endif + nt0=nt + endif + + return +end subroutine update + +character*17 function cdatetime() + character cdate*8,ctime*10 + call date_and_time(cdate,ctime) + cdatetime=cdate(3:8)//'_'//ctime + return +end function cdatetime + +subroutine transmit(nfunc,ftx,iptt) + include 'gcom1.f90' + character*17 cdatetime + integer ptt + + if(nTxOK.eq.1) return + + if(nfunc.eq.1) txmsg='CQ '//trim(mycall)//' '//mygrid + if(nfunc.eq.2) txmsg=trim(hiscall)//' '//trim(mycall)// & + ' 559 '//trim(exch) + if(nfunc.eq.3) txmsg=trim(hiscall)//' '//trim(mycall)// & + ' R 559 '//trim(exch) + if(nfunc.eq.4) txmsg=trim(hiscall)//' '//trim(mycall)//' RR73' + if(nfunc.eq.5) txmsg='TNX 73 GL' + call ft2_iwave(txmsg,ftx,snrdb,iwave) + iwave(23041:)=0 + i1=ptt(nport,1,1,iptt) + ntxok=1 + n=len(trim(txmsg)) + write(*,1010) cdatetime(),0,0.0,nint(ftx),(txmsg(i:i),i=1,n) + write(12,1010) cdatetime(),0,0.0,nint(ftx),(txmsg(i:i),i=1,n) +1010 format(a17,i4,f6.2,i5,' Tx ',37a1) + if(nfunc.ge.1 .and. nfunc.le.4) ntxed=nfunc + if(nfunc.ge.1 .and. nfunc.le.5) ltx(nfunc)=.true. + if(nfunc.eq.2 .or. nfunc.eq.3) QSO_in_progress=.true. + + return +end subroutine transmit diff --git a/wsjtx_lib/lib/ft2/ft2.ini b/wsjtx_lib/lib/ft2/ft2.ini new file mode 100644 index 0000000..d66770d --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2.ini @@ -0,0 +1,2 @@ +K1JT FN20 1 5 0 NJ +MyCall MyGrid AudioIn AudioOut PTTport Exch diff --git a/wsjtx_lib/lib/ft2/ft2_decode.f90 b/wsjtx_lib/lib/ft2/ft2_decode.f90 new file mode 100644 index 0000000..1d1bb6a --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2_decode.f90 @@ -0,0 +1,298 @@ +subroutine ft2_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line) + + use crc + use packjt77 + include 'ft2_params.f90' + character message*37,c77*77 + character*61 line + character*37 decodes(100) + character*120 data_dir + character*17 cdatetime0,cdatetime + character*6 mycall,hiscall,hhmmss + 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 + 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 candidate(3,100) + real savg(NH1) + 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) + logical unpk77_success + data s16/0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0/ + + hhmmss=cdatetime0(8:13) + 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.8 !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)) + + data_dir="." + fMHz=7.074 + ncoh=1 + candidate=0.0 + ncand=0 + fa=375.0 + fb=3000.0 + syncmin=0.2 + maxcand=100 + nfqso=-1 + call getcandidates2a(iwave,fa,fb,maxcand,savg,candidate,ncand) + ndecodes=0 + do icand=1,ncand + f0=candidate(1,icand) + 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 +! 750 samples/second here + ibest=-1 + sybest=-99. + dfbest=-1. +!### do if=-15,+15 + do if=-30,30 + df=if + a=0. + a(1)=-df + call twkfreq1(c2,NMAX/16,fs,a,cb) + do is=0,374 !DT search range is 0 - 0.5 s + csync1=0. + cterm=1 + do ib=1,16 + i1=(ib-1)*10+is + i2=i1+136*10 + if(s16(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. + a(1)=-dfbest + call twkfreq1(c2,NMAX/16,fs,a,cb) + ib=ibest + cd=cb(ib:ib+144*10-1) + s2=sum(real(cd*conjg(cd)))/(10*144) + cd=cd/sqrt(s2) + do nseq=1,5 + 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) + 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 + nhardmin=-1 + if(sum(message77).eq.0) cycle + if( nharderror.ge.0 ) then + write(c77,'(77i1)') message77(1:77) + call unpack77(c77,nrx,message,unpk77_success) + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.message) idupe=1 + enddo + if(idupe.eq.1) exit + ndecodes=ndecodes+1 + decodes(ndecodes)=message + xsnr=db(sybest*sybest) - 115.0 !### Rough estimate of S/N ### + nsnr=nint(xsnr) + freq=f0+dfbest + write(line,1000) hhmmss,nsnr,ibest/750.0,nint(freq),message +1000 format(a6,i4,f5.2,i5,' + ',1x,a37) + open(24,file='all_ft2.txt',status='unknown',position='append') + write(24,1002) cdatetime0,nsnr,ibest/750.0,nint(freq),message, & + nseq,nharderror,nhardmin + if(hhmmss.eq.' ') write(*,1002) cdatetime0,nsnr, & + ibest/750.0,nint(freq),message,nseq,nharderror,nhardmin +1002 format(a17,i4,f6.2,i5,' Rx ',a37,3i5) + close(24) + +!### Temporary: assume most recent decoded message conveys "hiscall". + i0=index(message,' ') + if(i0.ge.3 .and. i0.le.7) then + hiscall=message(i0+1:i0+6) + i1=index(hiscall,' ') + if(i1.gt.0) hiscall=hiscall(1:i1) + endif + nrx=-1 + if(index(message,'CQ ').eq.1) nrx=1 + if((index(message,trim(mycall)//' ').eq.1) .and. & + (index(message,' '//trim(hiscall)//' ').ge.4)) then + if(index(message,' 559 ').gt.8) nrx=2 + if(index(message,' R 559 ').gt.8) nrx=3 + if(index(message,' RR73 ').gt.8) nrx=4 + endif +!### + exit + endif + enddo ! nseq + enddo !candidate list + + return +end subroutine ft2_decode + +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/wsjtx_lib/lib/ft2/ft2_gfsk_iwave.f90 b/wsjtx_lib/lib/ft2/ft2_gfsk_iwave.f90 new file mode 100644 index 0000000..2611eca --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2_gfsk_iwave.f90 @@ -0,0 +1,88 @@ +subroutine ft2_gfsk_iwave(msg37,f0,snrdb,iwave) + +! Generate waveform for experimental "FT2" mode + + use packjt77 + include 'ft2_params.f90' !Set various constants + parameter (NWAVE=(NN+2)*NSPS) + character msg37*37,msgsent37*37 + real wave(NWAVE),xnoise(NWAVE) + real dphi(NWAVE) + real pulse(480) + + integer itone(NN) + integer*2 iwave(NWAVE) !Generated full-length waveform + logical first + data first/.true./ + save pulse + + twopi=8.0*atan(1.0) + fs=12000.0 !Sample rate (Hz) + dt=1.0/fs !Sample interval (s) + hmod=0.8 !Modulation index (MSK=0.5, FSK=1.0) + tt=NSPS*dt !Duration of symbols (s) + baud=1.0/tt !Keying rate (baud) + bw=1.5*baud !Occupied bandwidth (Hz) + 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 + + if(first) then +! The filtered frequency pulse + do i=1,480 + tt=(i-240.5)/160.0 + pulse(i)=gfsk_pulse(1.0,tt) + enddo + dphi_peak=twopi*(hmod/2.0)/real(NSPS) + first=.false. + endif + +! Source-encode, then get itone(): + itype=1 + call genft2(msg37,0,msgsent37,itone,itype) + +! Create the instantaneous frequency waveform + dphi=0.0 + do j=1,NN + ib=(j-1)*160+1 + ie=ib+480-1 + dphi(ib:ie)=dphi(ib:ie)+dphi_peak*pulse*(2*itone(j)-1) + enddo + + phi=0.0 + wave=0.0 + sqrt2=sqrt(2.) + dphi=dphi+twopi*f0*dt + do j=1,NWAVE + wave(j)=sqrt2*sin(phi) + sqsig=sqsig + wave(j)**2 + phi=mod(phi+dphi(j),twopi) + enddo + wave(1:160)=wave(1:160)*(1.0-cos(twopi*(/(i,i=0,159)/)/320.0) )/2.0 + wave(145*160+1:146*160)=wave(145*160+1:146*160)*(1.0+cos(twopi*(/(i,i=0,159)/)/320.0 ))/2.0 + wave(146*160+1:)=0. + + if(snrdb.gt.90.0) then + iwave=nint((32767.0/sqrt(2.0))*wave) + return + endif + + sqnoise=1.e-30 + if(snrdb.lt.90) then + do i=1,NWAVE !Add gaussian noise at specified SNR + xnoise(i)=gran() !Noise has rms = 1.0 + enddo + endif + xnoise=xnoise*sqrt(0.5*fs/2500.0) + fac=30.0 + snr_amplitude=10.0**(0.05*snrdb) + wave=fac*(snr_amplitude*wave + xnoise) + datpk=maxval(abs(wave)) + print*,'A',snr_amplitude,datpk + + iwave=nint((30000.0/datpk)*wave) + + return +end subroutine ft2_gfsk_iwave diff --git a/wsjtx_lib/lib/ft2/ft2_iwave.f90 b/wsjtx_lib/lib/ft2/ft2_iwave.f90 new file mode 100644 index 0000000..10b9908 --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2_iwave.f90 @@ -0,0 +1,64 @@ +subroutine ft2_iwave(msg37,f0,snrdb,iwave) + +! Generate waveform for experimental "FT2" mode + + use packjt77 + include 'ft2_params.f90' !Set various constants + parameter (NWAVE=NN*NSPS) + character msg37*37,msgsent37*37 + real wave(NWAVE),xnoise(NWAVE) + integer itone(NN) + integer*2 iwave(NWAVE) !Generated full-length waveform + + twopi=8.0*atan(1.0) + fs=12000.0 !Sample rate (Hz) + dt=1.0/fs !Sample interval (s) + hmod=0.8 !Modulation index (MSK=0.5, FSK=1.0) + tt=NSPS*dt !Duration of symbols (s) + baud=1.0/tt !Keying rate (baud) + bw=1.5*baud !Occupied bandwidth (Hz) + 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(): + itype=1 + call genft2(msg37,0,msgsent37,itone,itype) + + k=0 + phi=0.0 + sqsig=0. + do j=1,NN !Generate real waveform + dphi=twopi*(f0*dt+(hmod/2.0)*(2*itone(j)-1)/real(NSPS)) + do i=1,NSPS + k=k+1 + wave(k)=sqrt(2.0)*sin(phi) !Signal has rms = 1.0 + sqsig=sqsig + wave(k)**2 + phi=mod(phi+dphi,twopi) + enddo + enddo + + if(snrdb.gt.90.0) then + iwave=nint((32767.0/sqrt(2.0))*wave) + return + endif + + sqnoise=1.e-30 + if(snrdb.lt.90) then + do i=1,NWAVE !Add gaussian noise at specified SNR + xnoise(i)=gran() !Noise has rms = 1.0 + enddo + endif + xnoise=xnoise*sqrt(0.5*fs/2500.0) + fac=30.0 + snr_amplitude=10.0**(0.05*snrdb) + wave=fac*(snr_amplitude*wave + xnoise) + datpk=maxval(abs(wave)) + print*,'A',snr_amplitude,datpk + + iwave=nint((30000.0/datpk)*wave) + + return +end subroutine ft2_iwave diff --git a/wsjtx_lib/lib/ft2/ft2_params.f90 b/wsjtx_lib/lib/ft2/ft2_params.f90 new file mode 100644 index 0000000..4751e47 --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2_params.f90 @@ -0,0 +1,12 @@ +! 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=30000) !Samples in iwave (2.5*12000) +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/wsjtx_lib/lib/ft2/ft2audio.c b/wsjtx_lib/lib/ft2/ft2audio.c new file mode 100644 index 0000000..b5f19fa --- /dev/null +++ b/wsjtx_lib/lib/ft2/ft2audio.c @@ -0,0 +1,347 @@ +#include +#include "portaudio.h" +#include +#include + +int iaa; +int icc; +double total_time=0.0; + +// Definition of structure pointing to the audio data +typedef struct +{ + int *iwrite; + int *itx; + int *TxOK; + int *Transmitting; + int *nwave; + int *nright; + int nring; + int nfs; + short *y1; + short *y2; + short *iwave; +} paTestData; + +// Input callback routine: +static int +SoundIn( void *inputBuffer, void *outputBuffer, + unsigned long framesPerBuffer, + const PaStreamCallbackTimeInfo* timeInfo, + PaStreamCallbackFlags statusFlags, + void *userData ) +{ + paTestData *data = (paTestData*)userData; + short *in = (short*)inputBuffer; + unsigned int i; + static int ia=0; + + if(*data->Transmitting) return 0; + + if(statusFlags!=0) printf("Status flags %d\n",(int)statusFlags); + + if((statusFlags&1) == 0) { + //increment buffer pointers only if data available + ia=*data->iwrite; + if(*data->nright==0) { //Use left channel for input + for(i=0; iy1[ia] = (*in++); + data->y2[ia] = (*in++); + ia++; + } + } else { //Use right channel + for(i=0; iy2[ia] = (*in++); + data->y1[ia] = (*in++); + ia++; + } + } + } + + if(ia >= data->nring) ia=0; //Wrap buffer pointer if necessary + *data->iwrite = ia; //Save buffer pointer + iaa=ia; + total_time += (double)framesPerBuffer/12000.0; + // printf("iwrite: %d\n",*data->iwrite); + return 0; +} + +// Output callback routine: +static int +SoundOut( void *inputBuffer, void *outputBuffer, + unsigned long framesPerBuffer, + const PaStreamCallbackTimeInfo* timeInfo, + PaStreamCallbackFlags statusFlags, + void *userData ) +{ + paTestData *data = (paTestData*)userData; + short *wptr = (short*)outputBuffer; + unsigned int i,n; + static short int n2; + static int ic=0; + static int TxOKz=0; + static clock_t tstart=-1; + static clock_t tend=-1; + static int nsent=0; + + // printf("txOK: %d %d\n",TxOKz,*data->TxOK); + + if(*data->TxOK && (!TxOKz)) ic=0; //Reset buffer pointer to start Tx + *data->Transmitting=*data->TxOK; //Set the "transmitting" flag + + if(*data->TxOK) { + if(!TxOKz) { + // Start of a transmission + tstart=clock(); + nsent=0; + // printf("Start Tx\n"); + } + TxOKz=*data->TxOK; + for(i=0 ; i < framesPerBuffer; i++ ) { + n2=data->iwave[ic]; + *wptr++ = n2; //left + *wptr++ = n2; //right + ic++; + + if(ic > *data->nwave) { + *data->TxOK = 0; + *data->Transmitting = 0; + *data->iwrite = 0; //Reset Rx buffer pointer to 0 + ic=0; + tend=clock(); + double TxT=((double)(tend-tstart))/CLOCKS_PER_SEC; + // printf("End Tx, TxT = %f nSent = %d\n",TxT,nsent); + break; + } + } + nsent += framesPerBuffer; + } else { + memset((void*)outputBuffer, 0, 2*sizeof(short)*framesPerBuffer); + } + *data->itx = icc; //Save buffer pointer + icc=ic; + return 0; +} + +/*******************************************************************/ +int ft2audio_(int *ndevin, int *ndevout, int *npabuf, int *nright, + short y1[], short y2[], int *nring, int *iwrite, + int *itx, short iwave[], int *nwave, int *nfsample, + int *TxOK, int *Transmitting, int *ngo) + +{ + paTestData data; + PaStream *instream, *outstream; + PaStreamParameters inputParameters, outputParameters; + // PaStreamInfo *streamInfo; + + int nfpb = *npabuf; + int nSampleRate = *nfsample; + int ndevice_in = *ndevin; + int ndevice_out = *ndevout; + double dSampleRate = (double) *nfsample; + PaError err_init, err_open_in, err_open_out, err_start_in, err_start_out; + PaError err = 0; + + data.iwrite = iwrite; + data.itx = itx; + data.TxOK = TxOK; + data.Transmitting = Transmitting; + data.y1 = y1; + data.y2 = y2; + data.nring = *nring; + data.nright = nright; + data.nwave = nwave; + data.iwave = iwave; + data.nfs = nSampleRate; + + err_init = Pa_Initialize(); // Initialize PortAudio + + if(err_init) { + printf("Error initializing PortAudio.\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_init), + err_init); + Pa_Terminate(); // I don't think we need this but... + return(-1); + } + + // printf("Opening device %d for input, %d for output...\n", + // ndevice_in,ndevice_out); + + inputParameters.device = ndevice_in; + inputParameters.channelCount = 2; + inputParameters.sampleFormat = paInt16; + inputParameters.suggestedLatency = 0.2; + inputParameters.hostApiSpecificStreamInfo = NULL; + +// Test if this configuration actually works, so we do not run into an +// ugly assertion + err_open_in = Pa_IsFormatSupported(&inputParameters, NULL, dSampleRate); + + if (err_open_in == 0) { + err_open_in = Pa_OpenStream( + &instream, //address of stream + &inputParameters, + NULL, + dSampleRate, //Sample rate + nfpb, //Frames per buffer + paNoFlag, + (PaStreamCallback *)SoundIn, //Callback routine + (void *)&data); //address of data structure + + if(err_open_in) { // We should have no error here usually + printf("Error opening input audio stream:\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_open_in), + err_open_in); + err = 1; + } else { + // printf("Successfully opened audio input.\n"); + } + } else { + printf("Error opening input audio stream.\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_open_in), + err_open_in); + err = 1; + } + + outputParameters.device = ndevice_out; + outputParameters.channelCount = 2; + outputParameters.sampleFormat = paInt16; + outputParameters.suggestedLatency = 0.2; + outputParameters.hostApiSpecificStreamInfo = NULL; + +// Test if this configuration actually works, so we do not run into an +// ugly assertion. + err_open_out = Pa_IsFormatSupported(NULL, &outputParameters, dSampleRate); + + if (err_open_out == 0) { + err_open_out = Pa_OpenStream( + &outstream, //address of stream + NULL, + &outputParameters, + dSampleRate, //Sample rate + nfpb, //Frames per buffer + paNoFlag, + (PaStreamCallback *)SoundOut, //Callback routine + (void *)&data); //address of data structure + + if(err_open_out) { // We should have no error here usually + printf("Error opening output audio stream!\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_open_out), + err_open_out); + err += 2; + } else { + // printf("Successfully opened audio output.\n"); + } + } else { + printf("Error opening output audio stream.\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_open_out), + err_open_out); + err += 2; + } + + // if there was no error in opening both streams start them + if (err == 0) { + err_start_in = Pa_StartStream(instream); //Start input stream + if(err_start_in) { + printf("Error starting input audio stream!\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_start_in), + err_start_in); + err += 4; + } + + err_start_out = Pa_StartStream(outstream); //Start output stream + if(err_start_out) { + printf("Error starting output audio stream!\n"); + printf("\tErrortext: %s\n\tNumber: %d\n",Pa_GetErrorText(err_start_out), + err_start_out); + err += 8; + } + } + + if (err == 0) printf("Audio streams running normally.\n******************************************************************\n"); + + while( Pa_IsStreamActive(instream) && (*ngo != 0) && (err == 0) ) { + int ic1=0; + int ic2=0; + if(_kbhit()) ic1 = _getch(); + if(_kbhit()) ic2 = _getch(); + // if(ic1!=0 || ic2!=0) printf("%d %d %d\n",iaa,ic1,ic2); + update_(&total_time,&ic1,&ic2); + Pa_Sleep(100); + } + + Pa_AbortStream(instream); // Abort stream + Pa_CloseStream(instream); // Close stream, we're done. + Pa_AbortStream(outstream); // Abort stream + Pa_CloseStream(outstream); // Close stream, we're done. + + Pa_Terminate(); + + return(err); +} + + +int padevsub_(int *idevin, int *idevout) +{ + int numdev,ndefin,ndefout; + int nchin[101], nchout[101]; + int i, devIdx; + int numDevices; + const PaDeviceInfo *pdi; + PaError err; + + Pa_Initialize(); + numDevices = Pa_GetDeviceCount(); + numdev = numDevices; + + if( numDevices < 0 ) { + err = numDevices; + Pa_Terminate(); + return err; + } + + if ((devIdx = Pa_GetDefaultInputDevice()) > 0) { + ndefin = devIdx; + } else { + ndefin = 0; + } + + if ((devIdx = Pa_GetDefaultOutputDevice()) > 0) { + ndefout = devIdx; + } else { + ndefout = 0; + } + + printf("\nAudio Input Output Device Name\n"); + printf("Device Channels Channels\n"); + printf("------------------------------------------------------------------\n"); + + for( i=0; i < numDevices; i++ ) { + pdi = Pa_GetDeviceInfo(i); +// if(i == Pa_GetDefaultInputDevice()) ndefin = i; +// if(i == Pa_GetDefaultOutputDevice()) ndefout = i; + nchin[i]=pdi->maxInputChannels; + nchout[i]=pdi->maxOutputChannels; + printf(" %2d %2d %2d %s\n",i,nchin[i],nchout[i], + pdi->name); + } + + printf("\nUser requested devices: Input = %2d Output = %2d\n", + *idevin,*idevout); + printf("Default devices: Input = %2d Output = %2d\n", + ndefin,ndefout); + if((*idevin<0) || (*idevin>=numdev)) *idevin=ndefin; + if((*idevout<0) || (*idevout>=numdev)) *idevout=ndefout; + if((*idevin==0) && (*idevout==0)) { + *idevin=ndefin; + *idevout=ndefout; + } + printf("Will open devices: Input = %2d Output = %2d\n", + *idevin,*idevout); + + Pa_Terminate(); + + return 0; +} + diff --git a/wsjtx_lib/lib/ft2/g4.cmd b/wsjtx_lib/lib/ft2/g4.cmd new file mode 100644 index 0000000..0894dbe --- /dev/null +++ b/wsjtx_lib/lib/ft2/g4.cmd @@ -0,0 +1,7 @@ +gcc -c ft2audio.c +gcc -c ptt.c +gfortran -c ../77bit/packjt77.f90 +gfortran -c ../wavhdr.f90 +gfortran -c ../crc.f90 +gfortran -o ft2 -fbounds-check -fno-second-underscore -ffpe-trap=invalid,zero -Wall -Wno-conversion -Wno-character-truncation ft2.f90 ft2_iwave.f90 ft2_decode.f90 getcandidates2.f90 ft2audio.o ptt.o /JTSDK/wsjtx-output/qt55/2.1.0/Release/build/libwsjt_fort.a /JTSDK/wsjtx-output/qt55/2.1.0/Release/build/libwsjt_cxx.a libportaudio.a ../libfftw3f_win.a -lwinmm +rm *.o *.mod diff --git a/wsjtx_lib/lib/ft2/gcom1.f90 b/wsjtx_lib/lib/ft2/gcom1.f90 new file mode 100644 index 0000000..9402f9d --- /dev/null +++ b/wsjtx_lib/lib/ft2/gcom1.f90 @@ -0,0 +1,34 @@ +! Variable Purpose +!--------------------------------------------------------------------------- +integer NRING !Length of Rx ring buffer +integer NTZ !Length of Tx waveform in samples +parameter(NRING=230400) !Ring buffer at 12000 samples/sec +parameter(NTZ=23040) !144*160 +parameter(NMAX=30000) !2.5*12000 +real snrdb +integer ndevin !Device# for audio input +integer ndevout !Device# for audio output +integer iwrite !Pointer to Rx ring buffer +integer itx !Pointer to Tx buffer +integer ngo !Set to 0 to terminate audio streams +integer nTransmitting !Actually transmitting? +integer nTxOK !OK to transmit? +integer nport !COM port for PTT +logical tx_once !Transmit one message, then exit +logical ltx !True if msg i has been transmitted +logical lrx !True if msg i has been received +logical autoseq +logical QSO_in_progress +integer*2 y1 !Ring buffer for audio channel 0 +integer*2 y2 !Ring buffer for audio channel 1 +integer*2 iwave !Data for Tx audio +character*6 mycall +character*6 hiscall +character*6 hiscall_next +character*4 mygrid +character*3 exch +character*37 txmsg + +common/gcom1/snrdb,ndevin,ndevout,iwrite,itx,ngo,nTransmitting,nTxOK,nport, & + ntxed,tx_once,y1(NRING),y2(NRING),iwave(NTZ+3*1152),ltx(5),lrx(5), & + autoseq,QSO_in_progress,mycall,hiscall,hiscall_next,mygrid,exch,txmsg diff --git a/wsjtx_lib/lib/ft2/genft2.f90 b/wsjtx_lib/lib/ft2/genft2.f90 new file mode 100644 index 0000000..2eb36bc --- /dev/null +++ b/wsjtx_lib/lib/ft2/genft2.f90 @@ -0,0 +1,86 @@ +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/wsjtx_lib/lib/ft2/getcandidates2a.f90 b/wsjtx_lib/lib/ft2/getcandidates2a.f90 new file mode 100644 index 0000000..8e7209c --- /dev/null +++ b/wsjtx_lib/lib/ft2/getcandidates2a.f90 @@ -0,0 +1,64 @@ +subroutine getcandidates2a(id,fa,fb,maxcand,savg,candidate,ncand) + +! 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 x(NFFT1) + complex cx(0:NH1) + real candidate(3,100) + 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 + savsm(1)=savg(1) + savsm(NH1)=savg(NH1) + + nfa=nint(fa/df) + nfb=nint(fb/df) + np=nfb-nfa+1 + indx=0 + call indexx(savsm(nfa:nfb),np,indx) + xn=savsm(nfa+indx(nint(0.3*np))) + if(xn.ne.0) 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 + if(ncand.lt.maxcand) ncand=ncand+1 + candidate(1,ncand)=f0 + endif + + return +end subroutine getcandidates2a diff --git a/wsjtx_lib/lib/ft2/gfsk_pulse.f90 b/wsjtx_lib/lib/ft2/gfsk_pulse.f90 new file mode 100644 index 0000000..99ab78e --- /dev/null +++ b/wsjtx_lib/lib/ft2/gfsk_pulse.f90 @@ -0,0 +1,6 @@ +real function gfsk_pulse(b,t) + pi=4.*atan(1.0) + c=pi*sqrt(2.0/log(2.0)) + gfsk_pulse=0.5*(erf(c*b*(t+0.5))-erf(c*b*(t-0.5))) + return +end function gfsk_pulse diff --git a/wsjtx_lib/lib/ft2/libportaudio.a b/wsjtx_lib/lib/ft2/libportaudio.a new file mode 100644 index 0000000..f20f02c Binary files /dev/null and b/wsjtx_lib/lib/ft2/libportaudio.a differ diff --git a/wsjtx_lib/lib/ft2/libwsjt_cxx.a b/wsjtx_lib/lib/ft2/libwsjt_cxx.a new file mode 100644 index 0000000..d10d509 Binary files /dev/null and b/wsjtx_lib/lib/ft2/libwsjt_cxx.a differ diff --git a/wsjtx_lib/lib/ft2/libwsjt_fort.a b/wsjtx_lib/lib/ft2/libwsjt_fort.a new file mode 100644 index 0000000..7884c85 Binary files /dev/null and b/wsjtx_lib/lib/ft2/libwsjt_fort.a differ diff --git a/wsjtx_lib/lib/ft2/portaudio.h b/wsjtx_lib/lib/ft2/portaudio.h new file mode 100644 index 0000000..250fba0 --- /dev/null +++ b/wsjtx_lib/lib/ft2/portaudio.h @@ -0,0 +1,1123 @@ + +#ifndef PORTAUDIO_H +#define PORTAUDIO_H +/* + * $Id: portaudio.h,v 1.1 2005/11/29 21:27:24 joe Exp $ + * PortAudio Portable Real-Time Audio Library + * PortAudio API Header File + * Latest version available at: http://www.portaudio.com/ + * + * Copyright (c) 1999-2002 Ross Bencina and Phil Burk + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files + * (the "Software"), to deal in the Software without restriction, + * including without limitation the rights to use, copy, modify, merge, + * publish, distribute, sublicense, and/or sell copies of the Software, + * and to permit persons to whom the Software is furnished to do so, + * subject to the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * Any person wishing to distribute modifications to the Software is + * requested to send the modifications to the original developer so that + * they can be incorporated into the canonical version. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR + * ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF + * CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +/** @file + @brief The PortAudio API. +*/ + + +#ifdef __cplusplus +extern "C" +{ +#endif /* __cplusplus */ + + +/** Retrieve the release number of the currently running PortAudio build, + eg 1900. +*/ +int Pa_GetVersion( void ); + + +/** Retrieve a textual description of the current PortAudio build, + eg "PortAudio V19-devel 13 October 2002". +*/ +const char* Pa_GetVersionText( void ); + + +/** Error codes returned by PortAudio functions. + Note that with the exception of paNoError, all PaErrorCodes are negative. +*/ + +typedef int PaError; +typedef enum PaErrorCode +{ + paNoError = 0, + + paNotInitialized = -10000, + paUnanticipatedHostError, + paInvalidChannelCount, + paInvalidSampleRate, + paInvalidDevice, + paInvalidFlag, + paSampleFormatNotSupported, + paBadIODeviceCombination, + paInsufficientMemory, + paBufferTooBig, + paBufferTooSmall, + paNullCallback, + paBadStreamPtr, + paTimedOut, + paInternalError, + paDeviceUnavailable, + paIncompatibleHostApiSpecificStreamInfo, + paStreamIsStopped, + paStreamIsNotStopped, + paInputOverflowed, + paOutputUnderflowed, + paHostApiNotFound, + paInvalidHostApi, + paCanNotReadFromACallbackStream, /**< @todo review error code name */ + paCanNotWriteToACallbackStream, /**< @todo review error code name */ + paCanNotReadFromAnOutputOnlyStream, /**< @todo review error code name */ + paCanNotWriteToAnInputOnlyStream, /**< @todo review error code name */ + paIncompatibleStreamHostApi +} PaErrorCode; + + +/** Translate the supplied PortAudio error code into a human readable + message. +*/ +const char *Pa_GetErrorText( PaError errorCode ); + + +/** Library initialization function - call this before using PortAudio. + This function initialises internal data structures and prepares underlying + host APIs for use. This function MUST be called before using any other + PortAudio API functions. + + If Pa_Initialize() is called multiple times, each successful + call must be matched with a corresponding call to Pa_Terminate(). + Pairs of calls to Pa_Initialize()/Pa_Terminate() may overlap, and are not + required to be fully nested. + + Note that if Pa_Initialize() returns an error code, Pa_Terminate() should + NOT be called. + + @return paNoError if successful, otherwise an error code indicating the cause + of failure. + + @see Pa_Terminate +*/ +PaError Pa_Initialize( void ); + + +/** Library termination function - call this when finished using PortAudio. + This function deallocates all resources allocated by PortAudio since it was + initializied by a call to Pa_Initialize(). In cases where Pa_Initialise() has + been called multiple times, each call must be matched with a corresponding call + to Pa_Terminate(). The final matching call to Pa_Terminate() will automatically + close any PortAudio streams that are still open. + + Pa_Terminate() MUST be called before exiting a program which uses PortAudio. + Failure to do so may result in serious resource leaks, such as audio devices + not being available until the next reboot. + + @return paNoError if successful, otherwise an error code indicating the cause + of failure. + + @see Pa_Initialize +*/ +PaError Pa_Terminate( void ); + + + +/** The type used to refer to audio devices. Values of this type usually + range from 0 to (Pa_DeviceCount-1), and may also take on the PaNoDevice + and paUseHostApiSpecificDeviceSpecification values. + + @see Pa_DeviceCount, paNoDevice, paUseHostApiSpecificDeviceSpecification +*/ +typedef int PaDeviceIndex; + + +/** A special PaDeviceIndex value indicating that no device is available, + or should be used. + + @see PaDeviceIndex +*/ +#define paNoDevice ((PaDeviceIndex)-1) + + +/** A special PaDeviceIndex value indicating that the device(s) to be used + are specified in the host api specific stream info structure. + + @see PaDeviceIndex +*/ +#define paUseHostApiSpecificDeviceSpecification ((PaDeviceIndex)-2) + + +/* Host API enumeration mechanism */ + +/** The type used to enumerate to host APIs at runtime. Values of this type + range from 0 to (Pa_GetHostApiCount()-1). + + @see Pa_GetHostApiCount +*/ +typedef int PaHostApiIndex; + + +/** Retrieve the number of available host APIs. Even if a host API is + available it may have no devices available. + + @return A non-negative value indicating the number of available host APIs + or, a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. + + @see PaHostApiIndex +*/ +PaHostApiIndex Pa_GetHostApiCount( void ); + + +/** Retrieve the index of the default host API. The default host API will be + the lowest common denominator host API on the current platform and is + unlikely to provide the best performance. + + @return A non-negative value ranging from 0 to (Pa_GetHostApiCount()-1) + indicating the default host API index or, a PaErrorCode (which are always + negative) if PortAudio is not initialized or an error is encountered. +*/ +PaHostApiIndex Pa_GetDefaultHostApi( void ); + + +/** Unchanging unique identifiers for each supported host API. This type + is used in the PaHostApiInfo structure. The values are guaranteed to be + unique and to never change, thus allowing code to be written that + conditionally uses host API specific extensions. + + New type ids will be allocated when support for a host API reaches + "public alpha" status, prior to that developers should use the + paInDevelopment type id. + + @see PaHostApiInfo +*/ +typedef enum PaHostApiTypeId +{ + paInDevelopment=0, /* use while developing support for a new host API */ + paDirectSound=1, + paMME=2, + paASIO=3, + paSoundManager=4, + paCoreAudio=5, + paOSS=7, + paALSA=8, + paAL=9, + paBeOS=10, + paWDMKS=11, + paJACK=12 +} PaHostApiTypeId; + + +/** A structure containing information about a particular host API. */ + +typedef struct PaHostApiInfo +{ + /** this is struct version 1 */ + int structVersion; + /** The well known unique identifier of this host API @see PaHostApiTypeId */ + PaHostApiTypeId type; + /** A textual description of the host API for display on user interfaces. */ + const char *name; + + /** The number of devices belonging to this host API. This field may be + used in conjunction with Pa_HostApiDeviceIndexToDeviceIndex() to enumerate + all devices for this host API. + @see Pa_HostApiDeviceIndexToDeviceIndex + */ + int deviceCount; + + /** The the default input device for this host API. The value will be a + device index ranging from 0 to (Pa_GetDeviceCount()-1), or paNoDevice + if no default input device is available. + */ + PaDeviceIndex defaultInputDevice; + + /** The the default output device for this host API. The value will be a + device index ranging from 0 to (Pa_GetDeviceCount()-1), or paNoDevice + if no default output device is available. + */ + PaDeviceIndex defaultOutputDevice; + +} PaHostApiInfo; + + +/** Retrieve a pointer to a structure containing information about a specific + host Api. + + @param hostApi A valid host API index ranging from 0 to (Pa_GetHostApiCount()-1) + + @return A pointer to an immutable PaHostApiInfo structure describing + a specific host API. If the hostApi parameter is out of range or an error + is encountered, the function returns NULL. + + The returned structure is owned by the PortAudio implementation and must not + be manipulated or freed. The pointer is only guaranteed to be valid between + calls to Pa_Initialize() and Pa_Terminate(). +*/ +const PaHostApiInfo * Pa_GetHostApiInfo( PaHostApiIndex hostApi ); + + +/** Convert a static host API unique identifier, into a runtime + host API index. + + @param type A unique host API identifier belonging to the PaHostApiTypeId + enumeration. + + @return A valid PaHostApiIndex ranging from 0 to (Pa_GetHostApiCount()-1) or, + a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. + + The paHostApiNotFound error code indicates that the host API specified by the + type parameter is not available. + + @see PaHostApiTypeId +*/ +PaHostApiIndex Pa_HostApiTypeIdToHostApiIndex( PaHostApiTypeId type ); + + +/** Convert a host-API-specific device index to standard PortAudio device index. + This function may be used in conjunction with the deviceCount field of + PaHostApiInfo to enumerate all devices for the specified host API. + + @param hostApi A valid host API index ranging from 0 to (Pa_GetHostApiCount()-1) + + @param hostApiDeviceIndex A valid per-host device index in the range + 0 to (Pa_GetHostApiInfo(hostApi)->deviceCount-1) + + @return A non-negative PaDeviceIndex ranging from 0 to (Pa_GetDeviceCount()-1) + or, a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. + + A paInvalidHostApi error code indicates that the host API index specified by + the hostApi parameter is out of range. + + A paInvalidDevice error code indicates that the hostApiDeviceIndex parameter + is out of range. + + @see PaHostApiInfo +*/ +PaDeviceIndex Pa_HostApiDeviceIndexToDeviceIndex( PaHostApiIndex hostApi, + int hostApiDeviceIndex ); + + + +/** Structure used to return information about a host error condition. +*/ +typedef struct PaHostErrorInfo{ + PaHostApiTypeId hostApiType; /**< the host API which returned the error code */ + long errorCode; /**< the error code returned */ + const char *errorText; /**< a textual description of the error if available, otherwise a zero-length string */ +}PaHostErrorInfo; + + +/** Return information about the last host error encountered. The error + information returned by Pa_GetLastHostErrorInfo() will never be modified + asyncronously by errors occurring in other PortAudio owned threads + (such as the thread that manages the stream callback.) + + This function is provided as a last resort, primarily to enhance debugging + by providing clients with access to all available error information. + + @return A pointer to an immutable structure constaining information about + the host error. The values in this structure will only be valid if a + PortAudio function has previously returned the paUnanticipatedHostError + error code. +*/ +const PaHostErrorInfo* Pa_GetLastHostErrorInfo( void ); + + + +/* Device enumeration and capabilities */ + +/** Retrieve the number of available devices. The number of available devices + may be zero. + + @return A non-negative value indicating the number of available devices or, + a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. +*/ +PaDeviceIndex Pa_GetDeviceCount( void ); + + +/** Retrieve the index of the default input device. The result can be + used in the inputDevice parameter to Pa_OpenStream(). + + @return The default input device index for the default host API, or paNoDevice + if no default input device is available or an error was encountered. +*/ +PaDeviceIndex Pa_GetDefaultInputDevice( void ); + + +/** Retrieve the index of the default output device. The result can be + used in the outputDevice parameter to Pa_OpenStream(). + + @return The default output device index for the defualt host API, or paNoDevice + if no default output device is available or an error was encountered. + + @note + On the PC, the user can specify a default device by + setting an environment variable. For example, to use device #1. +
+ set PA_RECOMMENDED_OUTPUT_DEVICE=1
+
+ The user should first determine the available device ids by using + the supplied application "pa_devs". +*/ +PaDeviceIndex Pa_GetDefaultOutputDevice( void ); + + +/** The type used to represent monotonic time in seconds that can be used + for syncronisation. The type is used for the outTime argument to the + PaStreamCallback and as the result of Pa_GetStreamTime(). + + @see PaStreamCallback, Pa_GetStreamTime +*/ +typedef double PaTime; + + +/** A type used to specify one or more sample formats. Each value indicates + a possible format for sound data passed to and from the stream callback, + Pa_ReadStream and Pa_WriteStream. + + The standard formats paFloat32, paInt16, paInt32, paInt24, paInt8 + and aUInt8 are usually implemented by all implementations. + + The floating point representation (paFloat32) uses +1.0 and -1.0 as the + maximum and minimum respectively. + + paUInt8 is an unsigned 8 bit format where 128 is considered "ground" + + The paNonInterleaved flag indicates that a multichannel buffer is passed + as a set of non-interleaved pointers. + + @see Pa_OpenStream, Pa_OpenDefaultStream, PaDeviceInfo + @see paFloat32, paInt16, paInt32, paInt24, paInt8 + @see paUInt8, paCustomFormat, paNonInterleaved +*/ +typedef unsigned long PaSampleFormat; + + +#define paFloat32 ((PaSampleFormat) 0x00000001) /**< @see PaSampleFormat */ +#define paInt32 ((PaSampleFormat) 0x00000002) /**< @see PaSampleFormat */ +#define paInt24 ((PaSampleFormat) 0x00000004) /**< Packed 24 bit format. @see PaSampleFormat */ +#define paInt16 ((PaSampleFormat) 0x00000008) /**< @see PaSampleFormat */ +#define paInt8 ((PaSampleFormat) 0x00000010) /**< @see PaSampleFormat */ +#define paUInt8 ((PaSampleFormat) 0x00000020) /**< @see PaSampleFormat */ +#define paCustomFormat ((PaSampleFormat) 0x00010000)/**< @see PaSampleFormat */ + +#define paNonInterleaved ((PaSampleFormat) 0x80000000) + +/** A structure providing information and capabilities of PortAudio devices. + Devices may support input, output or both input and output. +*/ +typedef struct PaDeviceInfo +{ + int structVersion; /* this is struct version 2 */ + const char *name; + PaHostApiIndex hostApi; /* note this is a host API index, not a type id*/ + + int maxInputChannels; + int maxOutputChannels; + + /* Default latency values for interactive performance. */ + PaTime defaultLowInputLatency; + PaTime defaultLowOutputLatency; + /* Default latency values for robust non-interactive applications (eg. playing sound files). */ + PaTime defaultHighInputLatency; + PaTime defaultHighOutputLatency; + + double defaultSampleRate; +} PaDeviceInfo; + + +/** Retrieve a pointer to a PaDeviceInfo structure containing information + about the specified device. + @return A pointer to an immutable PaDeviceInfo structure. If the device + parameter is out of range the function returns NULL. + + @param device A valid device index in the range 0 to (Pa_GetDeviceCount()-1) + + @note PortAudio manages the memory referenced by the returned pointer, + the client must not manipulate or free the memory. The pointer is only + guaranteed to be valid between calls to Pa_Initialize() and Pa_Terminate(). + + @see PaDeviceInfo, PaDeviceIndex +*/ +const PaDeviceInfo* Pa_GetDeviceInfo( PaDeviceIndex device ); + + +/** Parameters for one direction (input or output) of a stream. +*/ +typedef struct PaStreamParameters +{ + /** A valid device index in the range 0 to (Pa_GetDeviceCount()-1) + specifying the device to be used or the special constant + paUseHostApiSpecificDeviceSpecification which indicates that the actual + device(s) to use are specified in hostApiSpecificStreamInfo. + This field must not be set to paNoDevice. + */ + PaDeviceIndex device; + + /** The number of channels of sound to be delivered to the + stream callback or accessed by Pa_ReadStream() or Pa_WriteStream(). + It can range from 1 to the value of maxInputChannels in the + PaDeviceInfo record for the device specified by the device parameter. + */ + int channelCount; + + /** The sample format of the buffer provided to the stream callback, + a_ReadStream() or Pa_WriteStream(). It may be any of the formats described + by the PaSampleFormat enumeration. + */ + PaSampleFormat sampleFormat; + + /** The desired latency in seconds. Where practical, implementations should + configure their latency based on these parameters, otherwise they may + choose the closest viable latency instead. Unless the suggested latency + is greater than the absolute upper limit for the device implementations + shouldround the suggestedLatency up to the next practial value - ie to + provide an equal or higher latency than suggestedLatency whereever possibe. + Actual latency values for an open stream may be retrieved using the + inputLatency and outputLatency fields of the PaStreamInfo structure + returned by Pa_GetStreamInfo(). + @see default*Latency in PaDeviceInfo, *Latency in PaStreamInfo + */ + PaTime suggestedLatency; + + /** An optional pointer to a host api specific data structure + containing additional information for device setup and/or stream processing. + hostApiSpecificStreamInfo is never required for correct operation, + if not used it should be set to NULL. + */ + void *hostApiSpecificStreamInfo; + +} PaStreamParameters; + + +/** Return code for Pa_IsFormatSupported indicating success. */ +#define paFormatIsSupported (0) + +/** Determine whether it would be possible to open a stream with the specified + parameters. + + @param inputParameters A structure that describes the input parameters used to + open a stream. The suggestedLatency field is ignored. See PaStreamParameters + for a description of these parameters. inputParameters must be NULL for + output-only streams. + + @param outputParameters A structure that describes the output parameters used + to open a stream. The suggestedLatency field is ignored. See PaStreamParameters + for a description of these parameters. outputParameters must be NULL for + input-only streams. + + @param sampleRate The required sampleRate. For full-duplex streams it is the + sample rate for both input and output + + @return Returns 0 if the format is supported, and an error code indicating why + the format is not supported otherwise. The constant paFormatIsSupported is + provided to compare with the return value for success. + + @see paFormatIsSupported, PaStreamParameters +*/ +PaError Pa_IsFormatSupported( const PaStreamParameters *inputParameters, + const PaStreamParameters *outputParameters, + double sampleRate ); + + + +/* Streaming types and functions */ + + +/** + A single PaStream can provide multiple channels of real-time + streaming audio input and output to a client application. A stream + provides access to audio hardware represented by one or more + PaDevices. Depending on the underlying Host API, it may be possible + to open multiple streams using the same device, however this behavior + is implementation defined. Portable applications should assume that + a PaDevice may be simultaneously used by at most one PaStream. + + Pointers to PaStream objects are passed between PortAudio functions that + operate on streams. + + @see Pa_OpenStream, Pa_OpenDefaultStream, Pa_OpenDefaultStream, Pa_CloseStream, + Pa_StartStream, Pa_StopStream, Pa_AbortStream, Pa_IsStreamActive, + Pa_GetStreamTime, Pa_GetStreamCpuLoad + +*/ +typedef void PaStream; + + +/** Can be passed as the framesPerBuffer parameter to Pa_OpenStream() + or Pa_OpenDefaultStream() to indicate that the stream callback will + accept buffers of any size. +*/ +#define paFramesPerBufferUnspecified (0) + + +/** Flags used to control the behavior of a stream. They are passed as + parameters to Pa_OpenStream or Pa_OpenDefaultStream. Multiple flags may be + ORed together. + + @see Pa_OpenStream, Pa_OpenDefaultStream + @see paNoFlag, paClipOff, paDitherOff, paNeverDropInput, + paPrimeOutputBuffersUsingStreamCallback, paPlatformSpecificFlags +*/ +typedef unsigned long PaStreamFlags; + +/** @see PaStreamFlags */ +#define paNoFlag ((PaStreamFlags) 0) + +/** Disable default clipping of out of range samples. + @see PaStreamFlags +*/ +#define paClipOff ((PaStreamFlags) 0x00000001) + +/** Disable default dithering. + @see PaStreamFlags +*/ +#define paDitherOff ((PaStreamFlags) 0x00000002) + +/** Flag requests that where possible a full duplex stream will not discard + overflowed input samples without calling the stream callback. This flag is + only valid for full duplex callback streams and only when used in combination + with the paFramesPerBufferUnspecified (0) framesPerBuffer parameter. Using + this flag incorrectly results in a paInvalidFlag error being returned from + Pa_OpenStream and Pa_OpenDefaultStream. + + @see PaStreamFlags, paFramesPerBufferUnspecified +*/ +#define paNeverDropInput ((PaStreamFlags) 0x00000004) + +/** Call the stream callback to fill initial output buffers, rather than the + default behavior of priming the buffers with zeros (silence). This flag has + no effect for input-only and blocking read/write streams. + + @see PaStreamFlags +*/ +#define paPrimeOutputBuffersUsingStreamCallback ((PaStreamFlags) 0x00000008) + +/** A mask specifying the platform specific bits. + @see PaStreamFlags +*/ +#define paPlatformSpecificFlags ((PaStreamFlags)0xFFFF0000) + +/** + Timing information for the buffers passed to the stream callback. +*/ +typedef struct PaStreamCallbackTimeInfo{ + PaTime inputBufferAdcTime; + PaTime currentTime; + PaTime outputBufferDacTime; +} PaStreamCallbackTimeInfo; + + +/** + Flag bit constants for the statusFlags to PaStreamCallback. + + @see paInputUnderflow, paInputOverflow, paOutputUnderflow, paOutputOverflow, + paPrimingOutput +*/ +typedef unsigned long PaStreamCallbackFlags; + +/** In a stream opened with paFramesPerBufferUnspecified, indicates that + input data is all silence (zeros) because no real data is available. In a + stream opened without paFramesPerBufferUnspecified, it indicates that one or + more zero samples have been inserted into the input buffer to compensate + for an input underflow. + @see PaStreamCallbackFlags +*/ +#define paInputUnderflow ((PaStreamCallbackFlags) 0x00000001) + +/** In a stream opened with paFramesPerBufferUnspecified, indicates that data + prior to the first sample of the input buffer was discarded due to an + overflow, possibly because the stream callback is using too much CPU time. + Otherwise indicates that data prior to one or more samples in the + input buffer was discarded. + @see PaStreamCallbackFlags +*/ +#define paInputOverflow ((PaStreamCallbackFlags) 0x00000002) + +/** Indicates that output data (or a gap) was inserted, possibly because the + stream callback is using too much CPU time. + @see PaStreamCallbackFlags +*/ +#define paOutputUnderflow ((PaStreamCallbackFlags) 0x00000004) + +/** Indicates that output data will be discarded because no room is available. + @see PaStreamCallbackFlags +*/ +#define paOutputOverflow ((PaStreamCallbackFlags) 0x00000008) + +/** Some of all of the output data will be used to prime the stream, input + data may be zero. + @see PaStreamCallbackFlags +*/ +#define paPrimingOutput ((PaStreamCallbackFlags) 0x00000010) + +/** + Allowable return values for the PaStreamCallback. + @see PaStreamCallback +*/ +typedef enum PaStreamCallbackResult +{ + paContinue=0, + paComplete=1, + paAbort=2 +} PaStreamCallbackResult; + + +/** + Functions of type PaStreamCallback are implemented by PortAudio clients. + They consume, process or generate audio in response to requests from an + active PortAudio stream. + + @param input and @param output are arrays of interleaved samples, + the format, packing and number of channels used by the buffers are + determined by parameters to Pa_OpenStream(). + + @param frameCount The number of sample frames to be processed by + the stream callback. + + @param timeInfo The time in seconds when the first sample of the input + buffer was received at the audio input, the time in seconds when the first + sample of the output buffer will begin being played at the audio output, and + the time in seconds when the stream callback was called. + See also Pa_GetStreamTime() + + @param statusFlags Flags indicating whether input and/or output buffers + have been inserted or will be dropped to overcome underflow or overflow + conditions. + + @param userData The value of a user supplied pointer passed to + Pa_OpenStream() intended for storing synthesis data etc. + + @return + The stream callback should return one of the values in the + PaStreamCallbackResult enumeration. To ensure that the callback continues + to be called, it should return paContinue (0). Either paComplete or paAbort + can be returned to finish stream processing, after either of these values is + returned the callback will not be called again. If paAbort is returned the + stream will finish as soon as possible. If paComplete is returned, the stream + will continue until all buffers generated by the callback have been played. + This may be useful in applications such as soundfile players where a specific + duration of output is required. However, it is not necessary to utilise this + mechanism as Pa_StopStream(), Pa_AbortStream() or Pa_CloseStream() can also + be used to stop the stream. The callback must always fill the entire output + buffer irrespective of its return value. + + @see Pa_OpenStream, Pa_OpenDefaultStream + + @note With the exception of Pa_GetStreamCpuLoad() it is not permissable to call + PortAudio API functions from within the stream callback. +*/ +typedef int PaStreamCallback( + const void *input, void *output, + unsigned long frameCount, + const PaStreamCallbackTimeInfo* timeInfo, + PaStreamCallbackFlags statusFlags, + void *userData ); + + +/** Opens a stream for either input, output or both. + + @param stream The address of a PaStream pointer which will receive + a pointer to the newly opened stream. + + @param inputParameters A structure that describes the input parameters used by + the opened stream. See PaStreamParameters for a description of these parameters. + inputParameters must be NULL for output-only streams. + + @param outputParameters A structure that describes the output parameters used by + the opened stream. See PaStreamParameters for a description of these parameters. + outputParameters must be NULL for input-only streams. + + @param sampleRate The desired sampleRate. For full-duplex streams it is the + sample rate for both input and output + + @param framesPerBuffer The number of frames passed to the stream callback + function, or the preferred block granularity for a blocking read/write stream. + The special value paFramesPerBufferUnspecified (0) may be used to request that + the stream callback will recieve an optimal (and possibly varying) number of + frames based on host requirements and the requested latency settings. + Note: With some host APIs, the use of non-zero framesPerBuffer for a callback + stream may introduce an additional layer of buffering which could introduce + additional latency. PortAudio guarantees that the additional latency + will be kept to the theoretical minimum however, it is strongly recommended + that a non-zero framesPerBuffer value only be used when your algorithm + requires a fixed number of frames per stream callback. + + @param streamFlags Flags which modify the behaviour of the streaming process. + This parameter may contain a combination of flags ORed together. Some flags may + only be relevant to certain buffer formats. + + @param streamCallback A pointer to a client supplied function that is responsible + for processing and filling input and output buffers. If this parameter is NULL + the stream will be opened in 'blocking read/write' mode. In blocking mode, + the client can receive sample data using Pa_ReadStream and write sample data + using Pa_WriteStream, the number of samples that may be read or written + without blocking is returned by Pa_GetStreamReadAvailable and + Pa_GetStreamWriteAvailable respectively. + + @param userData A client supplied pointer which is passed to the stream callback + function. It could for example, contain a pointer to instance data necessary + for processing the audio buffers. This parameter is ignored if streamCallback + is NULL. + + @return + Upon success Pa_OpenStream() returns paNoError and places a pointer to a + valid PaStream in the stream argument. The stream is inactive (stopped). + If a call to Pa_OpenStream() fails, a non-zero error code is returned (see + PaError for possible error codes) and the value of stream is invalid. + + @see PaStreamParameters, PaStreamCallback, Pa_ReadStream, Pa_WriteStream, + Pa_GetStreamReadAvailable, Pa_GetStreamWriteAvailable +*/ +PaError Pa_OpenStream( PaStream** stream, + const PaStreamParameters *inputParameters, + const PaStreamParameters *outputParameters, + double sampleRate, + unsigned long framesPerBuffer, + PaStreamFlags streamFlags, + PaStreamCallback *streamCallback, + void *userData ); + + +/** A simplified version of Pa_OpenStream() that opens the default input + and/or output devices. + + @param stream The address of a PaStream pointer which will receive + a pointer to the newly opened stream. + + @param numInputChannels The number of channels of sound that will be supplied + to the stream callback or returned by Pa_ReadStream. It can range from 1 to + the value of maxInputChannels in the PaDeviceInfo record for the default input + device. If 0 the stream is opened as an output-only stream. + + @param numOutputChannels The number of channels of sound to be delivered to the + stream callback or passed to Pa_WriteStream. It can range from 1 to the value + of maxOutputChannels in the PaDeviceInfo record for the default output dvice. + If 0 the stream is opened as an output-only stream. + + @param sampleFormat The sample format of both the input and output buffers + provided to the callback or passed to and from Pa_ReadStream and Pa_WriteStream. + sampleFormat may be any of the formats described by the PaSampleFormat + enumeration. + + @param sampleRate Same as Pa_OpenStream parameter of the same name. + @param framesPerBuffer Same as Pa_OpenStream parameter of the same name. + @param streamCallback Same as Pa_OpenStream parameter of the same name. + @param userData Same as Pa_OpenStream parameter of the same name. + + @return As for Pa_OpenStream + + @see Pa_OpenStream, PaStreamCallback +*/ +PaError Pa_OpenDefaultStream( PaStream** stream, + int numInputChannels, + int numOutputChannels, + PaSampleFormat sampleFormat, + double sampleRate, + unsigned long framesPerBuffer, + PaStreamCallback *streamCallback, + void *userData ); + + +/** Closes an audio stream. If the audio stream is active it + discards any pending buffers as if Pa_AbortStream() had been called. +*/ +PaError Pa_CloseStream( PaStream *stream ); + + +/** Functions of type PaStreamFinishedCallback are implemented by PortAudio + clients. They can be registered with a stream using the Pa_SetStreamFinishedCallback + function. Once registered they are called when the stream becomes inactive + (ie once a call to Pa_StopStream() will not block). + A stream will become inactive after the stream callback returns non-zero, + or when Pa_StopStream or Pa_AbortStream is called. For a stream providing audio + output, if the stream callback returns paComplete, or Pa_StopStream is called, + the stream finished callback will not be called until all generated sample data + has been played. + + @param userData The userData parameter supplied to Pa_OpenStream() + + @see Pa_SetStreamFinishedCallback +*/ +typedef void PaStreamFinishedCallback( void *userData ); + + +/** Register a stream finished callback function which will be called when the + stream becomes inactive. See the description of PaStreamFinishedCallback for + further details about when the callback will be called. + + @param stream a pointer to a PaStream that is in the stopped state - if the + stream is not stopped, the stream's finished callback will remain unchanged + and an error code will be returned. + + @param streamFinishedCallback a pointer to a function with the same signature + as PaStreamFinishedCallback, that will be called when the stream becomes + inactive. Passing NULL for this parameter will un-register a previously + registered stream finished callback function. + + @return on success returns paNoError, otherwise an error code indicating the cause + of the error. + + @see PaStreamFinishedCallback +*/ +PaError Pa_SetStreamFinishedCallback( PaStream *stream, PaStreamFinishedCallback* streamFinishedCallback ); + + +/** Commences audio processing. +*/ +PaError Pa_StartStream( PaStream *stream ); + + +/** Terminates audio processing. It waits until all pending + audio buffers have been played before it returns. +*/ +PaError Pa_StopStream( PaStream *stream ); + + +/** Terminates audio processing immediately without waiting for pending + buffers to complete. +*/ +PaError Pa_AbortStream( PaStream *stream ); + + +/** Determine whether the stream is stopped. + A stream is considered to be stopped prior to a successful call to + Pa_StartStream and after a successful call to Pa_StopStream or Pa_AbortStream. + If a stream callback returns a value other than paContinue the stream is NOT + considered to be stopped. + + @return Returns one (1) when the stream is stopped, zero (0) when + the stream is running or, a PaErrorCode (which are always negative) if + PortAudio is not initialized or an error is encountered. + + @see Pa_StopStream, Pa_AbortStream, Pa_IsStreamActive +*/ +PaError Pa_IsStreamStopped( PaStream *stream ); + + +/** Determine whether the stream is active. + A stream is active after a successful call to Pa_StartStream(), until it + becomes inactive either as a result of a call to Pa_StopStream() or + Pa_AbortStream(), or as a result of a return value other than paContinue from + the stream callback. In the latter case, the stream is considered inactive + after the last buffer has finished playing. + + @return Returns one (1) when the stream is active (ie playing or recording + audio), zero (0) when not playing or, a PaErrorCode (which are always negative) + if PortAudio is not initialized or an error is encountered. + + @see Pa_StopStream, Pa_AbortStream, Pa_IsStreamStopped +*/ +PaError Pa_IsStreamActive( PaStream *stream ); + + + +/** A structure containing unchanging information about an open stream. + @see Pa_GetStreamInfo +*/ + +typedef struct PaStreamInfo +{ + /** this is struct version 1 */ + int structVersion; + + /** The input latency of the stream in seconds. This value provides the most + accurate estimate of input latency available to the implementation. It may + differ significantly from the suggestedLatency value passed to Pa_OpenStream(). + The value of this field will be zero (0.) for output-only streams. + @see PaTime + */ + PaTime inputLatency; + + /** The output latency of the stream in seconds. This value provides the most + accurate estimate of output latency available to the implementation. It may + differ significantly from the suggestedLatency value passed to Pa_OpenStream(). + The value of this field will be zero (0.) for input-only streams. + @see PaTime + */ + PaTime outputLatency; + + /** The sample rate of the stream in Hertz (samples per second). In cases + where the hardware sample rate is inaccurate and PortAudio is aware of it, + the value of this field may be different from the sampleRate parameter + passed to Pa_OpenStream(). If information about the actual hardware sample + rate is not available, this field will have the same value as the sampleRate + parameter passed to Pa_OpenStream(). + */ + double sampleRate; + +} PaStreamInfo; + + +/** Retrieve a pointer to a PaStreamInfo structure containing information + about the specified stream. + @return A pointer to an immutable PaStreamInfo structure. If the stream + parameter invalid, or an error is encountered, the function returns NULL. + + @param stream A pointer to an open stream previously created with Pa_OpenStream. + + @note PortAudio manages the memory referenced by the returned pointer, + the client must not manipulate or free the memory. The pointer is only + guaranteed to be valid until the specified stream is closed. + + @see PaStreamInfo +*/ +const PaStreamInfo* Pa_GetStreamInfo( PaStream *stream ); + + +/** Determine the current time for the stream according to the same clock used + to generate buffer timestamps. This time may be used for syncronising other + events to the audio stream, for example synchronizing audio to MIDI. + + @return The stream's current time in seconds, or 0 if an error occurred. + + @see PaTime, PaStreamCallback +*/ +PaTime Pa_GetStreamTime( PaStream *stream ); + + +/** Retrieve CPU usage information for the specified stream. + The "CPU Load" is a fraction of total CPU time consumed by a callback stream's + audio processing routines including, but not limited to the client supplied + stream callback. This function does not work with blocking read/write streams. + + This function may be called from the stream callback function or the + application. + + @return + A floating point value, typically between 0.0 and 1.0, where 1.0 indicates + that the stream callback is consuming the maximum number of CPU cycles possible + to maintain real-time operation. A value of 0.5 would imply that PortAudio and + the stream callback was consuming roughly 50% of the available CPU time. The + return value may exceed 1.0. A value of 0.0 will always be returned for a + blocking read/write stream, or if an error occurrs. +*/ +double Pa_GetStreamCpuLoad( PaStream* stream ); + + +/** Read samples from an input stream. The function doesn't return until + the entire buffer has been filled - this may involve waiting for the operating + system to supply the data. + + @param stream A pointer to an open stream previously created with Pa_OpenStream. + + @param buffer A pointer to a buffer of sample frames. The buffer contains + samples in the format specified by the inputParameters->sampleFormat field + used to open the stream, and the number of channels specified by + inputParameters->numChannels. If non-interleaved samples were requested, + buffer is a pointer to the first element of an array of non-interleaved + buffer pointers, one for each channel. + + @param frames The number of frames to be read into buffer. This parameter + is not constrained to a specific range, however high performance applications + will want to match this parameter to the framesPerBuffer parameter used + when opening the stream. + + @return On success PaNoError will be returned, or PaInputOverflowed if input + data was discarded by PortAudio after the previous call and before this call. +*/ +PaError Pa_ReadStream( PaStream* stream, + void *buffer, + unsigned long frames ); + + +/** Write samples to an output stream. This function doesn't return until the + entire buffer has been consumed - this may involve waiting for the operating + system to consume the data. + + @param stream A pointer to an open stream previously created with Pa_OpenStream. + + @param buffer A pointer to a buffer of sample frames. The buffer contains + samples in the format specified by the outputParameters->sampleFormat field + used to open the stream, and the number of channels specified by + outputParameters->numChannels. If non-interleaved samples were requested, + buffer is a pointer to the first element of an array of non-interleaved + buffer pointers, one for each channel. + + @param frames The number of frames to be written from buffer. This parameter + is not constrained to a specific range, however high performance applications + will want to match this parameter to the framesPerBuffer parameter used + when opening the stream. + + @return On success PaNoError will be returned, or paOutputUnderflowed if + additional output data was inserted after the previous call and before this + call. +*/ +PaError Pa_WriteStream( PaStream* stream, + const void *buffer, + unsigned long frames ); + + +/** Retrieve the number of frames that can be read from the stream without + waiting. + + @return Returns a non-negative value representing the maximum number of frames + that can be read from the stream without blocking or busy waiting or, a + PaErrorCode (which are always negative) if PortAudio is not initialized or an + error is encountered. +*/ +signed long Pa_GetStreamReadAvailable( PaStream* stream ); + + +/** Retrieve the number of frames that can be written to the stream without + waiting. + + @return Returns a non-negative value representing the maximum number of frames + that can be written to the stream without blocking or busy waiting or, a + PaErrorCode (which are always negative) if PortAudio is not initialized or an + error is encountered. +*/ +signed long Pa_GetStreamWriteAvailable( PaStream* stream ); + + +/* Miscellaneous utilities */ + + +/** Retrieve the size of a given sample format in bytes. + + @return The size in bytes of a single sample in the specified format, + or paSampleFormatNotSupported if the format is not supported. +*/ +PaError Pa_GetSampleSize( PaSampleFormat format ); + + +/** Put the caller to sleep for at least 'msec' milliseconds. This function is + provided only as a convenience for authors of portable code (such as the tests + and examples in the PortAudio distribution.) + + The function may sleep longer than requested so don't rely on this for accurate + musical timing. +*/ +void Pa_Sleep( long msec ); + + + +#ifdef __cplusplus +} +#endif /* __cplusplus */ +#endif /* PORTAUDIO_H */ diff --git a/wsjtx_lib/lib/ft2/ptt.c b/wsjtx_lib/lib/ft2/ptt.c new file mode 100644 index 0000000..fdda4ff --- /dev/null +++ b/wsjtx_lib/lib/ft2/ptt.c @@ -0,0 +1,58 @@ +#include +#include + +int ptt_(int *nport, int *ntx, int *ndtr, int *iptt) +{ + static HANDLE hFile; + static int open=0, nhold=0; + char s[10]; + int i3,i4,i5,i6,i9,i00; + + if(*nport==0) { + *iptt=*ntx; + return(0); + } + + nhold=0; + if(*nport>100) nhold=1; + + if(*ntx && (!open)) { + sprintf(s,"\\\\.\\COM%d",*nport%100); + hFile=CreateFile( + TEXT(s), + GENERIC_WRITE, + 0, + NULL, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + NULL + ); + if(hFile==INVALID_HANDLE_VALUE) { + printf("PTT: Cannot open COM port %d.\n",*nport%100); + return(-1); + } + open=1; + } + + if(*ntx && open) { + if(*ndtr) + EscapeCommFunction(hFile,5); //set DTR + else + EscapeCommFunction(hFile,3); //set RTS + *iptt=1; + } + + else { + if(*ndtr) + EscapeCommFunction(hFile,6); //clear DTR + else + EscapeCommFunction(hFile,4); //clear RTS + EscapeCommFunction(hFile,9); //clear BREAK + if(nhold==0) { + i00=CloseHandle(hFile); + open=0; + } + *iptt=0; + } + return(0); +} diff --git a/wsjtx_lib/lib/ft2/ptt_unix.c b/wsjtx_lib/lib/ft2/ptt_unix.c new file mode 100644 index 0000000..b163806 --- /dev/null +++ b/wsjtx_lib/lib/ft2/ptt_unix.c @@ -0,0 +1,341 @@ +#include +#include +#include +#include +#include +#include +//#include +//#include +//#include +//#include +//#include + +int lp_reset (int fd); +int lp_ptt (int fd, int onoff); + +#ifdef HAVE_SYS_STAT_H +# include +#endif +#if (defined(__unix__) || defined(unix)) && !defined(USG) +# include +#endif + +#include +/* parport functions */ + +int dev_is_parport(int fd); +int ptt_parallel(int fd, int *ntx, int *iptt); +int ptt_serial(int fd, int *ntx, int *iptt); + +int fd=-1; /* Used for both serial and parallel */ + +/* + * ptt_ + * + * generic unix PTT routine called from Fortran + * + * Inputs + * unused Unused, to satisfy old windows calling convention + * ptt_port device name serial or parallel + * ntx pointer to fortran command on or off + * iptt pointer to fortran command status on or off + * Returns - non 0 if error +*/ + +/* Tiny state machine */ +#define STATE_PORT_CLOSED 0 +#define STATE_PORT_OPEN_PARALLEL 1 +#define STATE_PORT_OPEN_SERIAL 2 + +int +ptt_(int *unused, char *ptt_port, int *ntx, int *ndtr, int *iptt) +{ + static int state=0; + char *p; + + /* In the very unlikely event of a NULL pointer, just return. + * Yes, I realise this should not be possible in WSJT. + */ + if (ptt_port == NULL) { + *iptt = *ntx; + return (0); + } + + switch (state) { + case STATE_PORT_CLOSED: + + /* Remove trailing ' ' */ + if ((p = strchr(ptt_port, ' ')) != NULL) + *p = '\0'; + + /* If all that is left is a '\0' then also just return */ + if (*ptt_port == '\0') { + *iptt = *ntx; + return(0); + } + + if ((fd = open(ptt_port, O_RDWR|O_NONBLOCK)) < 0) { + fprintf(stderr, "Can't open %s.\n", ptt_port); + return (1); + } + + if (dev_is_parport(fd)) { + state = STATE_PORT_OPEN_PARALLEL; + lp_reset(fd); + ptt_parallel(fd, ntx, iptt); + } else { + state = STATE_PORT_OPEN_SERIAL; + ptt_serial(fd, ntx, iptt); + } + break; + + case STATE_PORT_OPEN_PARALLEL: + ptt_parallel(fd, ntx, iptt); + break; + + case STATE_PORT_OPEN_SERIAL: + ptt_serial(fd, ntx, iptt); + break; + + default: + close(fd); + fd = -1; + state = STATE_PORT_CLOSED; + break; + } + return(0); +} + +/* + * ptt_serial + * + * generic serial unix PTT routine called indirectly from Fortran + * + * fd - already opened file descriptor + * ntx - pointer to fortran command on or off + * iptt - pointer to fortran command status on or off + */ + +int +ptt_serial(int fd, int *ntx, int *iptt) +{ + int control = TIOCM_RTS | TIOCM_DTR; + + if(*ntx) { + ioctl(fd, TIOCMBIS, &control); /* Set DTR and RTS */ + *iptt = 1; + } else { + ioctl(fd, TIOCMBIC, &control); + *iptt = 0; + } + return(0); +} + + +/* parport functions */ + +/* + * dev_is_parport(fd): + * + * inputs - Already open fd + * output - 1 if parallel port, 0 if not + * side effects - Unfortunately, this is platform specific. + */ + +#if defined(HAVE_LINUX_PPDEV_H) /* Linux (ppdev) */ + +int +dev_is_parport(int fd) +{ + struct stat st; + int m; + + if ((fstat(fd, &st) == -1) || + ((st.st_mode & S_IFMT) != S_IFCHR) || + (ioctl(fd, PPGETMODE, &m) == -1)) + return(0); + + return(1); +} + +#elif defined(HAVE_DEV_PPBUS_PPI_H) /* FreeBSD (ppbus/ppi) */ + +int +dev_is_parport(int fd) +{ + struct stat st; + unsigned char c; + + if ((fstat(fd, &st) == -1) || + ((st.st_mode & S_IFMT) != S_IFCHR) || + (ioctl(fd, PPISSTATUS, &c) == -1)) + return(0); + + return(1); +} + +#else /* Fallback (nothing) */ + +int +dev_is_parport(int fd) +{ + return(0); +} + +#endif +/* Linux wrapper around PPFCONTROL */ +#ifdef HAVE_LINUX_PPDEV_H +static void +parport_control (int fd, unsigned char controlbits, int values) +{ + struct ppdev_frob_struct frob; + frob.mask = controlbits; + frob.val = values; + + if (ioctl (fd, PPFCONTROL, &frob) == -1) + { + fprintf(stderr, "Parallel port PPFCONTROL"); + exit (1); + } +} +#endif + +/* FreeBSD wrapper around PPISCTRL */ +#ifdef HAVE_DEV_PPBUS_PPI_H +static void +parport_control (int fd, unsigned char controlbits, int values) +{ + unsigned char val; + + if (ioctl (fd, PPIGCTRL, &val) == -1) + { + fprintf(stderr, "Parallel port PPIGCTRL"); + exit (1); + } + + val &= ~controlbits; + val |= values; + + if (ioctl (fd, PPISCTRL, &val) == -1) + { + fprintf(stderr, "Parallel port PPISCTRL"); + exit (1); + } +} +#endif + +/* Initialise a parallel port, given open fd */ +int +lp_init (int fd) +{ +#ifdef HAVE_LINUX_PPDEV_H + int mode; +#endif + +#ifdef HAVE_LINUX_PPDEV_H + mode = PARPORT_MODE_PCSPP; + + if (ioctl (fd, PPSETMODE, &mode) == -1) + { + fprintf(stderr, "Setting parallel port mode"); + close (fd); + return(-1); + } + + if (ioctl (fd, PPEXCL, NULL) == -1) + { + fprintf(stderr, "Parallel port is already in use.\n"); + close (fd); + return(-1); + } + if (ioctl (fd, PPCLAIM, NULL) == -1) + { + fprintf(stderr, "Claiming parallel port.\n"); + fprintf(stderr, "HINT: did you unload the lp kernel module?"); + close (fd); + return(-1); + } + + /* Enable CW & PTT - /STROBE bit (pin 1) */ + parport_control (fd, PARPORT_CONTROL_STROBE, PARPORT_CONTROL_STROBE); +#endif +#ifdef HAVE_DEV_PPBUS_PPI_H + parport_control (fd, STROBE, STROBE); +#endif + lp_reset (fd); + return(0); +} + +/* release ppdev and close port */ +int +lp_free (int fd) +{ +#ifdef HAVE_LINUX_PPDEV_H + lp_reset (fd); + + /* Disable CW & PTT - /STROBE bit (pin 1) */ + parport_control (fd, PARPORT_CONTROL_STROBE, 0); + + ioctl (fd, PPRELEASE); +#endif +#ifdef HAVE_DEV_PPBUS_PPI_H + /* Disable CW & PTT - /STROBE bit (pin 1) */ + parport_control (fd, STROBE, 0); +#endif + close (fd); + return(0); +} + +/* set to a known state */ +int +lp_reset (int fd) +{ +#if defined (HAVE_LINUX_PPDEV_H) || defined (HAVE_DEV_PPBUS_PPI_H) + lp_ptt (fd, 0); +#endif + return(0); +} + +/* SSB PTT keying - /INIT bit (pin 16) (inverted) */ +int +lp_ptt (int fd, int onoff) +{ +#ifdef HAVE_LINUX_PPDEV_H + if (onoff == 1) + parport_control (fd, PARPORT_CONTROL_INIT, + PARPORT_CONTROL_INIT); + else + parport_control (fd, PARPORT_CONTROL_INIT, 0); +#endif +#ifdef HAVE_DEV_PPBUS_PPI_H + if (onoff == 1) + parport_control (fd, nINIT, + nINIT); + else + parport_control (fd, nINIT, 0); +#endif + return(0); +} + +/* + * ptt_parallel + * + * generic parallel unix PTT routine called indirectly from Fortran + * + * fd - already opened file descriptor + * ntx - pointer to fortran command on or off + * iptt - pointer to fortran command status on or off + */ + +int +ptt_parallel(int fd, int *ntx, int *iptt) +{ + if(*ntx) { + lp_ptt(fd, 1); + *iptt=1; + } else { + lp_ptt(fd, 0); + *iptt=0; + } + return(0); +} diff --git a/wsjtx_lib/lib/ft4/clockit.f90 b/wsjtx_lib/lib/ft4/clockit.f90 new file mode 100644 index 0000000..eb3e7d8 --- /dev/null +++ b/wsjtx_lib/lib/ft4/clockit.f90 @@ -0,0 +1,111 @@ +subroutine clockit(dname,k) + +! Times procedure number n between a call with k=0 (tstart) and with +! k=1 (tstop). Accumulates sums of these times in array ut (user time). +! Also traces all calls (for debugging purposes) if limtrace.gt.0 + + character*8 dname,name(50),space,ename + character*16 sname + character*512 data_dir,fname + logical first,on(50) + real ut(50),ut0(50),dut(50),tt(2) + integer ncall(50),nlevel(50),nparent(50) + integer onlevel(0:10) + data first/.true./,eps/0.000001/,ntrace/0/ + data level/0/,nmax/0/,space/' '/ + data limtrace/0/,lu/29/,ntimer/1/ +! data limtrace/1000000/,lu/29/,ntimer/1/ + save + + if(ntimer.eq.0) return + if(lu.lt.1) lu=6 + if(k.gt.1) go to 40 !Check for "all done" (k>1) + onlevel(0)=0 + + do n=1,nmax !Check for existing name + if(name(n).eq.dname) go to 20 + enddo + + nmax=nmax+1 !This is a new one + n=nmax + ncall(n)=0 + on(n)=.false. + ut(n)=eps + name(n)=dname + +20 if(k.eq.0) then !Get start times (k=0) + if(on(n)) print*,'Error in timer: ',dname,' already on.' + level=level+1 !Increment the level + on(n)=.true. + ut0(n)=etime(tt) + ncall(n)=ncall(n)+1 + if(ncall(n).gt.1.and.nlevel(n).ne.level) then + nlevel(n)=-1 + else + nlevel(n)=level + endif + nparent(n)=onlevel(level-1) + onlevel(level)=n + + else if(k.eq.1) then !Get stop times and accumulate sums. (k=1) + if(on(n)) then + on(n)=.false. + ut1=etime(tt) + ut(n)=ut(n)+ut1-ut0(n) + endif + level=level-1 + endif + + ntrace=ntrace+1 + if(ntrace.lt.limtrace) write(28,1020) ntrace,dname,k,level,nparent(n) +1020 format(i8,': ',a8,3i5) + return + +! Write out the timer statistics + +40 open(lu,file=trim(fname),status='unknown') + write(lu,1040) +1040 format(/' name time frac dtime', & + ' dfrac calls level parent'/73('-')) + + if(k.gt.100) then + ndiv=k-100 + do i=1,nmax + ncall(i)=ncall(i)/ndiv + ut(i)=ut(i)/ndiv + enddo + endif + + total=ut(1) + sum=0. + sumf=0. + do i=1,nmax + dut(i)=ut(i) + do j=i,nmax + if(nparent(j).eq.i) dut(i)=dut(i)-ut(j) + enddo + utf=ut(i)/total + dutf=dut(i)/total + sum=sum+dut(i) + sumf=sumf+dutf + kk=nlevel(i) + sname=space(1:kk)//name(i)//space(1:8-kk) + ename=space + if(i.ge.2) ename=name(nparent(i)) + write(lu,1060) float(i),sname,ut(i),utf,dut(i),dutf, & + ncall(i),nlevel(i),ename +1060 format(f4.0,a16,2(f10.2,f6.2),i7,i5,2x,a8) + enddo + + write(lu,1070) sum,sumf +1070 format(/36x,f10.2,f6.2) + close(lu) + return + + entry clockit2(data_dir) + l1=index(data_dir,char(0))-1 + if(l1.ge.1) data_dir(l1+1:l1+1)='/' + fname=data_dir(1:l1+1)//'clockit.out' + return + +end subroutine clockit diff --git a/wsjtx_lib/lib/ft4/ft4_baseline.f90 b/wsjtx_lib/lib/ft4/ft4_baseline.f90 new file mode 100644 index 0000000..753ee32 --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4_baseline.f90 @@ -0,0 +1,49 @@ +subroutine ft4_baseline(s,nfa,nfb,sbase) + +! Fit baseline to spectrum +! Input: s(npts) Linear scale in power +! Output: sbase(npts) Baseline + + include 'ft4_params.f90' + implicit real*8 (a-h,o-z) + real*4 s(NH1) + real*4 sbase(NH1) + real*4 base + real*8 x(1000),y(1000),a(5) + data nseg/10/,npct/10/ + + df=12000.0/NFFT1 !5.21 Hz + ia=max(nint(200.0/df),nfa) + ib=min(NH1,nfb) + do i=ia,ib + s(i)=10.0*log10(s(i)) !Convert to dB scale + enddo + + nterms=5 + nlen=(ib-ia+1)/nseg !Length of test segment + i0=(ib-ia+1)/2 !Midpoint + k=0 + do n=1,nseg !Loop over all segments + ja=ia + (n-1)*nlen + jb=ja+nlen-1 + call pctile(s(ja),nlen,npct,base) !Find lowest npct of points + do i=ja,jb + if(s(i).le.base) then + if (k.lt.1000) k=k+1 !Save all "lower envelope" points + x(k)=i-i0 + y(k)=s(i) + endif + enddo + enddo + kz=k + a=0. + call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial + do i=ia,ib + t=i-i0 + sbase(i)=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + 0.65 +! write(51,3051) i*df,s(i),sbase(i) +!3051 format(3f12.3) + sbase(i)=10**(sbase(i)/10.0) + enddo + return +end subroutine ft4_baseline diff --git a/wsjtx_lib/lib/ft4/ft4_downsample.f90 b/wsjtx_lib/lib/ft4/ft4_downsample.f90 new file mode 100644 index 0000000..a6305c8 --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4_downsample.f90 @@ -0,0 +1,48 @@ +subroutine ft4_downsample(dd,newdata,f0,c) + + include 'ft4_params.f90' + parameter (NFFT2=NMAX/NDOWN) + real dd(NMAX) + complex c(0:NMAX/NDOWN-1) + complex c1(0:NFFT2-1) + complex cx(0:NMAX/2) + real x(NMAX), window(0:NFFT2-1) + equivalence (x,cx) + logical first, newdata + data first/.true./ + save first,window,x + + df=12000.0/NMAX + baud=12000.0/NSPS + if(first) then + bw_transition = 0.5*baud + bw_flat = 4*baud + iwt = bw_transition / df + iwf = bw_flat / df + pi=4.0*atan(1.0) + window(0:iwt-1) = 0.5*(1+cos(pi*(/(i,i=iwt-1,0,-1)/)/iwt)) + window(iwt:iwt+iwf-1)=1.0 + window(iwt+iwf:2*iwt+iwf-1) = 0.5*(1+cos(pi*(/(i,i=0,iwt-1)/)/iwt)) + window(2*iwt+iwf:)=0.0 + iws = baud / df + window=cshift(window,iws) + first=.false. + endif + + if(newdata) then + x=dd + call four2a(cx,NMAX,1,-1,0) !r2c FFT to freq domain + endif + i0=nint(f0/df) + c1=0. + if(i0.ge.0 .and. i0.le.NMAX/2) c1(0)=cx(i0) + do i=1,NFFT2/2 + if(i0+i.ge.0 .and. i0+i.le.NMAX/2) c1(i)=cx(i0+i) + if(i0-i.ge.0 .and. i0-i.le.NMAX/2) c1(NFFT2-i)=cx(i0-i) + enddo + c1=c1*window/NFFT2 + call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain + c=c1(0:NMAX/NDOWN-1) + + return +end subroutine ft4_downsample diff --git a/wsjtx_lib/lib/ft4/ft4_params.f90 b/wsjtx_lib/lib/ft4/ft4_params.f90 new file mode 100644 index 0000000..f0b03ab --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4_params.f90 @@ -0,0 +1,16 @@ +! FT4 +! LDPC(174,91) code, four 4x4 Costas arrays for sync, ramp-up and ramp-down symbols + +parameter (KK=91) !Information bits (77 + CRC14) +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=576) !Samples per symbol at 12000 S/s +parameter (NZ=NSPS*NN) !Sync and Data samples (59328) +parameter (NZ2=NSPS*NN2) !Total samples in shaped waveform (60480) +parameter (NMAX=21*3456) !Samples in iwave (72576) +parameter (NFFT1=2304, 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=18) !Downsample factor diff --git a/wsjtx_lib/lib/ft4/ft4_testmsg.f90 b/wsjtx_lib/lib/ft4/ft4_testmsg.f90 new file mode 100644 index 0000000..0d700ea --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4_testmsg.f90 @@ -0,0 +1,50 @@ + parameter (MAXTEST=75,NTEST=47) + character*37 testmsg(MAXTEST) + data testmsg(1:NTEST)/ & + "TNX BOB 73 GL", & ! 0.0 + "PA9XYZ 590003 IO91NP", & ! 0.2 + "G4ABC/P R 570007 JO22DB", & ! 0.2 + "K1ABC W9XYZ 6A WI", & ! 0.3 + "W9XYZ K1ABC R 17B EMA", & ! 0.3 + "123456789ABCDEF012", & ! 0.5 + "CQ K1ABC FN42", & ! 1. + "K1ABC W9XYZ EN37", & ! 1. + "W9XYZ K1ABC -11", & ! 1. + "K1ABC W9XYZ R-09", & ! 1. + "W9XYZ K1ABC RRR", & ! 1. + "K1ABC W9XYZ 73", & ! 1. + "K1ABC W9XYZ RR73", & ! 1. + "CQ FD K1ABC FN42", & ! 1. + "CQ TEST K1ABC/R FN42", & ! 1. + "K1ABC/R W9XYZ EN37", & ! 1. + "W9XYZ K1ABC/R R FN42", & ! 1. + "K1ABC/R W9XYZ RR73", & ! 1. + "CQ TEST K1ABC FN42", & ! 1. + "W9XYZ -11", & ! 1. + " W9XYZ R-09", & ! 1. + "CQ W9XYZ EN37", & ! 1. + " W9XYZ -11", & ! 1. + "W9XYZ R-09", & ! 1. + " KA1ABC", & ! 1. + "KA1ABC -11", & ! 1. + " KA1ABC R-17", & ! 1. + " KA1ABC 73", & ! 1. + "CQ G4ABC/P IO91", & ! 2. + "G4ABC/P PA9XYZ JO22", & ! 2. + "PA9XYZ G4ABC/P RR73", & ! 2. + "K1ABC W9XYZ 579 WI", & ! 3. + "W9XYZ K1ABC R 589 MA", & ! 3. + "K1ABC KA0DEF 559 MO", & ! 3. + "TU; KA0DEF K1ABC R 569 MA", & ! 3. + "KA1ABC G3AAA 529 0013", & ! 3. + "TU; G3AAA K1ABC R 559 MA", & ! 3. + "CQ KH1/KH7Z", & ! 4. + "CQ PJ4/K1ABC", & ! 4. + "PJ4/K1ABC ", & ! 4. + " PJ4/K1ABC RRR", & ! 4. + "PJ4/K1ABC 73", & ! 4. + " YW18FIFA", & ! 4. + "YW18FIFA RRR", & ! 4. + " YW18FIFA 73", & ! 4. + "CQ YW18FIFA", & ! 4. + " YW18FIFA RR73"/ diff --git a/wsjtx_lib/lib/ft4/ft4code.f90 b/wsjtx_lib/lib/ft4/ft4code.f90 new file mode 100644 index 0000000..dae5524 --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4code.f90 @@ -0,0 +1,102 @@ +program ft4code + +! Provides examples of message packing, LDPC(174,91) encoding, bit and +! symbol ordering, and other details of the FT8 protocol. + + use packjt77 + include 'ft4_params.f90' !Set various constants + include 'ft4_testmsg.f90' + parameter (NWAVE=NN*NSPS) + + character*37 msg,msgsent + character*77 c77 + character*9 comment + character bad*1,msgtype*18 + integer itone(NN) + integer*1 msgbits(77),rvec(77),codeword(174) + 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/ + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.1 .and. nargs.ne.3) then + print* + print*,'Program ft4code: Provides examples of message packing, ', & + 'LDPC(174,91) encoding,' + print*,'bit and symbol ordering, and other details of the FT4 protocol.' + print* + print*,'Usage: ft4code [-c grid] "message" # Results for specified message' + print*,' ft4code -t # Examples of all message types' + go to 999 + endif + + call getarg(1,msg) !Message to be transmitted + if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-t') then + nmsg=NTEST + else + call fmtmsg(msg,iz) !To upper case; collapse multiple blanks + nmsg=1 + endif + + write(*,1010) +1010 format(4x,'Message',31x,'Decoded',29x,'Err i3.n3'/100('-')) + + do imsg=1,nmsg + if(nmsg.gt.1) msg=testmsg(imsg) + +! Generate msgsent, msgbits, and itone + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + call genft4(msg,0,msgsent,msgbits,itone) + call encode174_91(msgbits,codeword) + msgtype="" + if(i3.eq.0) then + if(n3.eq.0) msgtype="Free text" + if(n3.eq.1) msgtype="DXpedition mode" + if(n3.eq.2) msgtype="EU VHF Contest" + if(n3.eq.3) msgtype="ARRL Field Day" + if(n3.eq.4) msgtype="ARRL Field Day" + if(n3.eq.5) msgtype="Telemetry" + if(n3.ge.6) msgtype="Undefined type" + endif + if(i3.eq.1) msgtype="Standard msg" + if(i3.eq.2) msgtype="EU VHF Contest" + if(i3.eq.3) msgtype="ARRL RTTY Roundup" + if(i3.eq.4) msgtype="Nonstandard calls" + if(i3.eq.5) msgtype="EU VHF Contest" + if(i3.ge.6) msgtype="Undefined msg type" + if(i3.ge.1) n3=-1 + bad=" " + comment=' ' + if(msg.ne.msgsent) bad="*" + if(n3.ge.0) then + write(*,1020) imsg,msg,msgsent,bad,i3,n3,msgtype,comment +1020 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',i1,1x,a18,1x,a9) + else + write(*,1022) imsg,msg,msgsent,bad,i3,msgtype,comment +1022 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',1x,1x,a18,1x,a9) + endif + enddo + + if(nmsg.eq.1) then + write(*,1030) ieor(msgbits,rvec) +1030 format(/'Source-encoded message before scrambling, 77 bits: ',/77i1) + write(*,1032) rvec +1032 format(/'Scrambling vector, 77 bits: ',/77i1) + write(*,1034) msgbits +1034 format(/'Source-encoded message after scrambling, 77 bits:'/77i1) + write(*,1036) codeword(78:91) +1036 format(/'14-bit CRC: ',/14i1) + write(*,1038) codeword(92:174) +1038 format(/'83 Parity bits: ',/83i1) + write(*,1040) 0,itone,0 +1040 format(/'Channel symbols (105 tones):'/ & + 'R Sync',13x,'Data',13x, & + ' Sync',13x,'Data',13x, & + ' Sync',13x,'Data',13x,' Sync R'/ & + i1,1x,4i1,1x,29i1,1x,4i1,1x,29i1,1x,4i1,1x,29i1,1x,4i1,i2) + endif + +999 end program ft4code diff --git a/wsjtx_lib/lib/ft4/ft4sim.f90 b/wsjtx_lib/lib/ft4/ft4sim.f90 new file mode 100644 index 0000000..cef2230 --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4sim.f90 @@ -0,0 +1,125 @@ +program ft4sim + +! Generate simulated signals for experimental "FT4" mode + + use wavhdr + use packjt77 + include 'ft4_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(77) + integer*2 iwave(NMAX) !Generated full-length waveform + integer icos4(4) + data icos4/0,1,3,2/ + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.7) then + print*,'Usage: ft4sim "message" f0 DT fdop del nfiles snr' + print*,'Examples: ft4sim "CQ W9XYZ EN37" 1500 0.0 0.1 1.0 10 -15' + print*,' ft4sim "K1ABC W9XYZ R 539 WI" 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 + + ! Source-encode, then get itone() + i3=-1 + n3=-1 + call pack77(msg37,i3,n3,c77) + read(c77,'(77i1)') msgbits + call genft4(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(*,'(77i1)') msgbits + endif + write(*,*) + write(*,'(a17)') 'Channel symbols: ' + write(*,'(76i1)') itone + write(*,*) + + call sgran() + + fsample=12000.0 + icmplx=1 + call gen_ft4wave(itone,NN,NSPS,fsample,f0,c0,wave,icmplx,NMAX) + + k=nint((xdt+0.5)/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 ft4sim diff --git a/wsjtx_lib/lib/ft4/ft4sim_mult.f90 b/wsjtx_lib/lib/ft4/ft4sim_mult.f90 new file mode 100644 index 0000000..d93978e --- /dev/null +++ b/wsjtx_lib/lib/ft4/ft4sim_mult.f90 @@ -0,0 +1,103 @@ +program ft4sim_mult + +! Generate simulated signals for experimental "FT4" mode + + use wavhdr + use packjt77 + include 'ft4_params.f90' !FT4 protocol constants + parameter (NWAVE=NN*NSPS) + parameter (NZZ=72576) !Length of .wav file (21*3456) + type(hdr) h !Header for .wav file + character arg*12,fname*17,cjunk*4 + character msg37*37,msgsent37*37,c77*77 + complex cwave0((NN+2)*NSPS) + real wave0((NN+2)*NSPS) + real wave(NZZ) + real tmp(NZZ) + integer itone(NN) + integer*1 msgbits(77) + integer*2 iwave(NZZ) !Generated full-length waveform + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.2) then + print*,'Usage: ft4sim_mult nsigs nfiles' + print*,'Example: ft4sim_mult 20 8 ' + go to 999 + endif + call getarg(1,arg) + read(arg,*) nsigs !Number of signals + call getarg(2,arg) + read(arg,*) nfiles !Number of files + + 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 unsmoothed symbols (s) + baud=1.0/tt !Keying rate (baud) + txt=NZ*dt !Transmission length (s) without ramp up/down + bandwidth_ratio=2500.0/(fs/2.0) + txt=NN*NSPS/12000.0 + open(10,file='messages.txt',status='old',err=998) + + do ifile=1,nfiles +1 read(10,1001,end=999) cjunk,n +1001 format(a4,i2) + if(cjunk.ne.'File' .or. n.ne.ifile) go to 1 + wave=0. + write(fname,1002) ifile +1002 format('000000_',i6.6,'.wav') + + do isig=1,nsigs + read(10,1003,end=100) cjunk,isnr,xdt0,ifreq,msg37 +1003 format(a4,30x,i3,f5.1,i5,1x,a37) + if(cjunk.eq.'File') go to 100 + if(isnr.lt.-17) isnr=-17 + f0=ifreq*960.0/576.0 + call random_number(r) + xdt=r-0.5 +! Source-encode, then get itone() + i3=-1 + n3=-1 + call pack77(msg37,i3,n3,c77) + call genft4(msg37,0,msgsent37,msgbits,itone) + nwave0=(NN+2)*NSPS + icmplx=0 + call gen_ft4wave(itone,NN,NSPS,12000.0,f0,cwave0,wave0,icmplx,nwave0) + + k0=nint((xdt+0.5)/dt) + if(k0.lt.1) k0=1 + tmp(:k0-1)=0.0 + tmp(k0:k0+nwave0-1)=wave0 + tmp(k0+nwave0:)=0.0 + + ! Insert this signal into wave() array + sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*isnr) + wave=wave + sig*tmp + write(*,1100) fname(1:13),isig,isnr,xdt,nint(f0),msg37 +1100 format(a13,i4,i5,f5.1,i6,2x,a37) + enddo ! isig + +100 backspace 10 + + do i=1,NZZ !Add gaussian noise at specified SNR + xnoise=gran() + wave(i)=wave(i) + xnoise + enddo + + gain=30.0 + wave=gain*wave + if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped." + iwave=nint(wave) + h=default_header(12000,NZZ) + open(12,file=fname,status='unknown',access='stream') + write(12) h,iwave !Save to *.wav file + close(12) + print*,' ' + enddo ! ifile + go to 999 + +998 print*,'Cannot open file "messages.txt"' + +999 end program ft4sim_mult diff --git a/wsjtx_lib/lib/ft4/gen_ft4wave.f90 b/wsjtx_lib/lib/ft4/gen_ft4wave.f90 new file mode 100644 index 0000000..1301824 --- /dev/null +++ b/wsjtx_lib/lib/ft4/gen_ft4wave.f90 @@ -0,0 +1,66 @@ +subroutine gen_ft4wave(itone,nsym,nsps,fsample,f0,cwave,wave,icmplx,nwave) + + real wave(nwave) + complex cwave(nwave) + real pulse(6912) !576*4*3 + real dphi(0:250000-1) + integer itone(nsym) + logical first + data first/.true./ + save pulse,first,twopi,dt,hmod + + if(first) then + twopi=8.0*atan(1.0) + dt=1.0/fsample + hmod=1.0 +! Compute the smoothed frequency-deviation pulse + do i=1,3*nsps + tt=(i-1.5*nsps)/real(nsps) + pulse(i)=gfsk_pulse(1.0,tt) + enddo + first=.false. + endif + +! Compute the smoothed frequency waveform. +! Length = (nsym+2)*nsps samples, zero-padded + 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*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_ft4wave diff --git a/wsjtx_lib/lib/ft4/genft4.f90 b/wsjtx_lib/lib/ft4/genft4.f90 new file mode 100644 index 0000000..66e70a6 --- /dev/null +++ b/wsjtx_lib/lib/ft4/genft4.f90 @@ -0,0 +1,90 @@ +subroutine genft4(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*576/12000 = 5.04 s + +! use iso_c_binding, only: c_loc,c_size_t + + use packjt77 + include 'ft4_params.f90' + 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(NN),itmp(ND) + integer*1 codeword(2*ND) + integer*1 msgbits(77),rvec(77) + integer icos4a(4),icos4b(4),icos4c(4),icos4d(4) + 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 + + if(ichk.eq.1) go to 999 + read(c77,'(77i1)',err=1) msgbits + if(unpk77_success) go to 2 +1 msgbits=0 + itone=0 + msgsent='*** bad message *** ' + go to 999 + +entry get_ft4_tones_from_77bits(msgbits,i4tone) + +2 msgbits=mod(msgbits+rvec,2) + call encode174_91(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 genft4 diff --git a/wsjtx_lib/lib/ft4/get_ft4_bitmetrics.f90 b/wsjtx_lib/lib/ft4/get_ft4_bitmetrics.f90 new file mode 100644 index 0000000..9c8a4ab --- /dev/null +++ b/wsjtx_lib/lib/ft4/get_ft4_bitmetrics.f90 @@ -0,0 +1,116 @@ +subroutine get_ft4_bitmetrics(cd,bitmetrics,badsync) + + include 'ft4_params.f90' + parameter (NSS=NSPS/NDOWN,NDMAX=NMAX/NDOWN) + 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 + 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_ft4_bitmetrics diff --git a/wsjtx_lib/lib/ft4/getcandidates4.f90 b/wsjtx_lib/lib/ft4/getcandidates4.f90 new file mode 100644 index 0000000..8ff8064 --- /dev/null +++ b/wsjtx_lib/lib/ft4/getcandidates4.f90 @@ -0,0 +1,83 @@ +subroutine getcandidates4(dd,fa,fb,syncmin,nfqso,maxcand,savg,candidate, & + ncand,sbase) + + include 'ft4_params.f90' + real s(NH1,NHSYM) + real savg(NH1),savsm(NH1) + real sbase(NH1) + real x(NFFT1) + real window(NFFT1) + complex cx(0:NH1) + real candidate(2,maxcand),candidatet(2,maxcand) + real dd(NMAX) + equivalence (x,cx) + logical first + data first/.true./ + save first,window + + if(first) then + first=.false. + pi=4.0*atan(1.) + window=0. + call nuttal_window(window,NFFT1) + endif + +! Compute symbol spectra, stepping by NSTEP steps. + savg=0. + df=12000.0/NFFT1 + fac=1.0/300.0 + do j=1,NHSYM + ia=(j-1)*NSTEP + 1 + ib=ia+NFFT1-1 + if(ib.gt.NMAX) exit + x=fac*dd(ia:ib)*window + call four2a(x,NFFT1,1,-1,0) !r2c FFT + s(1:NH1,j)=abs(cx(1:NH1))**2 + savg=savg + s(1:NH1,j) !Average spectrum + enddo + savg=savg/NHSYM + savsm=0. + do i=8,NH1-7 + savsm(i)=sum(savg(i-7:i+7))/15. + enddo + + nfa=fa/df + if(nfa.lt.nint(200.0/df)) nfa=nint(200.0/df) + nfb=fb/df + if(nfb.gt.nint(4910.0/df)) nfb=nint(4910.0/df) + call ft4_baseline(savg,nfa,nfb,sbase) + if(any(sbase(nfa:nfb).le.0)) return + savsm(nfa:nfb)=savsm(nfa:nfb)/sbase(nfa:nfb) + f_offset = -1.5*12000.0/NSPS + ncand=0 + candidatet=0 + do i=nfa+1,nfb-1 + if(savsm(i).ge.savsm(i-1) .and. savsm(i).ge.savsm(i+1) .and. & + savsm(i).ge.syncmin) then + den=savsm(i-1)-2*savsm(i)+savsm(i+1) + del=0. + if(den.ne.0.0) del=0.5*(savsm(i-1)-savsm(i+1))/den + fpeak=(i+del)*df+f_offset + if(fpeak.lt.200.0 .or. fpeak.gt.4910.0) cycle + speak=savsm(i) - 0.25*(savsm(i-1)-savsm(i+1))*del + ncand=ncand+1 + candidatet(1,ncand)=fpeak + candidatet(2,ncand)=speak + if(ncand.eq.maxcand) exit + endif + enddo + candidate=0 + nq=count(abs(candidatet(1,1:ncand)-nfqso).le.20.0) + n1=1 + n2=nq+1 + do i=1,ncand + if(abs(candidatet(1,i)-nfqso).le.20.0) then + candidate(1:2,n1)=candidatet(1:2,i) + n1=n1+1 + else + candidate(1:2,n2)=candidatet(1:2,i) + n2=n2+1 + endif + enddo +return +end subroutine getcandidates4 diff --git a/wsjtx_lib/lib/ft4/messages.txt b/wsjtx_lib/lib/ft4/messages.txt new file mode 100644 index 0000000..16329fc --- /dev/null +++ b/wsjtx_lib/lib/ft4/messages.txt @@ -0,0 +1,162 @@ +File 1 +190106_000015 7.080 Rx FT8 -15 0.2 178 N1TRK N4FKH 569 VA +190106_000015 7.080 Rx FT8 -13 -0.1 253 N1TRK KB7RUQ 539 UT +190106_000015 7.080 Rx FT8 10 0.2 389 W0ZF N3LFC RR73 +190106_000015 7.080 Rx FT8 -10 0.1 450 PY4AZ KF7YED 559 MT +190106_000015 7.080 Rx FT8 -3 0.2 507 N1TRK WA4DYD 559 GA +190106_000015 7.080 Rx FT8 14 0.2 689 KB0VHA KA1YQC R 539 MA +190106_000015 7.080 Rx FT8 -5 0.1 984 W9JA N9OY RR73 +190106_000015 7.080 Rx FT8 -12 0.1 1123 VA2CZ K8GNG RR73 +190106_000015 7.080 Rx FT8 2 0.1 1240 CQ RU K7RL CN88 +190106_000015 7.080 Rx FT8 -11 0.5 1293 K4ZMW K7VZ RR73 +190106_000015 7.080 Rx FT8 2 0.1 1387 WD9IGY KX1X 73 +190106_000015 7.080 Rx FT8 -10 0.1 1536 CQ RU W0FRC DM79 +190106_000015 7.080 Rx FT8 -2 0.1 1635 K4SQC VE3RX 549 ON +190106_000030 7.080 Rx FT8 -11 0.2 1745 CQ RU K1LOG FN56 +190106_000030 7.080 Rx FT8 3 0.8 1798 WD5DAX WS4WW 73 +190106_000030 7.080 Rx FT8 12 0.1 1895 DJ6GI KG4W 73 +190106_000030 7.080 Rx FT8 -14 0.2 2119 KF7YED KF5ZNQ 549 TX +190106_000030 7.080 Rx FT8 -5 0.1 336 CQ RU AB5XS EM12 +190106_000030 7.080 Rx FT8 0 0.0 1415 W3KIT AA8SW RR73 +190106_000030 7.080 Rx FT8 -13 0.3 1540 NI6G W7DRW 579 AZ +190106_000030 7.080 Rx FT8 -10 0.1 312 SHIFT W9JA +190106_000030 7.080 Rx FT8 -16 0.1 1447 W7BOB KJ7G 549 WA +File 2 +190106_000045 7.080 Rx FT8 -9 0.1 178 N1TRK N4FKH 569 VA +190106_000045 7.080 Rx FT8 -9 -0.1 253 N1TRK KB7RUQ RR73 +190106_000045 7.080 Rx FT8 -8 0.1 336 CQ RU AB5XS EM12 +190106_000045 7.080 Rx FT8 16 0.3 689 KB0VHA KA1YQC R 539 MA +190106_000045 7.080 Rx FT8 -3 0.1 984 CQ RU N9OY EN43 +190106_000045 7.080 Rx FT8 -10 0.1 1146 K1JT WB4HXE 559 GA +190106_000045 7.080 Rx FT8 6 0.1 1240 VE3LON K7RL R 549 WA +190106_000045 7.080 Rx FT8 -1 0.1 1386 WD9IGY KX1X 73 +190106_000045 7.080 Rx FT8 -12 0.1 1536 CQ RU W0FRC DM79 +190106_000045 7.080 Rx FT8 3 0.1 1635 K4SQC VE3RX RR73 +190106_000045 7.080 Rx FT8 -5 0.1 1688 CQ RU W1QA FN32 +190106_000045 7.080 Rx FT8 1 0.8 1797 CQ RU WS4WW FM17 +190106_000045 7.080 Rx FT8 14 0.1 1895 HB9BUN KG4W R 549 VA +190106_000100 7.080 Rx FT8 -7 0.1 2002 W9TO KN3ILZ 529 PA +190106_000100 7.080 Rx FT8 -9 0.1 312 W9JA PY2APK RRR +190106_000100 7.080 Rx FT8 -12 0.1 436 NZ7P WA7JAY 589 CA +190106_000100 7.080 Rx FT8 -13 -0.1 1380 AC6BW KR9A R 559 WI +190106_000100 7.080 Rx FT8 -17 0.1 1448 W7BOB KJ7G RR73 +190106_000100 7.080 Rx FT8 -7 0.3 1540 NI6G W7DRW 569 AZ +File 3 +190106_000115 7.080 Rx FT8 -13 0.2 178 N1TRK N4FKH 569 VA +190106_000115 7.080 Rx FT8 -14 -0.1 253 N1TRK KB7RUQ RR73 +190106_000115 7.080 Rx FT8 -5 0.1 336 CQ RU AB5XS EM12 +190106_000115 7.080 Rx FT8 -7 0.1 449 NI6G KF7YED 569 MT +190106_000115 7.080 Rx FT8 14 0.2 689 KB0VHA KA1YQC 73 +190106_000115 7.080 Rx FT8 11 0.4 852 W9TO N4QWF 569 VA +190106_000115 7.080 Rx FT8 -3 0.1 984 W4EMB N9OY R 529 WI +190106_000115 7.080 Rx FT8 -14 0.1 1117 WB4FAY K7PDW 549 UT +190106_000115 7.080 Rx FT8 3 0.2 1240 VE3LON K7RL R 559 WA +190106_000115 7.080 Rx FT8 -18 0.1 1380 AC6BW KR9A R 559 WI +190106_000115 7.080 Rx FT8 4 0.1 1475 K4KCL KB4S 559 VA +190106_000130 7.080 Rx FT8 -5 0.1 1612 K1JT WB4HXE RR73 +190106_000115 7.080 Rx FT8 -1 0.1 1688 KW4RTR W1QA R 539 MA +190106_000115 7.080 Rx FT8 -15 0.2 1745 CQ RU K1LOG FN56 +190106_000115 7.080 Rx FT8 3 0.8 1798 WA1T WS4WW R 579 VA +190106_000115 7.080 Rx FT8 14 0.1 1895 HB9BUN KG4W R 549 VA +190106_000115 7.080 Rx FT8 -9 0.2 2125 CQ RU NF3R FN20 +190106_000130 7.080 Rx FT8 -8 0.4 976 AG1T K7VZ 569 AZ +190106_000130 7.080 Rx FT8 -7 0.1 1434 Z36W N4KMC 529 FL +File 4 +190106_000145 7.080 Rx FT8 -8 0.1 335 CQ RU AB5XS EM12 +190106_000145 7.080 Rx FT8 -11 0.2 388 W0ZF WW4LL 559 ME +190106_000145 7.080 Rx FT8 -10 0.1 449 NI6G KF7YED 569 MT +190106_000145 7.080 Rx FT8 10 0.3 689 CQ RU KA1YQC FN42 +190106_000145 7.080 Rx FT8 12 0.4 852 W9TO N4QWF RR73 +190106_000145 7.080 Rx FT8 -2 0.1 984 W4EMB N9OY R 529 WI +190106_000145 7.080 Rx FT8 -12 0.1 1117 WB4FAY K7PDW 549 UT +190106_000145 7.080 Rx FT8 4 0.2 1240 VE3LON K7RL 73 +190106_000145 7.080 Rx FT8 -13 0.1 1348 WW5M KO9V 559 NC +190106_000145 7.080 Rx FT8 -14 0.1 1380 AC6BW KR9A R 559 WI +190106_000145 7.080 Rx FT8 2 0.1 1475 K4KCL KB4S RR73 +190106_000145 7.080 Rx FT8 -9 0.1 1536 KC1HTT W0FRC 73 +190106_000145 7.080 Rx FT8 1 0.1 1688 KW4RTR W1QA R 539 MA +190106_000200 7.080 Rx FT8 1 0.8 1797 WA1T WS4WW R 569 VA +190106_000200 7.080 Rx FT8 15 0.1 1895 CQ RU KG4W FM17 +190106_000200 7.080 Rx FT8 -6 0.2 2125 CQ RU NF3R FN20 +190106_000200 7.080 Rx FT8 -7 0.1 311 PD8DX PY2APK 539 0081 +190106_000200 7.080 Rx FT8 -3 0.5 976 AG1T K7VZ RR73 +190106_000200 7.080 Rx FT8 -5 0.1 1432 Z36W N4KMC 529 FL +190106_000200 7.080 Rx FT8 -7 0.3 1540 N7BT W7DRW 559 AZ +190106_000200 7.080 Rx FT8 -16 0.3 2124 N3KCR ON9COP 529 0053 +190106_000200 7.080 Rx FT8 -12 0.1 1448 K2DH KJ7G 549 WA +File 5 +190106_000215 7.080 Rx FT8 11 0.1 435 K1JT WV8WA 569 WV +190106_000215 7.080 Rx FT8 -4 0.1 335 CQ RU AB5XS EM12 +190106_000215 7.080 Rx FT8 10 0.5 689 CQ RU KA1YQC FN42 +190106_000215 7.080 Rx FT8 -10 0.1 843 CQ RU AE5JH EL07 +190106_000215 7.080 Rx FT8 -3 0.1 984 W4EMB N9OY R 529 WI +190106_000215 7.080 Rx FT8 -10 0.1 1118 WB4FAY W5MO 539 TX +190106_000215 7.080 Rx FT8 -16 0.1 1170 K1JT K8GNG 569 MI +190106_000215 7.080 Rx FT8 6 0.1 1240 CQ RU K7RL CN88 +190106_000215 7.080 Rx FT8 -8 0.1 1348 WW5M KO9V RR73 +190106_000215 7.080 Rx FT8 -12 0.1 1432 Z36W N4KMC 529 FL +190106_000215 7.080 Rx FT8 2 0.1 1490 KA6BIM KB4S 529 VA +190106_000230 7.080 Rx FT8 -1 0.1 1688 CQ RU W1QA FN32 +190106_000230 7.080 Rx FT8 15 0.1 1895 DD5ZZ KG4W R 539 VA +190106_000230 7.080 Rx FT8 -8 0.2 2125 CQ RU NF3R FN20 +190106_000230 7.080 Rx FT8 -13 0.1 1380 AC6BW KR9A R 559 WI +190106_000230 7.080 Rx FT8 -4 0.1 1536 CQ RU W0FRC DM79 +190106_000230 7.080 Rx FT8 -8 0.3 1540 N7BT W7DRW 559 AZ +File 6 +190106_000245 7.080 Rx FT8 6 0.1 635 K1JT WV8WA RR73 +190106_000245 7.080 Rx FT8 -12 0.1 335 VE3RX AB5XS R 589 TX +190106_000245 7.080 Rx FT8 -16 0.1 423 WA1T PY2APK 529 0081 +190106_000245 7.080 Rx FT8 9 0.4 507 N1TRK N4QWF RR73 +190106_000245 7.080 Rx FT8 -10 0.1 869 W7BOB W3KIT 539 MD +190106_000245 7.080 Rx FT8 -7 0.1 984 W4EMB N9OY R 529 WI +190106_000245 7.080 Rx FT8 -13 0.1 1170 K1JT K8GNG 569 MI +190106_000245 7.080 Rx FT8 5 0.1 1240 W6GMT K7RL R 569 WA +190106_000245 7.080 Rx FT8 2 0.1 1490 KA6BIM KB4S 529 VA +190106_000245 7.080 Rx FT8 -1 0.1 1688 CQ RU W1QA FN32 +190106_000245 7.080 Rx FT8 1 0.7 1798 N3KCR WS4WW R 599 VA +190106_000245 7.080 Rx FT8 17 0.1 1895 DD5ZZ KG4W 73 +190106_000300 7.080 Rx FT8 -10 0.2 2125 CQ RU NF3R FN20 +190106_000300 7.080 Rx FT8 8 0.1 546 W7BOB W4DHE 539 KY +190106_000300 7.080 Rx FT8 -9 0.2 844 CQ RU AE5JH EL07 +190106_000300 7.080 Rx FT8 -5 0.1 1536 W9WLX W0FRC R 549 CO +File 7 +190106_000315 7.080 Rx FT8 -5 0.1 335 VE3RX AB5XS 73 +190106_000315 7.080 Rx FT8 -13 0.1 424 WA1T PY2APK 529 0081 +190106_000315 7.080 Rx FT8 6 0.1 545 W7BOB W4DHE 539 KY +190106_000315 7.080 Rx FT8 -7 0.4 600 K2DH K7VZ 549 AZ +190106_000315 7.080 Rx FT8 9 0.1 689 VE3LON KA1YQC 73 +190106_000315 7.080 Rx FT8 -8 0.1 869 W7BOB W3KIT 539 MD +190106_000315 7.080 Rx FT8 -1 0.1 984 W4EMB N9OY R 529 WI +190106_000315 7.080 Rx FT8 -15 -0.1 1117 WB4FAY KB7RUQ 529 UT +190106_000315 7.080 Rx FT8 7 -0.2 1240 W6GMT K7RL 73 +190106_000315 7.080 Rx FT8 -5 0.2 1581 VA3WW WA4DYD 559 GA +190106_000315 7.080 Rx FT8 -8 0.1 1688 DD5ZZ W1QA R 569 MA +190106_000315 7.080 Rx FT8 4 0.7 1798 N3KCR WS4WW 73 +190106_000315 7.080 Rx FT8 16 0.1 1895 CQ RU KG4W FM17 +190106_000315 7.080 Rx FT8 -11 0.2 2125 CQ RU NF3R FN20 +190106_000330 7.080 Rx FT8 -8 0.1 1170 K1JT K8GNG RR73 +190106_000330 7.080 Rx FT8 -13 -0.1 454 NZ7P KM7S R 549 CA +190106_000330 7.080 Rx FT8 1 0.1 941 KW4RTR KO9V 559 NC +190106_000330 7.080 Rx FT8 -16 0.3 1034 W9JA W9OY 539 FL +190106_000330 7.080 Rx FT8 -2 0.1 1240 K2DH KD2GXL 559 NY +190106_000330 7.080 Rx FT8 -5 0.1 1536 W9WLX W0FRC 73 +190106_000330 7.080 Rx FT8 -2 -0.1 918 KF6JXM W5BT 529 TX +File 8 +190106_000345 7.080 Rx FT8 -5 0.1 335 CQ RU AB5XS EM12 +190106_000345 7.080 Rx FT8 -13 0.1 423 WA1T PY2APK 529 0081 +190106_000345 7.080 Rx FT8 6 0.2 689 CQ RU KA1YQC FN42 +190106_000345 7.080 Rx FT8 -16 0.1 852 W9TO KM4LFT RR73 +190106_000345 7.080 Rx FT8 -4 -0.1 918 KF6JXM W5BT 529 TX +190106_000345 7.080 Rx FT8 2 0.1 984 W4EMB N9OY R 529 WI +190106_000345 7.080 Rx FT8 -15 0.3 1034 W9JA W9OY RR73 +190106_000345 7.080 Rx FT8 -7 0.1 1175 K2DH KD2GXL 559 NY +190106_000345 7.080 Rx FT8 6 -0.1 1240 CQ RU K7RL CN88 +190106_000345 7.080 Rx FT8 -10 0.1 1536 CQ RU W0FRC DM79 +190106_000345 7.080 Rx FT8 -7 0.2 1581 VA3WW WA4DYD RR73 +190106_000345 7.080 Rx FT8 -9 0.1 1688 DD5ZZ W1QA 73 +190106_000345 7.080 Rx FT8 17 0.1 1895 CQ RU KG4W FM17 +190106_000345 7.080 Rx FT8 -9 0.1 2002 K2DH KN3ILZ 549 PA +190106_000400 7.080 Rx FT8 -5 0.7 2052 CQ RU WS4WW FM17 +190106_000400 7.080 Rx FT8 -9 0.2 2125 NV4G NF3R R 549 PA +190106_000400 7.080 Rx FT8 -5 0.0 941 KW4RTR KO9V RR73 +190106_000400 7.080 Rx FT8 -7 0.2 1744 KC1HTT K1LOG R 569 ME diff --git a/wsjtx_lib/lib/ft4/subtractft4.f90 b/wsjtx_lib/lib/ft4/subtractft4.f90 new file mode 100644 index 0000000..8fb1653 --- /dev/null +++ b/wsjtx_lib/lib/ft4/subtractft4.f90 @@ -0,0 +1,66 @@ +subroutine subtractft4(dd,itone,f0,dt) + +! Subtract an ft4 signal +! +! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) +! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) +! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ] +! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt} + + use timer_module, only: timer + + parameter (NMAX=21*3456,NSPS=576,NFFT=NMAX,NFILT=1400) + parameter (NFRAME=(103+2)*NSPS) + real*4 dd(NMAX), window(-NFILT/2:NFILT/2), xjunk + complex cref,camp,cfilt,cw + integer itone(103) + logical first + data first/.true./ + common/heap4/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX),xjunk(NFRAME) + save first + + nstart=dt*12000+1-NSPS + nsym=103 + fs=12000.0 + icmplx=1 + bt=1.0 + nss=NSPS + call gen_ft4wave(itone,nsym,nss,fs,f0,cref,xjunk,icmplx,NFRAME) + camp=0. + do i=1,nframe + id=nstart-1+i + if(id.ge.1.and.id.le.NMAX) camp(i)=dd(id)*conjg(cref(i)) + enddo + + if(first) then +! Create and normalize the filter + pi=4.0*atan(1.0) + fac=1.0/float(nfft) + sum=0.0 + do j=-NFILT/2,NFILT/2 + window(j)=cos(pi*j/NFILT)**2 + sum=sum+window(j) + enddo + cw=0. + cw(1:NFILT+1)=window/sum + cw=cshift(cw,NFILT/2+1) + call four2a(cw,nfft,1,-1,1) + cw=cw*fac + first=.false. + endif + + cfilt=0.0 + cfilt(1:nframe)=camp(1:nframe) + call four2a(cfilt,nfft,1,-1,1) + cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft) + call four2a(cfilt,nfft,1,1,1) + +! Subtract the reconstructed signal + do i=1,nframe + j=nstart+i-1 + if(j.ge.1 .and. j.le.NMAX) dd(j)=dd(j)-2*REAL(cfilt(i)*cref(i)) + enddo + + return +end subroutine subtractft4 + diff --git a/wsjtx_lib/lib/ft4/sync4d.f90 b/wsjtx_lib/lib/ft4/sync4d.f90 new file mode 100644 index 0000000..50ae5d9 --- /dev/null +++ b/wsjtx_lib/lib/ft4/sync4d.f90 @@ -0,0 +1,96 @@ +subroutine sync4d(cd0,i0,ctwk,itwk,sync) + +! Compute sync power for a complex, downsampled FT4 signal. + + include 'ft4_params.f90' + parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN) + complex cd0(0:NP-1) + complex csynca(2*NSS),csyncb(2*NSS),csyncc(2*NSS),csyncd(2*NSS) + complex csync2(2*NSS) + complex ctwk(2*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=2*twopi*icos4a(i)/real(NSS) + dphib=2*twopi*icos4b(i)/real(NSS) + dphic=2*twopi*icos4c(i)/real(NSS) + dphid=2*twopi*icos4d(i)/real(NSS) + do j=1,NSS/2 + 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/(2.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) 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:2)*conjg(csync2)) + elseif( i1.lt.0 ) then + npts=(i1+4*NSS-1)/2 + if(npts.le.16) then + z1=0. + else + z1=sum(cd0(0:i1+4*NSS-1:2)*conjg(csync2(2*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) z2=sum(cd0(i2:i2+4*NSS-1:2)*conjg(csync2)) + + if(itwk.eq.1) csync2=ctwk*csyncc !Tweak the frequency + if(i3.ge.0 .and. i3+4*NSS-1.le.NP-1) z3=sum(cd0(i3:i3+4*NSS-1:2)*conjg(csync2)) + + 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:2)*conjg(csync2)) + elseif( i4+4*NSS-1.gt.NP-1 ) then + npts=(NP-1-i4+1)/2 + if(npts.le.16) then + z4=0. + else + z4=sum(cd0(i4:i4+2*npts-1:2)*conjg(csync2(1:npts))) + endif + endif + + sync = p(z1) + p(z2) + p(z3) + p(z4) + + return +end subroutine sync4d diff --git a/wsjtx_lib/lib/ft4_decode.f90 b/wsjtx_lib/lib/ft4_decode.f90 new file mode 100644 index 0000000..b15368a --- /dev/null +++ b/wsjtx_lib/lib/ft4_decode.f90 @@ -0,0 +1,467 @@ +module ft4_decode + + type :: ft4_decoder + procedure(ft4_decode_callback), pointer :: callback + contains + procedure :: decode + end type ft4_decoder + + abstract interface + subroutine ft4_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual) + import ft4_decoder + implicit none + class(ft4_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + end subroutine ft4_decode_callback + end interface + +contains + + subroutine decode(this,callback,iwave,nQSOProgress,nfqso, & + nfa,nfb,ndepth,lapcqonly,ncontest,mycall,hiscall) + use timer_module, only: timer + use packjt77 + include 'ft4/ft4_params.f90' + parameter (MAXCAND=100) + class(ft4_decoder), intent(inout) :: this + procedure(ft4_decode_callback) :: callback + parameter (NSS=NSPS/NDOWN,NDMAX=NMAX/NDOWN) + character message*37,msgsent*37 + character c77*77 + character*37 decodes(100) + character*17 cdatetime0 + character*12 mycall,hiscall + character*12 mycall0,hiscall0 + character*6 hhmmss + + complex cd2(0:NDMAX-1) !Complex waveform + complex cb(0:NDMAX-1) + complex cd(0:NN*NSS-1) !Complex waveform + complex ctwk(2*NSS),ctwk2(2*NSS,-16:16) + + real a(5) + real bitmetrics(2*NN,3) + real dd(NMAX) + real llr(2*ND),llra(2*ND),llrb(2*ND),llrc(2*ND),llrd(2*ND) + real candidate(2,MAXCAND) + real savg(NH1),sbase(NH1) + + integer apbits(2*ND) + integer apmy_ru(28),aphis_fd(28) + integer*2 iwave(NMAX) !Raw received data + integer*1 message77(77),rvec(77),apmask(2*ND),cw(2*ND) + integer*1 message91(91) + integer*1 hbits(2*NN) + integer i4tone(103) + integer nappasses(0:5) ! # of decoding passes for QSO States 0-5 + integer naptypes(0:5,4) ! nQSOProgress, decoding pass + integer mcq(29),mcqru(29),mcqfd(29),mcqtest(29),mcqww(29) + integer mrrr(19),m73(19),mrr73(19) + + logical nohiscall,unpk77_success + logical first, dobigfft + logical dosubtract,doosd + logical badsync + logical, intent(in) :: lapcqonly + + data first/.true./ + data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ + data mcqru/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,1,1,0,0/ + data mcqfd/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0/ + data mcqtest/0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,1,1,1,1,1,1,0,0,1,0/ + data mcqww/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,1,1,0/ + data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ + data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ + data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,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/ + save fs,dt,tt,txt,twopi,h,first,apbits,nappasses,naptypes, & + mycall0,hiscall0,ctwk2 + + this%callback => callback + hhmmss=cdatetime0(8:13) + dxcall13=hiscall ! initialize for use in packjt77 + mycall13=mycall + + smax1=0. + nd1=0 + + if(first) then + fs=12000.0/NDOWN !Sample rate after downsampling + dt=1/fs !Sample interval after downsample (s) + tt=NSPS*dt !Duration of "itone" symbols (s) + txt=NZ*dt !Transmission length (s) without ramp up/down + twopi=8.0*atan(1.0) + h=1.0 + + do idf=-16,16 + a=0. + a(1)=real(idf) + ctwk=1. + call twkfreq1(ctwk,2*NSS,fs/2.0,a,ctwk2(:,idf)) + enddo + + mcq=2*mod(mcq+rvec(1:29),2)-1 + mcqru=2*mod(mcqru+rvec(1:29),2)-1 + mcqfd=2*mod(mcqfd+rvec(1:29),2)-1 + mcqtest=2*mod(mcqtest+rvec(1:29),2)-1 + mcqww=2*mod(mcqww+rvec(1:29),2)-1 + mrrr=2*mod(mrrr+rvec(59:77),2)-1 + m73=2*mod(m73+rvec(59:77),2)-1 + mrr73=2*mod(mrr73+rvec(59:77),2)-1 + nappasses(0)=2 + nappasses(1)=2 + nappasses(2)=2 + nappasses(3)=2 + nappasses(4)=2 + nappasses(5)=3 + +! iaptype +!------------------------ +! 1 CQ ??? ??? (29 ap bits) +! 2 MyCall ??? ??? (29 ap bits) +! 3 MyCall DxCall ??? (58 ap bits) +! 4 MyCall DxCall RRR (77 ap bits) +! 5 MyCall DxCall 73 (77 ap bits) +! 6 MyCall DxCall RR73 (77 ap bits) +!******** + naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ) + naptypes(1,1:4)=(/2,3,0,0/) ! Tx1 + naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 + naptypes(3,1:4)=(/3,6,0,0/) ! Tx3 + naptypes(4,1:4)=(/3,6,0,0/) ! Tx4 + naptypes(5,1:4)=(/3,1,2,0/) ! Tx5 + + mycall0='' + hiscall0='' + first=.false. + endif + + l1=index(mycall,char(0)) + if(l1.ne.0) mycall(l1:)=" " + l1=index(hiscall,char(0)) + if(l1.ne.0) hiscall(l1:)=" " + if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0) then + apbits=0 + apbits(1)=99 + apbits(30)=99 + apmy_ru=0 + aphis_fd=0 + + if(len(trim(mycall)) .lt. 3) go to 10 + + nohiscall=.false. + hiscall0=hiscall + if(len(trim(hiscall0)).lt.3) then + hiscall0=mycall ! use mycall for dummy hiscall - mycall won't be hashed. + nohiscall=.true. + endif + message=trim(mycall)//' '//trim(hiscall0)//' RR73' + i3=-1 + n3=-1 + call pack77(message,i3,n3,c77) + call unpack77(c77,1,msgsent,unpk77_success) + if(i3.ne.1 .or. (message.ne.msgsent) .or. .not.unpk77_success) go to 10 + read(c77,'(77i1)') message77 + apmy_ru=2*mod(message77(1:28)+rvec(2:29),2)-1 + aphis_fd=2*mod(message77(30:57)+rvec(29:56),2)-1 + message77=mod(message77+rvec,2) + call encode174_91(message77,cw) + apbits=2*cw-1 + if(nohiscall) apbits(30)=99 + +10 continue + mycall0=mycall + hiscall0=hiscall + endif + ndecodes=0 + decodes=' ' + fa=nfa + fb=nfb + dd=iwave + +! ndepth=3: 3 passes, bp+osd +! ndepth=2: 3 passes, bp only +! ndepth=1: 1 pass, no subtraction + + max_iterations=40 + syncmin=1.2 + dosubtract=.true. + doosd=.true. + nsp=3 + if(ndepth.eq.2) then + doosd=.false. + endif + if(ndepth.eq.1) then + nsp=1 + dosubtract=.false. + doosd=.false. + endif + + do isp = 1,nsp + if(isp.eq.2) then + if(ndecodes.eq.0) exit + nd1=ndecodes + elseif(isp.eq.3) then + nd2=ndecodes-nd1 + if(nd2.eq.0) exit + endif + + candidate=0.0 + ncand=0 + call timer('getcand4',0) + call getcandidates4(dd,fa,fb,syncmin,nfqso,MAXCAND,savg,candidate, & + ncand,sbase) + call timer('getcand4',1) + dobigfft=.true. + do icand=1,ncand + f0=candidate(1,icand) + snr=candidate(2,icand)-1.0 + call timer('ft4_down',0) + call ft4_downsample(dd,dobigfft,f0,cd2) !Downsample to 32 Sam/Sym + call timer('ft4_down',1) + if(dobigfft) dobigfft=.false. + sum2=sum(cd2*conjg(cd2))/(real(NMAX)/real(NDOWN)) + if(sum2.gt.0.0) cd2=cd2/sqrt(sum2) +! Sample rate is now 12000/18 = 666.67 samples/second + do iseg=1,3 ! DT search is done over 3 segments + do isync=1,2 + if(isync.eq.1) then + idfmin=-12 + idfmax=12 + idfstp=3 + ibmin=-344 + ibmax=1012 + if(iseg.eq.1) then + ibmin=108 + ibmax=560 + elseif(iseg.eq.2) then + smax1=smax + ibmin=560 + ibmax=1012 + elseif(iseg.eq.3) then + ibmin=-344 + ibmax=108 + endif + ibstp=4 + else + idfmin=idfbest-4 + idfmax=idfbest+4 + idfstp=1 + ibmin=ibest-5 + ibmax=ibest+5 + ibstp=1 + endif + ibest=-1 + idfbest=0 + smax=-99. + call timer('sync4d ',0) + do idf=idfmin,idfmax,idfstp + do istart=ibmin,ibmax,ibstp + call sync4d(cd2,istart,ctwk2(:,idf),1,sync) !Find sync power + if(sync.gt.smax) then + smax=sync + ibest=istart + idfbest=idf + endif + enddo + enddo + call timer('sync4d ',1) + enddo + if(iseg.eq.1) smax1=smax + if(smax.lt.1.2) cycle + if(iseg.gt.1 .and. smax.lt.smax1) cycle + f1=f0+real(idfbest) + if( f1.le.10.0 .or. f1.ge.4990.0 ) cycle + call timer('ft4down ',0) + call ft4_downsample(dd,dobigfft,f1,cb) !Final downsample, corrected f0 + call timer('ft4down ',1) + sum2=sum(abs(cb)**2)/(real(NSS)*NN) + if(sum2.gt.0.0) cb=cb/sqrt(sum2) + cd=0. + if(ibest.ge.0) then + it=min(NDMAX-1,ibest+NN*NSS-1) + np=it-ibest+1 + cd(0:np-1)=cb(ibest:it) + else + cd(-ibest:ibest+NN*NSS-1)=cb(0:NN*NSS+2*ibest-1) + endif + call timer('bitmet ',0) + call get_ft4_bitmetrics(cd,bitmetrics,badsync) + call timer('bitmet ',1) + if(badsync) cycle + 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 + + apmag=maxval(abs(llra))*1.1 + npasses=3+nappasses(nQSOProgress) + if(lapcqonly) npasses=4 + if(ndepth.eq.1) npasses=3 + if(ncontest.ge.6) npasses=3 ! Don't support Fox and Hound + do ipass=1,npasses + if(ipass.eq.1) llr=llra + if(ipass.eq.2) llr=llrb + if(ipass.eq.3) llr=llrc + if(ipass.le.3) then + apmask=0 + iaptype=0 + endif + + if(ipass .gt. 3) then + llrd=llrc + iaptype=naptypes(nQSOProgress,ipass-3) + if(lapcqonly) iaptype=1 + +! ncontest=0 : NONE +! 1 : NA_VHF +! 2 : EU_VHF +! 3 : FIELD DAY +! 4 : RTTY +! 5 : WW_DIGI +! 6 : FOX +! 7 : HOUND +! +! Conditions that cause us to bail out of AP decoding + napwid=80 + if(ncontest.le.5 .and. iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid) ) cycle + if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall + if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall + + if(iaptype.eq.1) then ! CQ or CQ TEST or CQ FD or CQ RU or CQ WW + apmask=0 + apmask(1:29)=1 + if( ncontest.eq.0 ) llrd(1:29)=apmag*mcq(1:29) + if( ncontest.eq.1 ) llrd(1:29)=apmag*mcqtest(1:29) + if( ncontest.eq.2 ) llrd(1:29)=apmag*mcqtest(1:29) + if( ncontest.eq.3 ) llrd(1:29)=apmag*mcqfd(1:29) + if( ncontest.eq.4 ) llrd(1:29)=apmag*mcqru(1:29) + if( ncontest.eq.5 ) llrd(1:29)=apmag*mcqww(1:29) + endif + + if(iaptype.eq.2) then ! MyCall,???,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.5) then + apmask(1:29)=1 + llrd(1:29)=apmag*apbits(1:29) + else if(ncontest.eq.2) then + apmask(1:28)=1 + llrd(1:28)=apmag*apbits(1:28) + else if(ncontest.eq.3) then + apmask(1:28)=1 + llrd(1:28)=apmag*apbits(1:28) + else if(ncontest.eq.4) then + apmask(2:29)=1 + llrd(2:29)=apmag*apmy_ru(1:28) + endif + endif + + if(iaptype.eq.3) then ! MyCall,DxCall,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2.or.ncontest.eq.5) then + apmask(1:58)=1 + llrd(1:58)=apmag*apbits(1:58) + else if(ncontest.eq.3) then ! Field Day + apmask(1:56)=1 + llrd(1:28)=apmag*apbits(1:28) + llrd(29:56)=apmag*aphis_fd(1:28) + else if(ncontest.eq.4) then + apmask(2:57)=1 + llrd(2:29)=apmag*apmy_ru(1:28) + llrd(30:57)=apmag*apbits(30:57) + endif + endif + + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then + apmask=0 + if(ncontest.le.5) then + apmask(1:77)=1 ! mycall, hiscall, RRR|73|RR73 + if(iaptype.eq.6) llrd(1:77)=apmag*apbits(1:77) + endif + endif + + llr=llrd + endif + message77=0 + dmin=0.0 + + ndeep=2 + maxosd=2 + if(abs(nfqso-f1).le.napwid) then + ndeep=2 + maxosd=3 + endif + if(.not.doosd) maxosd = -1 + call timer('dec174_91 ',0) + Keff=91 + call decode174_91(llr,Keff,maxosd,ndeep,apmask,message91,cw, & + ntype,nharderror,dmin) + message77=message91(1:77) + call timer('dec174_91 ',1) + + if(sum(message77).eq.0) cycle + if( nharderror.ge.0 ) then + message77=mod(message77+rvec,2) ! remove rvec scrambling + write(c77,'(77i1)') message77(1:77) + call unpack77(c77,1,message,unpk77_success) + if(.not.unpk77_success) exit + if(dosubtract) then + call get_ft4_tones_from_77bits(message77,i4tone) + dt=real(ibest)/666.67 + call timer('subtract',0) + call subtractft4(dd,i4tone,f1,dt) + call timer('subtract',1) + endif + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.message) idupe=1 + enddo + if(idupe.eq.1) exit + ndecodes=ndecodes+1 + decodes(ndecodes)=message + if(snr.gt.0.0) then + xsnr=10*log10(snr)-14.8 + else + xsnr=-21.0 + endif + nsnr=nint(max(-21.0,xsnr)) + xdt=ibest/666.67 - 0.5 + qual=1.0-(nharderror+dmin)/60.0 + call this%callback(smax,nsnr,xdt,f1,message,iaptype,qual) + exit + endif + enddo !Sequence estimation + if(nharderror.ge.0) exit + enddo !3 DT segments + enddo !Candidate list + enddo !Subtraction loop + return + end subroutine decode + +end module ft4_decode diff --git a/wsjtx_lib/lib/ft8/DXpedQuickStart.txt b/wsjtx_lib/lib/ft8/DXpedQuickStart.txt new file mode 100644 index 0000000..82d1c5a --- /dev/null +++ b/wsjtx_lib/lib/ft8/DXpedQuickStart.txt @@ -0,0 +1,126 @@ + Quick Start for DXpedition Mode + ------------------------------- + +These notes are intended for operators already familiar with WSJT-X +and FT8 mode. QSOs between the Dxpedition ("Fox") and other stations +("Hounds") are completed with as little as one transmission per Hound, +as in the following examples: + +---------------------------------------------------------------------------- + Fox (300-600 Hz) Hounds +---------------------------------------------------------------------------- +1. CQ KH1DX AJ10 +2. KH1DX K1ABC FN42, KH1DX W9XYZ EN37, ... +3. K1ABC KH1DX -13 +4. KH1DX K1ABC R-11 +5. K1ABC RR73; W9XYZ -17 +6. KH1DX W9XYZ R-16 +7. W9XYZ RR73; G4AAA -09 +8. ... +---------------------------------------------------------------------------- + +Everybody sets dial frequency to an agreed number and uses CAT control +with Split Operation (either *Rig* or *Fake It*). Fox transmits up to +5 signals simultaneously, at audio frequencies 300, 360, ... 540 +Hz. Hounds make initial calls (e.g., line 2 above) anywhere in the +range 1000 - 4000 Hz. They send "R+rpt" 350 Hz above the frequency +where Fox called them. + + +INSTRUCTIONS FOR FOX +-------------------- + +1. Start WSJT-X in FT8 mode. Select *Fox* on the *Settings -> +Advanced tab*. On the main window, check *Tx even/1st*, *Auto Seq*, +and *Hold Tx Freq*; uncheck *Call 1st*. Set *Tx 300 Hz* and select +Tab 3. + +2. In Fox mode the left window (called "Band Activity" in normal FT8 +mode) is labeled "Stations calling DXpedition ". It will be +filled with a sorted list of calling Hounds. You can sort by Call, +Grid, S/N, Distance, or Random order by using the comboBox at top +right of Tab 3. You can limit the displayed Hound callsigns to those +no stronger than *Max dB*. Fox might use this feature to discourage +Hounds from engaging in a QRO arms race. + +3. *N Slots* sets the number of simultaneous Fox signals to be used. +Fox carries out as many as *N Slots* QSOs simultaneously. + +4. *Repeats* sets the maximum number of repeat transmissions of the +same message. A QSO is aborted when this number would be exceeded. + +5. The *CQ* comboBox on Tab 3 offers a selection of directed CQ +messages. *Reset* clears the QSO queue. + +6. The Fox operator's main task is to select Hounds to be called and +worked. The text box on Tab 3 holds the "QSO queue": a list of Hound +calls to be worked. Hit Enter to select the top callsign from the +sorted list of callers (left window), or double-click on any +particular call. Either actiion moves that Hound into the "QSO +queue". + +7. The right window displays decodes of signals below 1000 Hz. +Normally these should include only Hound messages containing "R+rpt" +and Fox's own transmissions. + +8. To get things started, toggle *Enable Tx* to red. If a Hound call +is available in the QSO queue, that station will be called. If the +QSO queue is empty, Fox calls CQ. + +9. If you're using Nslots = 2 or higher, your signal no longer has +a constant envelope. To avoid producing intermod sidebands you need +to ensure linearity in your Tx system. One way to get things about right +is to use the WSJT-X *Tune* button to generate a pure tone. Reduce the +Tx audio level until your power output decreases by 10% or so. Use this +level for your Fox transmissions. + +NOTE: If you are generating Nslots signals, the average power in each one +will be 1/Nslots^2 of its normal value for single-signal transmissions. + +Nslots Relative dB +------------------- + 1 0 + 2 -6 + 3 -9.5 + 4 -12 + 5 -14 + + +The following features are not yet implemented for Fox: + +1. Enforce all required settings +2. Tx message timeout +3. Manual abort of selected QSO +4. All Tx and Rx messages to all.txt +5. Additional sort criteria for Hound calls +6. Selectable timeout for keeping Hounds in the sorted list +7. Display number of active callers +8. Display QSO rate + + +INSTRUCTIONS FOR HOUND +---------------------- + +1. Start WSJT-X in FT8 mode. Select *Hound* On the *Settings -> +Advanced* tab. On the main window check *Auto Seq* and uncheck *Tx +even/1st*, *Call 1st*, and *Hold Tx Freq*. Set *Tx nnnn Hz* to some +frequency between 1000 and 4000 Hz, and select *Tab 1*. Enter Fox's +callsign and locator in DX Call and DX Grid, select Tx1, and start +*Monitor*. + +2. When you have copied Fox, hit *Enable Tx* to call him. You may +keep calling until he answers. You may wish to move your TxFreq +around, hoping to find a clear calling frequency. + +3. When you are called by Fox with a signal report, your next +transmission will automatically be sent as Tx3 ("R+rpt"). When Fox +receives that message he responds with "RR73", and your QSO is +complete! + + +The following features are not yet implemented for Hound: + +1. Force all required settings +2. React properly to directed CQs from Fox +3. Disable Tx2, 4, 5, 6 +4. For Tx1, enforce TxFreq >= 1000 Hz diff --git a/wsjtx_lib/lib/ft8/baseline.f90 b/wsjtx_lib/lib/ft8/baseline.f90 new file mode 100644 index 0000000..d85eedb --- /dev/null +++ b/wsjtx_lib/lib/ft8/baseline.f90 @@ -0,0 +1,49 @@ +subroutine baseline(s,nfa,nfb,sbase) + +! Fit baseline to spectrum (for FT8) +! Input: s(npts) Linear scale in power +! Output: sbase(npts) Baseline + + implicit real*8 (a-h,o-z) + real*4 s(1920) + real*4 sbase(1920) + real*4 base + real*8 x(1000),y(1000),a(5) + data nseg/10/,npct/10/ + + df=12000.0/3840.0 !3.125 Hz + ia=max(1,nint(nfa/df)) + ib=nint(nfb/df) + do i=ia,ib + s(i)=10.0*log10(s(i)) !Convert to dB scale + enddo + + nterms=5 + nlen=(ib-ia+1)/nseg !Length of test segment + i0=(ib-ia+1)/2 !Midpoint + k=0 + do n=1,nseg !Loop over all segments + ja=ia + (n-1)*nlen + jb=ja+nlen-1 + call pctile(s(ja),nlen,npct,base) !Find lowest npct of points + do i=ja,jb + if(s(i).le.base) then + if (k.lt.1000) k=k+1 !Save all "lower envelope" points + x(k)=i-i0 + y(k)=s(i) + endif + enddo + enddo + kz=k + a=0. + call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial + sbase=0.0 + do i=ia,ib + t=i-i0 + sbase(i)=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + 0.65 +! write(51,3051) i*df,s(i),sbase(i) +!3051 format(3f12.3) + enddo + + return +end subroutine baseline diff --git a/wsjtx_lib/lib/ft8/bpdecode174_91.f90 b/wsjtx_lib/lib/ft8/bpdecode174_91.f90 new file mode 100644 index 0000000..a7c6f95 --- /dev/null +++ b/wsjtx_lib/lib/ft8/bpdecode174_91.f90 @@ -0,0 +1,117 @@ +subroutine bpdecode174_91(llr,apmask,maxiterations,message77,cw,nharderror,iter,ncheck) +! +! A log-domain belief propagation decoder for the (174,91) code. +! +use iso_c_binding, only: c_loc,c_size_t +use crc +integer, parameter:: N=174, K=91, M=N-K +integer*1 cw(N),apmask(N) +integer*1 decoded(K) +integer*1 message77(77) +integer nrw(M),ncw +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 + +include "ldpc_174_91_c_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 +! 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 chkcrc14a(decoded,nbadcrc) + nharderror=count( (2*cw-1)*llr .lt. 0.0 ) + if(nbadcrc.eq.0) then + message77=decoded(1:77) + 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: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 +nharderror=-1 +return +end subroutine bpdecode174_91 diff --git a/wsjtx_lib/lib/ft8/chkcrc13a.f90 b/wsjtx_lib/lib/ft8/chkcrc13a.f90 new file mode 100644 index 0000000..25e1458 --- /dev/null +++ b/wsjtx_lib/lib/ft8/chkcrc13a.f90 @@ -0,0 +1,24 @@ +subroutine chkcrc13a(decoded,nbadcrc) + + use crc + integer*1 decoded(90) + integer*1, target:: i1Dec8BitBytes(12) + character*90 cbits + +! Write decoded bits into cbits: 77-bit message plus 13-bit CRC + write(cbits,1000) decoded +1000 format(90i1) + read(cbits,1001) i1Dec8BitBytes +1001 format(12b8) + read(cbits,1002) ncrc13 !Received CRC13 +1002 format(77x,b13) + + i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),transfer(128+64+32+16+8,0_1)) + i1Dec8BitBytes(11:12)=0 + icrc13=crc13(c_loc(i1Dec8BitBytes),12) !CRC13 computed from 77 msg bits + + nbadcrc=1 + if(ncrc13.eq.icrc13) nbadcrc=0 + + return +end subroutine chkcrc13a diff --git a/wsjtx_lib/lib/ft8/chkcrc14a.f90 b/wsjtx_lib/lib/ft8/chkcrc14a.f90 new file mode 100644 index 0000000..9ecda9b --- /dev/null +++ b/wsjtx_lib/lib/ft8/chkcrc14a.f90 @@ -0,0 +1,24 @@ +subroutine chkcrc14a(decoded,nbadcrc) + + use crc + integer*1 decoded(91) + integer*1, target:: i1Dec8BitBytes(12) + character*91 cbits + +! Write decoded bits into cbits: 77-bit message plus 14-bit CRC + write(cbits,1000) decoded +1000 format(91i1) + read(cbits,1001) i1Dec8BitBytes +1001 format(12b8) + read(cbits,1002) ncrc14 !Received CRC14 +1002 format(77x,b14) + + i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),transfer(128+64+32+16+8,0_1)) + i1Dec8BitBytes(11:12)=0 + icrc14=crc14(c_loc(i1Dec8BitBytes),12) !CRC14 computed from 77 msg bits + + nbadcrc=1 + if(ncrc14.eq.icrc14) nbadcrc=0 + + return +end subroutine chkcrc14a diff --git a/wsjtx_lib/lib/ft8/chkdec.f90 b/wsjtx_lib/lib/ft8/chkdec.f90 new file mode 100644 index 0000000..7a5e761 --- /dev/null +++ b/wsjtx_lib/lib/ft8/chkdec.f90 @@ -0,0 +1,161 @@ +program chkdec + + parameter(NMAX=100) + character*88 line + character*37 msg(NMAX),msg0,msg1 + character*2 c2(NMAX) + character*1 c1(NMAX) + character*1 only + integer nsnr(NMAX,0:1),nf(NMAX,0:1) + real dt(NMAX,0:1) + logical found,eof + +! These files are sorted by freq within each Rx sequence + open(10,file='all.wsjtx',status='old') + open(11,file='all.jtdx',status='old') + write(20,1030) +1030 format(' iseq B w j W W+ J E B w j W', & + ' W+ J E'/80('-')) + + nutc0=-1 + nbt=0 !Both + nwt=0 !WSJT-X only + njt=0 !JTDX only + net=0 !Either + n7t=0 !a7 + eof=.false. + + do iseq=1,9999 + j=0 + msg=' ' + nsnr=-99 + nf=-99 + dt=-99 + c1=' ' + c2=' ' + do i=1,NMAX + read(10,'(a88)',end=8) line !Read from the WSJT-X file + if(line(25:30).ne.'Rx FT8') cycle !Ignore any line not an FT8 decode + read(line(8:13),*) nutc + if(nutc0.lt.0) nutc0=nutc !First time only + if(nutc.ne.nutc0) then + backspace(10) + go to 10 !Finished WSJT-X for this sequence + endif + j=j+1 + if(j.eq.1) then + nf(j,0)=-1 + j=j+1 + endif + read(line,1001) nsnr(j,0),dt(j,0),nf(j,0),msg(j),c2(j) +1001 format(30x,i7,f5.1,i5,1x,a36,2x,a2) +! if(nutc.eq.180215 .and. c2(j).eq.'a7') print*,'aaa',j,nf(j,0),c2(j) + nutc0=nutc + enddo ! i + +8 eof=.true. +10 jz=j + do i=1,NMAX + read(11,'(a88)',end=20) line !Read from the JTDX file + if(line(31:31).ne.'~') cycle !Ignore any line not an FT8 decode + read(line(10:15),*) nutc + if(nutc.ne.nutc0) then + backspace(11) + go to 20 !Finished JTDX for this sequence + endif + msg1=line(33:58) + read(line(25:29),*) nf1 + found=.false. + do j=1,jz + if(msg(j).eq.msg1) then + read(line,1002) nsnr(j,1),dt(j,1),nf(j,1),c1(j) +1002 format(15x,i4,f5.1,i5,29x,a1) + found=.true. + exit + endif + i1=index(msg(j),'<') + if(i1.gt.0) then + i2=index(msg(j),'>') + msg0=msg(j)(1:i1-1)//msg(j)(i1+1:i2-1)//msg(j)(i2+1:) + if(msg0.eq.msg1) then + read(line,1002) nsnr(j,1),dt(j,1),nf(j,1),c1(j) + found=.true. + exit + endif + endif + enddo ! j + + if(.not.found) then !Insert this one as a new message + do j=1,jz + if(nf1.ge.nf(j,0) .and. nf1.lt.nf(j+1,0)) then + jj=j+1 + exit + endif + enddo + do j=jz+1,jj+1,-1 + nsnr(j,0)=nsnr(j-1,0) + dt(j,0)=dt(j-1,0) + nf(j,0)=nf(j-1,0) + msg(j)=msg(j-1) + c1(j)=c1(j-1) + c2(j)=c2(j-1) + enddo ! j + read(line,1004) nsnr(jj,1),dt(jj,1),nf(jj,1),msg(jj),c1(jj) +1004 format(15x,i4,f5.1,i5,3x,a26,a1) + c2(jj)=' ' + nsnr(jj,0)=-99 + dt(jj,0)=-99.0 + nf(jj,0)=-99 + jz=jz+1 + endif + enddo ! i + +20 nb=0 + nw=0 + nj=0 + ne=0 + n7=0 + do j=2,jz + write(line,1020) nutc0,j,nsnr(j,:),dt(j,:),nf(j,:),msg(j)(1:26), & + c2(j),c1(j) +1020 format(i6.6,i3,1x,2i4,1x,2f6.1,1x,2i5,1x,a26,1x,a2,1x,a1) + if(c2(j).eq.'a7') n7=n7+1 + only=' ' + if(line(12:14).eq.'-99') then + line(12:14)=' ' + only='j' + nj=nj+1 +! if(c2(j).eq.'a7') print*,'aaa ',trim(line) + endif + if(line(16:18).eq.'-99') then + line(16:18)=' ' + only='w' + nw=nw+1 + endif + if(line(12:14).ne.' ' .or. line(16:19).ne.' ') ne=ne+1 + if(line(12:14).ne.' ' .and. line(16:19).ne.' ') nb=nb+1 + if(line(21:25).eq.'-99.0') line(21:25)=' ' + if(line(27:31).eq.'-99.0') line(27:31)=' ' + if(line(35:37).eq.'-99') line(35:37)=' ' + if(line(40:42).eq.'-99') line(40:42)=' ' +! if(line(12:14).ne.' ') nw=nw+1 +! if(line(16:18).ne.' ') nj=nj+1 + write(*,'(a74,1x,a1)') line(1:74),only + enddo ! j + + nbt=nbt+nb + nwt=nwt+nw + n7t=n7t+n7 + njt=njt+nj + net=net+ne + nutc0=nutc + write(*,*) + + write(20,1031) iseq,nb,nw,nj,nb+nw-n7,nb+nw,nb+nj,ne,nbt,nwt,njt, & + nbt+nwt-n7t,nbt+nwt,nbt+njt,net +1031 format(i5,2x,7i4,2x,7i6) + if(eof) exit +! if(iseq.eq.2) exit + enddo ! iseq + +end program chkdec diff --git a/wsjtx_lib/lib/ft8/compress.f90 b/wsjtx_lib/lib/ft8/compress.f90 new file mode 100644 index 0000000..683fc4d --- /dev/null +++ b/wsjtx_lib/lib/ft8/compress.f90 @@ -0,0 +1,37 @@ +subroutine compress(c) + + parameter (NMAX=15*12000) !Samples in iwave (180,000) + complex c(0:NMAX-1) + real xr(0:NMAX-1),xi(0:NMAX-1) + + xr=real(c) + call wavestats(xr,NMAX,rms,pk,pwr_pk,pwr_ave) + xr=xr/rms + xi=aimag(c)/rms + + do i=0,NMAX-1 + c(i)=rms*cmplx(h1(xr(i)),h1(xi(i))) + enddo + +! par=pwr_pk/pwr_ave +! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par +!1010 format(i3,2f10.3,3f10.2) +! call wavestats(xi,NMAX,rms,pk,pwr_pk,pwr_ave) +! par=pwr_pk/pwr_ave +! write(*,1010) 5,rms,pk,pwr_pk,pwr_ave,par + + return +end subroutine compress + +subroutine wavestats(x,kz,rms,pk,pwr_pk,pwr_ave) + + real x(kz) + + sumsq=dot_product(x,x) + rms=sqrt(sumsq/kz) + pk=max(maxval(x),-minval(x)) + pwr_pk=pk*pk + pwr_ave=sumsq/kz + + return +end subroutine wavestats diff --git a/wsjtx_lib/lib/ft8/decode174_91.f90 b/wsjtx_lib/lib/ft8/decode174_91.f90 new file mode 100644 index 0000000..134864d --- /dev/null +++ b/wsjtx_lib/lib/ft8/decode174_91.f90 @@ -0,0 +1,155 @@ +subroutine decode174_91(llr,Keff,maxosd,norder,apmask,message91,cw,ntype,nharderror,dmin) +! +! A hybrid bp/osd decoder for the (174,91) code. +! +! maxosd<0: do bp only +! maxosd=0: do bp and then call osd once with channel llrs +! maxosd>1: do bp and then call osd maxosd times with saved bp outputs +! norder : osd decoding depth +! + integer, parameter:: N=174, K=91, M=N-K + integer*1 cw(N),apmask(N) + integer*1 nxor(N),hdec(N) + integer*1 message91(91),m96(96) + integer nrw(M),ncw + 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),zsum(N),zsave(N,3) + real llr(N) + real Tmn + + include "ldpc_174_91_c_parity.f90" + + maxiterations=30 + nosd=0 + if(maxosd.gt.3) maxosd=3 + if(maxosd.eq.0) then ! osd with channel llrs + nosd=1 + zsave(:,1)=llr + elseif(maxosd.gt.0) then ! + nosd=maxosd + elseif(maxosd.lt.0) then ! just bp + nosd=0 + endif + + 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 + zsum=0.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 + zsum=zsum+zn + if(iter.gt.0 .and. iter.le.maxosd) then + zsave(:,iter)=zsum + endif + +! 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 + enddo + if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it + m96=0 + m96(1:77)=cw(1:77) + m96(83:96)=cw(78:91) + call get_crc14(m96,96,nbadcrc) + nharderror=count( (2*cw-1)*llr .lt. 0.0 ) + if(nbadcrc.eq.0) then + message91=cw(1:91) + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + dmin=sum(nxor*abs(llr)) + ntype=1 + 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 + exit + 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 ! bp iterations + + do i=1,nosd + zn=zsave(:,i) + call osd174_91(zn,Keff,apmask,norder,message91,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)) + ntype=2 + return + endif + enddo + + ntype=0 + nharderror=-1 + dminosd=0.0 + + return +end subroutine decode174_91 diff --git a/wsjtx_lib/lib/ft8/encode174.f90 b/wsjtx_lib/lib/ft8/encode174.f90 new file mode 100644 index 0000000..599f106 --- /dev/null +++ b/wsjtx_lib/lib/ft8/encode174.f90 @@ -0,0 +1,50 @@ +subroutine encode174(message,codeword) +! Encode an 87-bit message and return a 174-bit codeword. +! The generator matrix has dimensions (87,87). +! The code is a (174,87) 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_174_87_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,11 + read(g(i)( (j-1)*2+1:(j-1)*2+2 ),"(Z2)") istr + do jj=1, 8 + icol=(j-1)*8+jj + if( icol .le. 87 ) then + if( btest(istr,8-jj) ) gen(i,icol)=1 + endif + 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 encode174 diff --git a/wsjtx_lib/lib/ft8/encode174_91.f90 b/wsjtx_lib/lib/ft8/encode174_91.f90 new file mode 100644 index 0000000..5bae7d5 --- /dev/null +++ b/wsjtx_lib/lib/ft8/encode174_91.f90 @@ -0,0 +1,58 @@ +subroutine encode174_91(message77,codeword) +! +! Add a 14-bit CRC to a 77-bit message and return a 174-bit codeword +! + use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_loc,c_size_t + use crc + + integer, parameter:: N=174, K=91, M=N-K + character*91 tmpchar + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message77(77),message(K) + integer*1 pchecks(M) + integer*1, target :: i1MsgBytes(12) + include "ldpc_174_91_c_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,23 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.23) ibmax=3 + do jj=1, ibmax + icol=(j-1)*4+jj + if( btest(istr,4-jj) ) gen(i,icol)=1 + enddo + enddo + enddo + first=.false. + endif + +! Add 14-bit CRC to form 91-bit message+CRC14 + write(tmpchar,'(77i1)') message77 + tmpchar(78:80)='000' + i1MsgBytes=0 + read(tmpchar,'(10b8)') i1MsgBytes(1:10) + ncrc14 = crc14 (c_loc (i1MsgBytes), 12) + write(tmpchar(78:91),'(b14)') ncrc14 + read(tmpchar,'(91i1)') message + + 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_91 diff --git a/wsjtx_lib/lib/ft8/encode174_91_nocrc.f90 b/wsjtx_lib/lib/ft8/encode174_91_nocrc.f90 new file mode 100644 index 0000000..82d1669 --- /dev/null +++ b/wsjtx_lib/lib/ft8/encode174_91_nocrc.f90 @@ -0,0 +1,47 @@ +subroutine encode174_91_nocrc(message,codeword) +! +! Encode a 91-bit message and return a 174-bit codeword. +! + use, intrinsic :: iso_c_binding + use iso_c_binding, only: c_loc,c_size_t + use crc + + integer, parameter:: N=174, K=91, M=N-K + integer*1 codeword(N) + integer*1 gen(M,K) + integer*1 message(K) + integer*1 pchecks(M) + include "ldpc_174_91_c_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,23 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.23) ibmax=3 + 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_91_nocrc diff --git a/wsjtx_lib/lib/ft8/filt8.f90 b/wsjtx_lib/lib/ft8/filt8.f90 new file mode 100644 index 0000000..12626fb --- /dev/null +++ b/wsjtx_lib/lib/ft8/filt8.f90 @@ -0,0 +1,52 @@ +subroutine filt8(f0,nslots,width,wave) + + parameter (NFFT=180000,NH=NFFT/2) + real wave(NFFT) + real x(NFFT) + real s1(0:NH) + real s2(0:NH) + complex cx(0:NH) + equivalence (x,cx) + + x=wave + call four2a(cx,NFFT,1,-1,0) !r2c + df=12000.0/NFFT + fa=f0 - 0.5*6.25 + fb=f0 + 7.5*6.25 + (nslots-1)*60.0 + ia2=nint(fa/df) + ib1=nint(fb/df) + ia1=nint(ia2-width/df) + ib2=nint(ib1+width/df) + pi=4.0*atan(1.0) + do i=ia1,ia2 + fil=(1.0 + cos(pi*df*(i-ia2)/width))/2.0 + cx(i)=fil*cx(i) + enddo + do i=ib1,ib2 + fil=(1.0 + cos(pi*df*(i-ib1)/width))/2.0 + cx(i)=fil*cx(i) + enddo + cx(0:ia1-1)=0. + cx(ib2+1:)=0. + + call four2a(cx,nfft,1,1,-1) !c2r + wave=x/nfft + +!### + if(nslots.ne.99) return + x=wave + call four2a(cx,NFFT,1,-1,0) !r2c + do i=0,NH + s1(i)=real(cx(i))**2 + aimag(cx(i))**2 + enddo + nadd=20 + call smo(s1,NH+1,s2,nadd) + do i=0,NH + freq=i*df + write(29,3101) freq,db(s2(i)) - 72.0 +3101 format(2f12.3) + enddo +!### + + return +end subroutine filt8 diff --git a/wsjtx_lib/lib/ft8/foxfilt.f90 b/wsjtx_lib/lib/ft8/foxfilt.f90 new file mode 100644 index 0000000..18b9fbe --- /dev/null +++ b/wsjtx_lib/lib/ft8/foxfilt.f90 @@ -0,0 +1,36 @@ +subroutine foxfilt(nslots,nfreq,width,wave) + + parameter (NN=79,ND=58,KK=87,NSPS=4*1920) + parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2) + real wave(NWAVE) + real x(NFFT) + complex cx(0:NH) + equivalence (x,cx) + + x(1:NWAVE)=wave + x(NWAVE+1:)=0. + call four2a(cx,NFFT,1,-1,0) !r2c + df=48000.0/NFFT + fa=nfreq - 0.5*6.25 + fb=nfreq + 7.5*6.25 + (nslots-1)*60.0 + ia2=nint(fa/df) + ib1=nint(fb/df) + ia1=nint(ia2-width/df) + ib2=nint(ib1+width/df) + pi=4.0*atan(1.0) + do i=ia1,ia2 + fil=(1.0 + cos(pi*df*(i-ia2)/width))/2.0 + cx(i)=fil*cx(i) + enddo + do i=ib1,ib2 + fil=(1.0 + cos(pi*df*(i-ib1)/width))/2.0 + cx(i)=fil*cx(i) + enddo + cx(0:ia1-1)=0. + cx(ib2+1:)=0. + + call four2a(cx,nfft,1,1,-1) !c2r + wave=x(1:NWAVE)/nfft + + return +end subroutine foxfilt diff --git a/wsjtx_lib/lib/ft8/foxgen.f90 b/wsjtx_lib/lib/ft8/foxgen.f90 new file mode 100644 index 0000000..a609673 --- /dev/null +++ b/wsjtx_lib/lib/ft8/foxgen.f90 @@ -0,0 +1,72 @@ +subroutine foxgen() + + ! Called from MainWindow::foxTxSequencer() to generate the Tx waveform in + ! FT8 Fox mode. The Tx message can contain up to 5 "slots", each carrying + ! its own FT8 signal. + + ! Encoded messages can be of the form "HoundCall FoxCall rpt" (a standard FT8 + ! message with i3bit=0) or "HoundCall_1 RR73; HoundCall_2 rpt", + ! a new message type with i3bit=1. The waveform is generated with + ! fsample=48000 Hz; it is compressed to reduce the PEP-to-average power ratio, + ! with (currently disabled) filtering afterware to reduce spectral growth. + + ! Input message information is provided in character array cmsg(5), in + ! common/foxcom/. The generated wave(NWAVE) is passed back in the same + ! common block. + + parameter (NN=79,ND=58,NSPS=4*1920) + parameter (NWAVE=(160+2)*134400*4) !the biggest waveform we generate (FST4-1800 at 48kHz) + parameter (NFFT=614400,NH=NFFT/2) + character*40 cmsg + character*37 msg,msgsent + integer itone(79) + integer*1 msgbits(77),msgbits2 + integer*1, target:: mycall + real x(NFFT) + real*8 dt,twopi,f0,fstep,dfreq,phi,dphi + complex cx(0:NH) + common/foxcom/wave(NWAVE),nslots,nfreq,i3bit(5),cmsg(5),mycall(12) + common/foxcom2/itone2(NN),msgbits2(77) + equivalence (x,cx),(y,cy) + + fstep=60.d0 + dfreq=6.25d0 + dt=1.d0/48000.d0 + twopi=8.d0*atan(1.d0) + irpt=0 + nplot=0 + wave=0. + + do n=1,nslots + msg=cmsg(n)(1:37) + call genft8(msg,i3,n3,msgsent,msgbits,itone) +! Make copies of itone() and msgbits() for ft8sim + itone2=itone + msgbits2=msgbits + f0=nfreq + fstep*(n-1) + phi=0.d0 + k=0 + do j=1,NN + f=f0 + dfreq*itone(j) + dphi=twopi*f*dt + do ii=1,NSPS + k=k+1 + phi=phi+dphi + xphi=phi + wave(k)=wave(k)+sin(xphi) + enddo + enddo + enddo + kz=k + + peak1=maxval(abs(wave)) + wave=wave/peak1 + width=50.0 + call foxfilt(nslots,nfreq,width,wave) + peak3=maxval(abs(wave)) + wave=wave/peak3 + + return +end subroutine foxgen + +! include 'plotspec.f90' diff --git a/wsjtx_lib/lib/ft8/foxgen_wrap.f90 b/wsjtx_lib/lib/ft8/foxgen_wrap.f90 new file mode 100644 index 0000000..6be1a3f --- /dev/null +++ b/wsjtx_lib/lib/ft8/foxgen_wrap.f90 @@ -0,0 +1,25 @@ +subroutine foxgen_wrap(msg40,msgbits,itone) + + parameter (NN=79,ND=58,KK=77,NSPS=4*1920) + parameter (NWAVE=(160+2)*134400*4) !the biggest waveform we generate (FST4-1800) + + character*40 msg40,cmsg + character*12 mycall12 + integer*1 msgbits(KK),msgbits2 + integer itone(NN) + common/foxcom/wave(NWAVE),nslots,nfreq,i3bit(5),cmsg(5),mycall12 + common/foxcom2/itone2(NN),msgbits2(KK) + + nslots=1 + nfreq=300 + i1=index(msg40,'<') + i2=index(msg40,'>') + mycall12=msg40(i1+1:i2-1)//' ' + cmsg(1)=msg40 + i3bit(1)=1 + call foxgen() + msgbits=msgbits2 + itone=itone2 + + return +end subroutine foxgen_wrap diff --git a/wsjtx_lib/lib/ft8/ft8_a7.f90 b/wsjtx_lib/lib/ft8/ft8_a7.f90 new file mode 100644 index 0000000..7c7f028 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8_a7.f90 @@ -0,0 +1,421 @@ +module ft8_a7 + + parameter(MAXDEC=200) + +! For the following three arrays +! First index i=decode number in this sequence +! Second index j=0 or 1 for even or odd sequence +! Third index k=0 or 1 for previous or current tally for this j + real dt0(MAXDEC,0:1,0:1) !dt0(i,j,k) + real f0(MAXDEC,0:1,0:1) !f0(i,j,k) + character*37 msg0(MAXDEC,0:1,0:1) !msg0(i,j,k) + + integer itone_a7(79) + integer jseq !even=0, odd=1 + integer ndec(0:1,0:1) !ndec(j,k) + data ndec/4*0/,jseq/0/ + +contains + +subroutine ft8_a7_save(jseq,dt,f,msg) + + use packjt77 + character*37 msg,msg1 + character*13 w(19) + character*4 g4 + integer nw(19) + logical isgrid4 + +! Statement function: + isgrid4(g4)=(len_trim(g4).eq.4 .and. & + ichar(g4(1:1)).ge.ichar('A') .and. ichar(g4(1:1)).le.ichar('R') .and. & + ichar(g4(2:2)).ge.ichar('A') .and. ichar(g4(2:2)).le.ichar('R') .and. & + ichar(g4(3:3)).ge.ichar('0') .and. ichar(g4(3:3)).le.ichar('9') .and. & + ichar(g4(4:4)).ge.ichar('0') .and. ichar(g4(4:4)).le.ichar('9')) + + if(index(msg,'/').ge.1 .or. index(msg,'<').ge.1) go to 999 + call split77(msg,nwords,nw,w) !Parse msg into words + if(nwords.lt.1) go to 999 + if(w(1)(1:3).eq.'CQ_') go to 999 + j=jseq + +! Add this decode to current table for this sequence + ndec(j,1)=ndec(j,1)+1 !Number of decodes in this sequence + i=ndec(j,1) !i is index of a new table entry + if(i.gt.MAXDEC) return !Prevent table overflow (indexes start at 1) + + dt0(i,j,1)=dt !Save dt in table + f0(i,j,1)=f !Save f in table + msg0(i,j,1)=trim(w(1))//' '//trim(w(2)) !Save "call_1 call_2" + if(w(1)(1:3).eq.'CQ ' .and. nw(2).le.2) then + msg0(i,j,1)='CQ '//trim(w(2))//' '//trim(w(3)) !Save "CQ DX Call_2" + endif + msg1=msg0(i,j,1) !Message without grid + nn=len(trim(msg1)) !Message length without grid +! Include grid as part of message + if(isgrid4(w(nwords))) msg0(i,j,1)=trim(msg0(i,j,1))//' '//trim(w(nwords)) + +! If a transmission at this frequency with message fragment "call_1 call_2" +! was decoded in the previous sequence, flag it as "DO NOT USE" because +! we have already decoded and subtracted that station's next transmission. + + call split77(msg0(i,j,1),nwords,nw,w) !Parse msg into words + do i=1,ndec(j,0) + if(f0(i,j,0).le.-98.0) cycle + i2=index(msg0(i,j,0),' '//trim(w(2))) + if(abs(f-f0(i,j,0)).le.3.0 .and. i2.ge.3) then + f0(i,j,0)=-98.0 !Flag as "do not use" for a potential a7 decode + endif + enddo + +999 return +end subroutine ft8_a7_save + +subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,xbase,nharderrors,dmin, & + msg37,xsnr) + +! Examine the raw data in dd0() for possible "a7" decodes. + + use crc + use timer_module, only: timer + use packjt77 + include 'ft8_params.f90' + parameter(NP2=2812) + character*37 msg37,msg,msgsent,msgbest + character*12 call_1,call_2 + character*4 grid4 + real a(5) + real s8(0:7,NN) + real s2(0:511) + real dmm(206) + real bmeta(174),bmetb(174),bmetc(174),bmetd(174) + real llra(174),llrb(174),llrc(174),llrd(174) !Soft symbols + real dd0(15*12000) + real ss(9) + real rcw(174) + integer*1 cw(174) + integer*1 msgbits(77) + integer*1 nxor(174),hdec(174) + integer itone(NN) + integer icos7(0:6),ip(1) + logical one(0:511,0:8) + integer graymap(0:7) + integer iloc(1) + complex cd0(0:3199) + complex ctwk(32) + complex csymb(32) + complex cs(0:7,NN) + logical std_1,std_2 + logical first,newdat + data icos7/3,1,4,0,6,5,2/ !Sync array + data first/.true./ + data graymap/0,1,3,2,5,6,4,7/ + save one + + if(first) then + one=.false. + do i=0,511 + do j=0,8 + if(iand(i,2**j).ne.0) one(i,j)=.true. + enddo + enddo + first=.false. + endif + + call stdcall(call_1,std_1) + if(call_1(1:3).eq.'CQ ') std_1=.true. + call stdcall(call_2,std_2) + + fs2=12000.0/NDOWN + dt2=1.0/fs2 + twopi=8.0*atan(1.0) + delfbest=0. + ibest=0 + + call timer('ft8_down',0) + call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal + smax=0.0 + do idt=i0-10,i0+10 !Search over +/- one quarter symbol + call sync8d(cd0,idt,ctwk,0,sync) !NB: ctwk not used here + if(sync.gt.smax) then + smax=sync + ibest=idt + endif + enddo + +! Peak up in frequency + smax=0.0 + do ifr=-5,5 !Search over +/- 2.5 Hz + delf=ifr*0.5 + dphi=twopi*delf*dt2 + phi=0.0 + do i=1,32 + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + call sync8d(cd0,ibest,ctwk,1,sync) + if( sync .gt. smax ) then + smax=sync + delfbest=delf + endif + enddo + a=0.0 + a(1)=-delfbest + call twkfreq1(cd0,NP2,fs2,a,cd0) + f1=f1+delfbest !Improved estimate of DF + + call timer('ft8_down',0) + call ft8_downsample(dd0,.false.,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + smax=0.0 + do idt=-4,4 !Search over +/- one quarter symbol + call sync8d(cd0,ibest+idt,ctwk,0,sync) + ss(idt+5)=sync + enddo + smax=maxval(ss) + iloc=maxloc(ss) + ibest=iloc(1)-5+ibest + xdt=(ibest-1)*dt2 - 0.5 + sync=smax + + do k=1,NN + i1=ibest+(k-1)*32 + csymb=cmplx(0.0,0.0) + if( i1.ge.0 .and. i1+31 .le. NP2-1 ) csymb=cd0(i1:i1+31) + call four2a(csymb,32,1,-1,1) + cs(0:7,k)=csymb(1:8)/1e3 + s8(0:7,k)=abs(csymb(1:8)) + enddo + +! sync quality check + is1=0 + is2=0 + is3=0 + do k=1,7 + ip=maxloc(s8(:,k)) + if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s8(:,k+36)) + if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s8(:,k+72)) + if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1 + enddo +! hard sync sum - max is 21 + nsync=is1+is2+is3 +! if(nsync .le. 6) return ! bail out + + do nsym=1,3 + nt=2**(3*nsym) + do ihalf=1,2 + do k=1,29,nsym + if(ihalf.eq.1) ks=k+7 + if(ihalf.eq.2) ks=k+43 + amax=-1.0 + do i=0,nt-1 + i1=i/64 + i2=iand(i,63)/8 + i3=iand(i,7) + if(nsym.eq.1) then + s2(i)=abs(cs(graymap(i3),ks)) + elseif(nsym.eq.2) then + s2(i)=abs(cs(graymap(i2),ks)+cs(graymap(i3),ks+1)) + elseif(nsym.eq.3) then + s2(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2)) + else + print*,"Error - nsym must be 1, 2, or 3." + endif + enddo + i32=1+(k-1)*3+(ihalf-1)*87 + if(nsym.eq.1) ibmax=2 + if(nsym.eq.2) ibmax=5 + if(nsym.eq.3) ibmax=8 + 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(i32+ib .gt.174) cycle + if(nsym.eq.1) then + bmeta(i32+ib)=bm + den=max(maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)), & + maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))) + if(den.gt.0.0) then + cm=bm/den + else ! erase it + cm=0.0 + endif + bmetd(i32+ib)=cm + elseif(nsym.eq.2) then + bmetb(i32+ib)=bm + elseif(nsym.eq.3) then + bmetc(i32+ib)=bm + endif + enddo + enddo + enddo + enddo + call normalizebmet(bmeta,174) + call normalizebmet(bmetb,174) + call normalizebmet(bmetc,174) + call normalizebmet(bmetd,174) + + scalefac=2.83 + llra=scalefac*bmeta + llrb=scalefac*bmetb + llrc=scalefac*bmetc + llrd=scalefac*bmetd + +! apmag=maxval(abs(llra))*1.01 + + MAXMSG=206 + pbest=0. + dmin=1.e30 + nharderrors=-1 + + do imsg=1,MAXMSG + msg=trim(call_1)//' '//trim(call_2) + i=imsg + if(call_1(1:3).eq.'CQ ' .and. i.ne.5) msg='QU1RK '//trim(call_2) + if(.not.std_1) then + if(i.eq.1 .or. i.ge.6) msg='<'//trim(call_1)//'> '//trim(call_2) + if(i.ge.2 .and. i.le.4) msg=trim(call_1)//' <'//trim(call_2)//'>' + else if(.not.std_2) then + if(i.le.4 .or. i.eq.6) msg='<'//trim(call_1)//'> '//trim(call_2) + if(i.ge.7) msg=trim(call_1)//' <'//trim(call_2)//'>' + endif + j0=len(trim(msg))+2 + if(i.eq.2) msg(j0:j0+2)='RRR' + if(i.eq.3) msg(j0:j0+3)='RR73' + if(i.eq.4) msg(j0:j0+1)='73' + if(i.eq.5) then + if(std_2) then + msg='CQ '//trim(call_2) + if(call_1(3:3).eq.'_') msg=trim(call_1)//' '//trim(call_2) + if(grid4.ne.'RR73') msg=trim(msg)//' '//grid4 + endif + if(.not.std_2) msg='CQ '//trim(call_2) + endif + if(i.eq.6 .and. std_2) msg(j0:j0+3)=grid4 + if(i.ge.7) then + isnr = -50 + (i-7)/2 + if(iand(i,1).eq.1) then + write(msg(j0:j0+2),'(i3.2)') isnr + if(msg(j0:j0).eq.' ') msg(j0:j0)='+' + else + write(msg(j0:j0+3),'("R",i3.2)') isnr + if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+' + endif + endif + + i3=-1 + n3=-1 + call genft8(msg,i3,n3,msgsent,msgbits,itone) !Source-encode this message + call encode174_91(msgbits,cw) !Get codeword for this message + rcw=2*cw-1 + pow=0.0 + do i=1,79 + pow=pow+s8(itone(i),i)**2 + enddo + + hdec=0 + where(llra.ge.0.0) hdec=1 + nxor=ieor(hdec,cw) + da=sum(nxor*abs(llra)) + + hdec=0 + where(llrb.ge.0.0) hdec=1 + nxor=ieor(hdec,cw) + dbb=sum(nxor*abs(llrb)) + + hdec=0 + where(llrc.ge.0.0) hdec=1 + nxor=ieor(hdec,cw) + dc=sum(nxor*abs(llrc)) + + hdec=0 + where(llrd.ge.0.0) hdec=1 + nxor=ieor(hdec,cw) + dd=sum(nxor*abs(llrd)) + + dm=min(da,dbb,dc,dd) + dmm(imsg)=dm + if(dm.lt.dmin) then + dmin=dm + msgbest=msgsent + pbest=pow + if(dm.eq.da) then + nharderrors=count((2*cw-1)*llra.lt.0.0) + else if(dm.eq.dbb) then + nharderrors=count((2*cw-1)*llrb.lt.0.0) + else if(dm.eq.dc) then + nharderrors=count((2*cw-1)*llrc.lt.0.0) + else if(dm.eq.dd) then + nharderrors=count((2*cw-1)*llrd.lt.0.0) + endif + endif + + enddo ! imsg + + iloc=minloc(dmm) + dmm(iloc(1))=1.e30 + iloc=minloc(dmm) + dmin2=dmm(iloc(1)) + xsnr=-25. + arg=pbest/xbase/3.0e6-1.0 + if(arg.gt.0.0) xsnr=max(-25.0,db(arg)-27.0) +! write(41,3041) nharderrors,dmin,dmin2,dmin2/dmin,xsnr,trim(msgbest) +!3041 format(i3,2f7.1,f7.2,f7.1,1x,a) + if(dmin.gt.100.0 .or. dmin2/dmin.lt.1.3) nharderrors=-1 + msg37=msgbest + if(msg37(1:3).eq.'CQ ' .and. std_2 .and. grid4.eq.' ') nharderrors=-1 + if(msg37(1:6).eq.'QU1RK ') nharderrors=-1 + + return +end subroutine ft8_a7d + +subroutine getmsg(i,mycall,hiscall,hisgrid,msg) + + character*12 mycall,hiscall + character*6 hisgrid + character*37 msg + logical my_std,his_std + + call stdcall(mycall,my_std) + call stdcall(hiscall,his_std) + + isnr=0 + msg=trim(mycall)//' '//trim(hiscall) + if(.not.my_std) then + if(i.eq.1 .or. i.ge.6) msg='<'//trim(mycall)//'> '//trim(hiscall) + if(i.ge.2 .and. i.le.4) msg=trim(mycall)//' <'//trim(hiscall)//'>' + else if(.not.his_std) then + if(i.le.4 .or. i.eq.6) msg='<'//trim(mycall)//'> '//trim(hiscall) + if(i.ge.7) msg=trim(mycall)//' <'//trim(hiscall)//'>' + endif + j0=len(trim(msg))+2 + if(i.eq.2) msg(j0:j0+2)='RRR' + if(i.eq.3) msg(j0:j0+3)='RR73' + if(i.eq.4) msg(j0:j0+1)='73' + if(i.eq.5) then + if(his_std) msg='CQ '//trim(hiscall)//' '//hisgrid(1:4) + if(.not.his_std) msg='CQ '//trim(hiscall) + endif + if(i.eq.6 .and. his_std) msg(j0:j0+3)=hisgrid(1:4) + if(i.ge.7 .and. i.le.206) then + isnr = -50 + (i-7)/2 + if(iand(i,1).eq.1) then + write(msg(j0:j0+2),'(i3.2)') isnr + if(msg(j0:j0).eq.' ') msg(j0:j0)='+' + else + write(msg(j0:j0+3),'("R",i3.2)') isnr + if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+' + endif + endif + + if(abs(isnr).gt.30) msg='' + + return +end subroutine getmsg + +end module ft8_a7 diff --git a/wsjtx_lib/lib/ft8/ft8_a8d.f90 b/wsjtx_lib/lib/ft8/ft8_a8d.f90 new file mode 100644 index 0000000..3fb1a07 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8_a8d.f90 @@ -0,0 +1,188 @@ +subroutine ft8_a8d(dd,mycall,dxcall,dxgrid,f1a,xdt,fbest,xsnr,plog,msgbest) + +! List decoding for FT8, activated only at nfqso (Rx Freq) +/- 10 Hz and when +! DxCall and DxGrid are populated. Returns xdt, fbest, and msgbest. + + use packjt77 + use ft8_a7 + use timer_module, only: timer + include 'ft8_params.f90' !Set various constants + parameter (NWAVE=NN*NSPS/NDOWN) !Length of generated cwave = 2528 + parameter (NZZ=3200) !Length of downsampled arrays + parameter (NFFT=NZZ,NH=NFFT/2) !FFT length + parameter (NMSGS=206) !Number of messages to be tried + parameter (PLOG_MIN=-160.0) !Minimum log probability + character mycall*12,dxcall*12,dxgrid*6 + character*37 msg,msgsent,msgbest + character*77 c77 + integer*1 msgbits(77) + real xjunk(NZZ) + real s(-NH:NH) !Power spectrum of cd0 +! real s00(-NH:NH) !Raw spectrum of downsampled data + real s0(-NH:NH) !Best-fit re-centered spectrum for this msg + real s1(-NH:NH) !Overall best-fit re-centered spectrum + real s8(0:7) !Spectrum of a single symbol + real dd(NMAX) !Floating point copy of iwave + real a(5) + complex cwave(0:NZZ-1) !Complex waveform corresponding to msg + complex cd(0:NZZ-1) !Data from dd, now complex and sampled at 200 Hz + complex cd0(0:NZZ-1) !All tones in cd nominally shifted to 0 Hz + complex csymb(0:31) + integer itone(NN) + integer itone_best(NN) + integer ipk(1) + logical newdat + + f1=f1a + newdat=.true. +! Mix from f1 to baseband and downsample from dd into cd (complex, 200 Hz sampling) + call ft8_downsample(dd,newdat,f1,cd) + fac=1.e-6 + + fsd=200.0 !Downsampled rate (Hz) + bt=2.0 !Gaussian smoothing parameter + dt=1.0/fsd + df=200.0/NFFT + s=0. + ss=0. + sq=0. + +! Find the message that fits the received waveform best + sbest=0. + tbest=0. + fbest=0. + msgbest='' + itone_best=0 + do imsg=1,NMSGS + call getmsg(imsg,mycall,dxcall,dxgrid,msg) + +! Source-encode the message, get itone(), and generate complex FT8 waveform. + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + call genft8(msg,i3,n3,msgsent,msgbits,itone) + call gen_ft8wave(itone,NN,32,bt,fsd,0.0,cwave,xjunk,1,NWAVE) + cwave(NWAVE:)=0. + +! For this message, find the best lag + spk=0. + fpk=0. + tpk=0. + lagpk=0 + lag1=-200 + lag2=200 + lagstep=4 + do iter=1,2 + if(iter.eq.2) then + lag1=lagpk-8 + lag2=lagpk+8 + lagstep=1 + endif + do lag=lag1,lag2,lagstep + do i=0,NWAVE-1 + j=i+lag + 100 + cd0(i)=0. + if(j.ge.0 .and. j.le.NWAVE-1) cd0(i)=cd(j)*conjg(cwave(i)) + enddo + + cd0(NWAVE:)=0. + call four2a(cd0,NFFT,1,-1,1) !Forward c2c FFT + + do i=0,NFFT-1 + j=i + if(i.gt.NH) j=i-NFFT + s(j)=fac*(real(cd0(i))**2 + aimag(cd0(i))**2) + enddo + + call smo121(s,NFFT+1) + + smax=0. + do j=-NH,NH + smax=max(s(j),smax) + if(s(j).gt.spk) then + spk=s(j) + fpk=j*df + f1 + lagpk=lag + tpk=lag*dt + s0=s !Save best-fit spectrum for this msg + endif + enddo ! j + enddo ! lag + enddo ! iter + + if(spk.gt.sbest) then + sbest=spk + fbest=fpk + tbest=tpk + msgbest=msg + itone_best=itone + s1=s0 !Save overall best-fit spectrum + endif + enddo ! imsg + + a=0 + a(1)=f1-fbest +! if(abs(a(1)+5.0).gt.10.0) then !Effective Ftol = 10 Hz + if(abs(a(1)).gt.5.0) then !Effective Ftol = 5 Hz + msgbest='' + return + endif + call twkfreq1(cd,NZZ,200.0,a,cd) !Re-center the spectrum + + xdt=tbest + ave=(sum(s1(-200:-100)) + sum(s1(100:200)))/202.0 + s1=s1/ave - 1.0 + s1pk=maxval(s1(-32:32)) + sig=0. + nsig=0 + do i=-32,32 + if(s1(i).lt.0.5*s1pk) cycle + sig=sig+s1(i) + nsig=nsig+1 + enddo + sig=sig/nsig + xsnr=db(sig)-35.0 + if(xsnr.lt.-30) xsnr=-30 !Set min SNR for 'a8' decodes + + if(msgbest.ne.'') then +! Compute probability of successful decode. + plog=0.0 + nhard=0 + nsum=0 + sum_sync=0. + sum_sig=0. + sum_big=0. + do k=1,NN + i0=32*(k-1) + nint((tbest+0.5)/0.005) + csymb=0. + do i=0,31 + if(i0+i.ge.0 .and. i0+i.le.NZZ-1) csymb(i)=cd(i0+i) + enddo + call four2a(csymb,32,1,-1,1) !c2c + do i=0,7 + s8(i)=real(csymb(i))**2 + aimag(csymb(i))**2 + enddo + s8sum=sum(s8) + if(s8sum.gt.0.0) then + p=s8(itone_best(k))/s8sum + plog=plog + log(p) + nsum=nsum+1 + endif + ipk=maxloc(s8)-1 + if(ipk(1).ne.itone_best(k)) nhard=nhard+1 + if(k.le.7 .or. (k.ge.37 .and. k.le.43) .or. k.ge.73) then + sum_sync=sum_sync + s8(itone_best(k)) + else + sum_sig=sum_sig + s8(itone_best(k)) + endif + sum_big=sum_big + s8(ipk(1)) + enddo + if(nsum.lt.NN) plog=plog + (NN-nsum)*log(0.125) + sigobig=(sum_sync+sum_sig)/sum_big +! write(60,3060) nsum,xdt,fbest,xsnr,plog,nhard,sigosync,sigobig,trim(msgbest) +!3060 format(i2,f8.3,3f8.1,i5,2f7.2,1x,a) + if(nhard.gt.54 .or. plog.lt.-159.0 .or. sigobig.lt.0.71) msgbest='' + endif + + return +end subroutine ft8_a8d diff --git a/wsjtx_lib/lib/ft8/ft8_downsample.f90 b/wsjtx_lib/lib/ft8/ft8_downsample.f90 new file mode 100644 index 0000000..587fb4d --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8_downsample.f90 @@ -0,0 +1,51 @@ +subroutine ft8_downsample(dd,newdat,f0,c1) + +! Downconvert to complex data sampled at 200 Hz ==> 32 samples/symbol + + parameter (NMAX=15*12000,NSPS=1920) + parameter (NFFT1=192000,NFFT2=3200) !192000/60 = 3200 + + logical newdat,first + complex c1(0:NFFT2-1) + complex cx(0:NFFT1/2) + real dd(NMAX),x(NFFT1+2),taper(0:100) + data first/.true./ + save x,cx,first,taper + equivalence (x,cx) + + if(first) then + pi=4.0*atan(1.0) + do i=0,100 + taper(i)=0.5*(1.0+cos(i*pi/100)) + enddo + first=.false. + endif + if(newdat) then +! Data in dd have changed, recompute the long FFT + x(1:NMAX)=dd + x(NMAX+1:NFFT1+2)=0. !Zero-pad the x array + call four2a(cx,NFFT1,1,-1,0) !r2c FFT to freq domain + newdat=.false. + endif + df=12000.0/NFFT1 + baud=12000.0/NSPS + i0=nint(f0/df) + ft=f0+8.5*baud + it=min(nint(ft/df),NFFT1/2) + fb=f0-1.5*baud + ib=max(1,nint(fb/df)) + k=0 + c1=0. + do i=ib,it + c1(k)=cx(i) + k=k+1 + enddo + c1(0:100)=c1(0:100)*taper(100:0:-1) + c1(k-1-100:k-1)=c1(k-1-100:k-1)*taper + c1=cshift(c1,i0-ib) + call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain + fac=1.0/sqrt(float(NFFT1)*NFFT2) + c1=fac*c1 + + return +end subroutine ft8_downsample diff --git a/wsjtx_lib/lib/ft8/ft8_params.f90 b/wsjtx_lib/lib/ft8/ft8_params.f90 new file mode 100644 index 0000000..139ff96 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8_params.f90 @@ -0,0 +1,12 @@ +! LDPC (174,91) code +parameter (KK=91) !Information bits (77 + CRC14) +parameter (ND=58) !Data symbols +parameter (NS=21) !Sync symbols (3 @ Costas 7x7) +parameter (NN=NS+ND) !Total channel symbols (79) +parameter (NSPS=1920) !Samples per symbol at 12000 S/s +parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680) +parameter (NMAX=15*12000) !Samples in iwave (180,000) +parameter (NFFT1=2*NSPS, 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=60) !Downsample factor diff --git a/wsjtx_lib/lib/ft8/ft8_testmsg.f90 b/wsjtx_lib/lib/ft8/ft8_testmsg.f90 new file mode 100644 index 0000000..253641d --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8_testmsg.f90 @@ -0,0 +1,51 @@ + parameter (MAXTEST=75,NTEST=48) + character*37 testmsg(MAXTEST) + data testmsg(1:NTEST)/ & + "TNX BOB 73 GL", & ! 0.0 + "K1ABC RR73; W9XYZ -08", & ! 0.1 + "PA9XYZ 590003 IO91NP", & ! 0.2 + "G4ABC/P R 570007 JO22DB", & ! 0.2 + "K1ABC W9XYZ 6A WI", & ! 0.3 + "W9XYZ K1ABC R 17B EMA", & ! 0.3 + "123456789ABCDEF012", & ! 0.5 + "CQ K1ABC FN42", & ! 1. + "K1ABC W9XYZ EN37", & ! 1. + "W9XYZ K1ABC -11", & ! 1. + "K1ABC W9XYZ R-09", & ! 1. + "W9XYZ K1ABC RRR", & ! 1. + "K1ABC W9XYZ 73", & ! 1. + "K1ABC W9XYZ RR73", & ! 1. + "CQ FD K1ABC FN42", & ! 1. + "CQ TEST K1ABC/R FN42", & ! 1. + "K1ABC/R W9XYZ EN37", & ! 1. + "W9XYZ K1ABC/R R FN42", & ! 1. + "K1ABC/R W9XYZ RR73", & ! 1. + "CQ TEST K1ABC FN42", & ! 1. + "W9XYZ -11", & ! 1. + " W9XYZ R-09", & ! 1. + "CQ W9XYZ EN37", & ! 1. + " W9XYZ -11", & ! 1. + "W9XYZ R-09", & ! 1. + " KA1ABC", & ! 1. + "KA1ABC -11", & ! 1. + " KA1ABC R-17", & ! 1. + " KA1ABC 73", & ! 1. + "CQ G4ABC/P IO91", & ! 2. + "G4ABC/P PA9XYZ JO22", & ! 2. + "PA9XYZ G4ABC/P RR73", & ! 2. + "K1ABC W9XYZ 579 WI", & ! 3. + "W9XYZ K1ABC R 589 MA", & ! 3. + "K1ABC KA0DEF 559 MO", & ! 3. + "TU; KA0DEF K1ABC R 569 MA", & ! 3. + "KA1ABC G3AAA 529 0013", & ! 3. + "TU; G3AAA K1ABC R 559 MA", & ! 3. + "CQ KH1/KH7Z", & ! 4. + "CQ PJ4/K1ABC", & ! 4. + "PJ4/K1ABC ", & ! 4. + " PJ4/K1ABC RRR", & ! 4. + "PJ4/K1ABC 73", & ! 4. + " YW18FIFA", & ! 4. + "YW18FIFA RRR", & ! 4. + " YW18FIFA 73", & ! 4. + "CQ YW18FIFA", & ! 4. + " YW18FIFA RR73"/ diff --git a/wsjtx_lib/lib/ft8/ft8apset.f90 b/wsjtx_lib/lib/ft8/ft8apset.f90 new file mode 100644 index 0000000..73a224e --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8apset.f90 @@ -0,0 +1,62 @@ +subroutine ft8apset(mycall12,hiscall12,ncontest,apsym,aph10) + use packjt77 + character*77 c77 + character*37 msg,msgchk + character*12 mycall12,hiscall12,hiscall + character*13 hc13 + character*10 c10 + integer apsym(58),aph10(10) + logical nohiscall,unpk77_success,std + + apsym=0 + apsym(1)=99 + apsym(30)=99 + aph10=0 + aph10(1)=99 + if(len(trim(mycall12)).lt.3) return + + nohiscall=.false. + hiscall=hiscall12 + if(len(trim(hiscall)).lt.3) then + hiscall='KA1ABC' !Use a dummy hiscall + nohiscall=.true. + else + hc13=hiscall + n10=0 + n12=0 + n22=0 + call save_hash_call(hc13,n10,n12,n22) + write(c10,'(b10.10)') iand(n10,Z'3FF') + read(c10,'(10i1.1)',err=1) aph10 + aph10=2*aph10-1 + endif + +! Encode a dummy standard message: i3=1, 28 1 28 1 1 15 +! + msg=trim(mycall12)//' '//trim(hiscall)//' RRR' + call stdcall(mycall12,std) + if(.not.std) msg='<'//trim(mycall12)//'> '//trim(hiscall)//' RRR' + i3=0 + n3=0 + call pack77(msg,i3,n3,c77) + call unpack77(c77,1,msgchk,unpk77_success) + if(ncontest.eq.7.and. (i3.ne.1 .or. .not.unpk77_success)) return + if(ncontest.le.5.and. (i3.ne.1 .or. msg.ne.msgchk .or. .not.unpk77_success)) return + + read(c77,'(58i1)',err=2) apsym(1:58) + apsym=2*apsym-1 + if(nohiscall) then + apsym(30)=99 + aph10(1)=99 + endif + return + +1 aph10=0 + aph10(1)=99 + return +2 apsym=0 + apsym(1)=99 + apsym(30)=99 + return + +end subroutine ft8apset diff --git a/wsjtx_lib/lib/ft8/ft8b.f90 b/wsjtx_lib/lib/ft8/ft8b.f90 new file mode 100644 index 0000000..43ac33b --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8b.f90 @@ -0,0 +1,530 @@ +subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,nzhsym,lapon, & + lapcqonly,napwid,lsubtract,nagain,ncontest,imetric,iaptype,mycall12,hiscall12, & + f1,xdt,xbase,apsym,aph10,nharderrors,dmin,nbadcrc,ipass, & + msg37,xsnr,itone) + + use crc + use timer_module, only: timer + use packjt77 + include 'ft8_params.f90' + parameter(NP2=2812) + character*37 msg37 + character*12 mycall12,hiscall12 + character*77 c77 + real a(5) + real s8(0:7,NN) + real s2(0:511) + real bmeta(174),bmetb(174),bmetc(174),bmetd(174),bmete(174) + real llra(174),llrb(174),llrc(174),llrd(174),llre(174),llrz(174) !Soft symbols + real dd0(15*12000) + real ss(9) + real temp(3) + integer*1 message77(77),message91(91),apmask(174),cw(174) + integer apsym(58),aph10(10) + integer mcq(29),mcqru(29),mcqfd(29),mcqtest(29),mcqww(29) + integer mrrr(19),m73(19),mrr73(19) + integer itone(NN) + integer icos7(0:6),ip(1) + integer nappasses(0:5) !Number of decoding passes to use for each QSO state + integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now + integer ncontest,ncontest0 + logical one(0:511,0:8) + integer graymap(0:7) + integer iloc(1) + complex cd0(0:3199) + complex ctwk(32) + complex csymb(32) + complex cs(0:7,NN) + logical first,newdat,lsubtract,lapon,lapcqonly,nagain,unpk77_success + data icos7/3,1,4,0,6,5,2/ ! Flipped w.r.t. original FT8 sync array + data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ + data mcqru/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,1,1,0,0/ + data mcqfd/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0/ + data mcqtest/0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,1,1,1,1,1,1,0,0,1,0/ + data mcqww/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,1,1,0/ + data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ + data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ + data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/ + data first/.true./ + data graymap/0,1,3,2,5,6,4,7/ + save nappasses,naptypes,ncontest0,one + + if(first.or.(ncontest.ne.ncontest0)) then + mcq=2*mcq-1 + mcqfd=2*mcqfd-1 + mcqru=2*mcqru-1 + mcqtest=2*mcqtest-1 + mcqww=2*mcqww-1 + mrrr=2*mrrr-1 + m73=2*m73-1 + mrr73=2*mrr73-1 + nappasses(0)=2 + nappasses(1)=2 + nappasses(2)=2 + nappasses(3)=4 + nappasses(4)=4 + nappasses(5)=3 + +! iaptype +!------------------------ +! 1 CQ ??? ??? (29+3=32 ap bits) +! 2 MyCall ??? ??? (29+3=32 ap bits) +! 3 MyCall DxCall ??? (58+3=61 ap bits) +! 4 MyCall DxCall RRR (77 ap bits) +! 5 MyCall DxCall 73 (77 ap bits) +! 6 MyCall DxCall RR73 (77 ap bits) + + naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ) + naptypes(1,1:4)=(/2,3,0,0/) ! Tx1 + naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 + naptypes(3,1:4)=(/3,4,5,6/) ! Tx3 + naptypes(4,1:4)=(/3,4,5,6/) ! Tx4 + naptypes(5,1:4)=(/3,1,2,0/) ! Tx5 + + one=.false. + do i=0,511 + do j=0,8 + if(iand(i,2**j).ne.0) one(i,j)=.true. + enddo + enddo + first=.false. + ncontest0=ncontest + endif + + dxcall13=hiscall12 ! initialize for use in packjt77 + mycall13=mycall12 + + max_iterations=30 + nharderrors=-1 + fs2=12000.0/NDOWN + dt2=1.0/fs2 + twopi=8.0*atan(1.0) + delfbest=0. + ibest=0 + + call timer('ft8_down',0) + call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal + smax=0.0 + do idt=i0-10,i0+10 !Search over +/- one quarter symbol + call sync8d(cd0,idt,ctwk,0,sync) + if(sync.gt.smax) then + smax=sync + ibest=idt + endif + enddo + +! Now peak up in frequency + smax=0.0 + do ifr=-5,5 !Search over +/- 2.5 Hz + delf=ifr*0.5 + dphi=twopi*delf*dt2 + phi=0.0 + do i=1,32 + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + call sync8d(cd0,ibest,ctwk,1,sync) + if( sync .gt. smax ) then + smax=sync + delfbest=delf + endif + enddo + a=0.0 + a(1)=-delfbest + call twkfreq1(cd0,NP2,fs2,a,cd0) + f1=f1+delfbest !Improved estimate of DF + + call timer('ft8_down',0) + call ft8_downsample(dd0,.false.,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + smax=0.0 + do idt=-4,4 !Search over +/- one quarter symbol + call sync8d(cd0,ibest+idt,ctwk,0,sync) + ss(idt+5)=sync + enddo + smax=maxval(ss) + iloc=maxloc(ss) + ibest=iloc(1)-5+ibest + xdt=(ibest-1)*dt2 + sync=smax + + do k=1,NN + i1=ibest+(k-1)*32 + csymb=cmplx(0.0,0.0) + if( i1.ge.0 .and. i1+31 .le. NP2-1 ) csymb=cd0(i1:i1+31) + call four2a(csymb,32,1,-1,1) + cs(0:7,k)=csymb(1:8)/1e3 + s8(0:7,k)=abs(csymb(1:8)) + enddo + +! sync quality check + is1=0 + is2=0 + is3=0 + do k=1,7 + ip=maxloc(s8(:,k)) + if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s8(:,k+36)) + if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s8(:,k+72)) + if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1 + enddo +! hard sync sum - max is 21 + nsync=is1+is2+is3 + syncmin=6 + if(imetric.eq.2) syncmin=7 + if(ndepth.le.2) syncmin=8 + if(nsync.le.syncmin) then ! bail out + nbadcrc=1 + return + endif + + do nsym=1,3 + nt=2**(3*nsym) + do ihalf=1,2 + do k=1,29,nsym + if(ihalf.eq.1) ks=k+7 + if(ihalf.eq.2) ks=k+43 + amax=-1.0 + do i=0,nt-1 + i1=i/64 + i2=iand(i,63)/8 + i3=iand(i,7) + if(nsym.eq.1) then + s2(i)=abs(cs(graymap(i3),ks)) + elseif(nsym.eq.2) then + s2(i)=abs(cs(graymap(i2),ks)+cs(graymap(i3),ks+1)) + elseif(nsym.eq.3) then + s2(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2)) + else + print*,"Error - nsym must be 1, 2, or 3." + endif + enddo + if(imetric.eq.2) s2=s2**2 + i32=1+(k-1)*3+(ihalf-1)*87 + if(nsym.eq.1) ibmax=2 + if(nsym.eq.2) ibmax=5 + if(nsym.eq.3) ibmax=8 + 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(i32+ib .gt.174) cycle + if(nsym.eq.1) then + bmeta(i32+ib)=bm + den=max(maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)), & + maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))) + if(den.gt.0.0) then + cm=bm/den + else ! erase it + cm=0.0 + endif + bmetd(i32+ib)=cm + elseif(nsym.eq.2) then + bmetb(i32+ib)=bm + elseif(nsym.eq.3) then + bmetc(i32+ib)=bm + endif + enddo + enddo + enddo + enddo + do i=1,174 + temp(1)=bmeta(i) + temp(2)=bmetb(i) + temp(3)=bmetc(i) + ip=maxloc(abs(temp)) + bmete(i)=temp(ip(1)) + enddo + + call normalizebmet(bmeta,174) + call normalizebmet(bmetb,174) + call normalizebmet(bmetc,174) + call normalizebmet(bmetd,174) + call normalizebmet(bmete,174) + + scalefac=2.83 + llra=scalefac*bmeta + llrb=scalefac*bmetb + llrc=scalefac*bmetc + llrd=scalefac*bmetd + llre=scalefac*bmete + +! pass # +!------------------------------ +! 1 regular decoding, nsym=1 +! 2 regular decoding, nsym=2 +! 3 regular decoding, nsym=3 +! 4 regular decoding, nsym=1, bit-by-bit normalized +! 5 regular decoding, choose best (largest) metric from 1-3 +! 6 ap pass 1, nsym=1 +! 7 ap pass 1, nsym=2 +! 8 ap pass 2, nsym=1 +! 9 ap pass 2, nsym=2 +! 10 ap pass 3, nsym=1 +! 11 ap pass 3, nsym=2 +! 12 ap pass 4, nsym=1 +! 13 ap pass 4, nsym=2 + + if(lapon.or.ncontest.eq.7) then !Hounds always use AP + if(.not.lapcqonly) then + npasses=5+2*nappasses(nQSOProgress) + else + npasses=7 + endif + else + npasses=5 + endif + if(nzhsym.lt.50) npasses=5 + + do ipass=1,npasses + llrz=llra + if(ipass.eq.2) llrz=llrb + if(ipass.eq.3) llrz=llrc + if(ipass.eq.4) llrz=llrd + if(ipass.eq.5) llrz=llre + if(ipass.le.5) then + apmask=0 + iaptype=0 + endif + if(ipass .gt. 5) then + llrz=llra + if(mod(ipass-5,2).eq.1) llrz=llra + if(mod(ipass-5,2).eq.0) llrz=llrc + apmag=maxval(abs(llrz))*1.1 + if(.not.lapcqonly) then + iaptype=naptypes(nQSOProgress,(ipass-4)/2) + else + iaptype=1 + endif + +! ncontest=0 : NONE +! 1 : NA_VHF +! 2 : EU_VHF +! 3 : FIELD DAY +! 4 : RTTY +! 5 : WW_DIGI +! 6 : FOX +! 7 : HOUND +! 8 : ARRL_DIGI +! +! Conditions that cause us to bail out of AP decoding + if(ncontest.le.5 .and. iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle + if(ncontest.eq.6) cycle ! No AP for Foxes + if(ncontest.eq.7.and.f1.gt.950.0) cycle ! Hounds use AP only for signals below 950 Hz + if(iaptype.ge.2 .and. apsym(1).gt.1) cycle ! No, or nonstandard, mycall + if(ncontest.eq.7 .and. iaptype.ge.2 .and. aph10(1).gt.1) cycle + if(iaptype.ge.3 .and. apsym(30).gt.1) cycle ! No, or nonstandard, dxcall + + if(iaptype.eq.1) then ! CQ or CQ RU or CQ TEST or CQ FD + apmask=0 + apmask(1:29)=1 + if(ncontest.eq.0) llrz(1:29)=apmag*mcq(1:29) + if(ncontest.eq.1) llrz(1:29)=apmag*mcqtest(1:29) + if(ncontest.eq.2) llrz(1:29)=apmag*mcqtest(1:29) + if(ncontest.eq.3) llrz(1:29)=apmag*mcqfd(1:29) + if(ncontest.eq.4) llrz(1:29)=apmag*mcqru(1:29) + if(ncontest.eq.5) llrz(1:29)=apmag*mcqww(1:29) + if(ncontest.eq.7) llrz(1:29)=apmag*mcq(1:29) + if(ncontest.eq.8) llrz(1:29)=apmag*mcqtest(1:29) + apmask(75:77)=1 + llrz(75:76)=apmag*(-1) + llrz(77)=apmag*(+1) + endif + + if(iaptype.eq.2) then ! MyCall,???,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.5.or.ncontest.eq.8) then + apmask(1:29)=1 + llrz(1:29)=apmag*apsym(1:29) + apmask(75:77)=1 + llrz(75:76)=apmag*(-1) + llrz(77)=apmag*(+1) + else if(ncontest.eq.2) then + apmask(1:28)=1 + llrz(1:28)=apmag*apsym(1:28) + apmask(72:74)=1 + llrz(72)=apmag*(-1) + llrz(73)=apmag*(+1) + llrz(74)=apmag*(-1) + apmask(75:77)=1 + llrz(75:77)=apmag*(-1) + else if(ncontest.eq.3) then + apmask(1:28)=1 + llrz(1:28)=apmag*apsym(1:28) + apmask(75:77)=1 + llrz(75:77)=apmag*(-1) + else if(ncontest.eq.4) then + apmask(2:29)=1 + llrz(2:29)=apmag*apsym(1:28) + apmask(75:77)=1 + llrz(75)=apmag*(-1) + llrz(76:77)=apmag*(+1) + else if(ncontest.eq.7) then ! ??? RR73; MyCall ??? + apmask(29:56)=1 + llrz(29:56)=apmag*apsym(1:28) + apmask(57:66)=1 + llrz(57:66)=apmag*aph10(1:10) + apmask(72:77)=1 + llrz(72:73)=apmag*(-1) + llrz(74)=apmag*(+1) + llrz(75:77)=apmag*(-1) + endif + endif + + if(iaptype.eq.3) then ! MyCall,DxCall,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2.or.ncontest.eq.5.or.ncontest.eq.7.or.ncontest.eq.8) then + apmask(1:58)=1 + llrz(1:58)=apmag*apsym + apmask(75:77)=1 + llrz(75:76)=apmag*(-1) + llrz(77)=apmag*(+1) + else if(ncontest.eq.3) then ! Field Day + apmask(1:56)=1 + llrz(1:28)=apmag*apsym(1:28) + llrz(29:56)=apmag*apsym(30:57) + apmask(72:74)=1 + apmask(75:77)=1 + llrz(75:77)=apmag*(-1) + else if(ncontest.eq.4) then + apmask(2:57)=1 + llrz(2:29)=apmag*apsym(1:28) + llrz(30:57)=apmag*apsym(30:57) + apmask(75:77)=1 + llrz(75)=apmag*(-1) + llrz(76:77)=apmag*(+1) + endif + endif + + if(iaptype.eq.5.and.ncontest.eq.7) cycle !Hound + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then + apmask=0 + if(ncontest.le.5 .or. (ncontest.eq.7.and.iaptype.eq.6) .or. ncontest.eq.8) then + apmask(1:77)=1 ! mycall, hiscall, RRR|73|RR73 + llrz(1:58)=apmag*apsym + if(iaptype.eq.4) llrz(59:77)=apmag*mrrr + if(iaptype.eq.5) llrz(59:77)=apmag*m73 + if(iaptype.eq.6) llrz(59:77)=apmag*mrr73 + else if(ncontest.eq.7.and.iaptype.eq.4) then ! Hound listens for MyCall RR73;... + apmask(1:28)=1 + llrz(1:28)=apmag*apsym(1:28) + apmask(57:66)=1 + llrz(57:66)=apmag*aph10(1:10) + apmask(72:77)=1 + llrz(72:73)=apmag*(-1) + llrz(74)=apmag*(1) + llrz(75:77)=apmag*(-1) + endif + endif + endif + + cw=0 + dmin=0.0 + norder=2 + maxosd=2 + if(ndepth.eq.1) maxosd=-1 ! BP only +! if(ndepth.eq.2) maxosd=0 ! uncoupled BP+OSD + if(ndepth.eq.3 .and. & + (abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid .or. ncontest.eq.7)) then + maxosd=2 + endif + call timer('dec174_91 ',0) + Keff=91 + call decode174_91(llrz,Keff,maxosd,norder,apmask,message91,cw, & + ntype,nharderrors,dmin) + if(nharderrors.ge.0) message77=message91(1:77) + call timer('dec174_91 ',1) + + msg37=' ' + nbadcrc=1 + if(nharderrors.lt.0 .or. nharderrors.gt.36) cycle + if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword + write(c77,'(77i1)') message77 + read(c77(72:74),'(b3)') n3 + read(c77(75:77),'(b3)') i3 + if(i3.gt.5 .or. (i3.eq.0.and.n3.gt.6)) cycle + if(i3.eq.0 .and. n3.eq.2) cycle + call unpack77(c77,1,msg37,unpk77_success) + if(.not.unpk77_success .or. index(msg37,'/R').gt.0 .or. & + msg37(1:4).eq.'TU; ') then + if(i3.ge.1 .and. i3.le.3 .and. ncontest.eq.0) cycle + endif + if(.not.unpk77_success) cycle +! If we get this far: valid codeword, valid (i3,n3), nonquirky message. + nbadcrc=0 + call get_ft8_tones_from_77bits(message77,itone) + if(lsubtract) then + call timer('sub_ft8a',0) + call subtractft8(dd0,itone,f1,xdt,.false.) + call timer('sub_ft8a',1) + endif + xsig=0.0 + xnoi=0.0 + do i=1,79 + xsig=xsig+s8(itone(i),i)**2 + ios=mod(itone(i)+4,7) + xnoi=xnoi+s8(ios,i)**2 + enddo + xsnr=0.001 + xsnr2=0.001 + arg=xsig/xnoi-1.0 + if(arg.gt.0.1) xsnr=arg + arg=xsig/xbase/3.0e6-1.0 + if(arg.gt.0.1) xsnr2=arg + xsnr=10.0*log10(xsnr)-27.0 + xsnr2=10.0*log10(xsnr2)-27.0 + if(.not.nagain) then + xsnr=xsnr2 + endif + if(nsync.le.10 .and. xsnr.lt.-25.0) then !bail out, likely false decode + nbadcrc=1 + return + endif + if(xsnr .lt. -25.0) xsnr=-25.0 + return + enddo + return +end subroutine ft8b + +subroutine normalizebmet(bmet,n) + real bmet(n) + + bmetav=sum(bmet)/real(n) + bmet2av=sum(bmet*bmet)/real(n) + var=bmet2av-bmetav*bmetav + if( var .gt. 0.0 ) then + bmetsig=sqrt(var) + else + bmetsig=sqrt(bmet2av) + endif + bmet=bmet/bmetsig + return +end subroutine normalizebmet + + +function bessi0(x) +! From Numerical Recipes + real bessi0,x + double precision p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9,y + save p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9 + data p1,p2,p3,p4,p5,p6,p7/1.0d0,3.5156229d0,3.0899424d0,1.2067492d0, & + 0.2659732d0,0.360768d-1,0.45813d-2/ + data q1,q2,q3,q4,q5,q6,q7,q8,q9/0.39894228d0,0.1328592d-1, & + 0.225319d-2,-0.157565d-2,0.916281d-2,-0.2057706d-1, & + 0.2635537d-1,-0.1647633d-1,0.392377d-2/ + + if (abs(x).lt.3.75) then + y=(x/3.75)**2 + bessi0=p1+y*(p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7))))) + else + ax=abs(x) + y=3.75/ax + bessi0=(exp(ax)/sqrt(ax))*(q1+y*(q2+y*(q3+y*(q4 & + +y*(q5+y*(q6+y*(q7+y*(q8+y*q9)))))))) + endif + return +end function bessi0 diff --git a/wsjtx_lib/lib/ft8/ft8c.f90 b/wsjtx_lib/lib/ft8/ft8c.f90 new file mode 100644 index 0000000..a7d1ccb --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8c.f90 @@ -0,0 +1,261 @@ +subroutine ft8c(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, & + msg37,xsnr) + + use crc + use timer_module, only: timer + use packjt77 + include 'ft8_params.f90' + parameter(NP2=2812) + character*37 msg37,msg,msgsent,msgbest + character*12 call_1,call_2 + character*4 grid4 + real a(5) + real s8(0:7,NN) + real s2(0:511) + real bmeta(174),bmetb(174),bmetc(174),bmetd(174) + real llra(174),llrb(174),llrc(174),llrd(174),llrbest(174) !Soft symbols + real dd0(15*12000) + real ss(9) + real rcw(174) + integer*1 cw(174) + integer*1 msgbits(77) + integer*1 nxor(174),hdec(174) + integer itone(NN) + integer icos7(0:6),ip(1) + logical one(0:511,0:8) + integer graymap(0:7) + integer iloc(1) + complex cd0(0:3199) + complex ctwk(32) + complex csymb(32) + complex cs(0:7,NN) + logical std_1,std_2 + logical first,newdat + data icos7/3,1,4,0,6,5,2/ ! Flipped w.r.t. original FT8 sync array + data first/.true./ + data graymap/0,1,3,2,5,6,4,7/ + save one + + if(first) then + one=.false. + do i=0,511 + do j=0,8 + if(iand(i,2**j).ne.0) one(i,j)=.true. + enddo + enddo + first=.false. + endif + + call stdcall(call_1,std_1) + if(call_1(1:3).eq.'CQ ') std_1=.true. + call stdcall(call_2,std_2) + + nharderrors=-1 + fs2=12000.0/NDOWN + dt2=1.0/fs2 + twopi=8.0*atan(1.0) + delfbest=0. + ibest=0 + + call timer('ft8_down',0) + call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal + smax=0.0 + do idt=i0-10,i0+10 !Search over +/- one quarter symbol + call sync8d(cd0,idt,ctwk,0,sync) + if(sync.gt.smax) then + smax=sync + ibest=idt + endif + enddo + +! Now peak up in frequency + smax=0.0 + do ifr=-5,5 !Search over +/- 2.5 Hz + delf=ifr*0.5 + dphi=twopi*delf*dt2 + phi=0.0 + do i=1,32 + ctwk(i)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + enddo + call sync8d(cd0,ibest,ctwk,1,sync) + if( sync .gt. smax ) then + smax=sync + delfbest=delf + endif + enddo + a=0.0 + a(1)=-delfbest + call twkfreq1(cd0,NP2,fs2,a,cd0) + f1=f1+delfbest !Improved estimate of DF + + call timer('ft8_down',0) + call ft8_downsample(dd0,.false.,f1,cd0) !Mix f1 to baseband and downsample + call timer('ft8_down',1) + + smax=0.0 + do idt=-4,4 !Search over +/- one quarter symbol + call sync8d(cd0,ibest+idt,ctwk,0,sync) + ss(idt+5)=sync + enddo + smax=maxval(ss) + iloc=maxloc(ss) + ibest=iloc(1)-5+ibest + xdt=(ibest-1)*dt2 - 0.5 + sync=smax + + do k=1,NN + i1=ibest+(k-1)*32 + csymb=cmplx(0.0,0.0) + if( i1.ge.0 .and. i1+31 .le. NP2-1 ) csymb=cd0(i1:i1+31) + call four2a(csymb,32,1,-1,1) + cs(0:7,k)=csymb(1:8)/1e3 + s8(0:7,k)=abs(csymb(1:8)) + enddo + +! sync quality check + is1=0 + is2=0 + is3=0 + do k=1,7 + ip=maxloc(s8(:,k)) + if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1 + ip=maxloc(s8(:,k+36)) + if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1 + ip=maxloc(s8(:,k+72)) + if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1 + enddo +! hard sync sum - max is 21 + nsync=is1+is2+is3 +! if(nsync .le. 6) return ! bail out + + do nsym=1,3 + nt=2**(3*nsym) + do ihalf=1,2 + do k=1,29,nsym + if(ihalf.eq.1) ks=k+7 + if(ihalf.eq.2) ks=k+43 + amax=-1.0 + do i=0,nt-1 + i1=i/64 + i2=iand(i,63)/8 + i3=iand(i,7) + if(nsym.eq.1) then + s2(i)=abs(cs(graymap(i3),ks)) + elseif(nsym.eq.2) then + s2(i)=abs(cs(graymap(i2),ks)+cs(graymap(i3),ks+1)) + elseif(nsym.eq.3) then + s2(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2)) + else + print*,"Error - nsym must be 1, 2, or 3." + endif + enddo + i32=1+(k-1)*3+(ihalf-1)*87 + if(nsym.eq.1) ibmax=2 + if(nsym.eq.2) ibmax=5 + if(nsym.eq.3) ibmax=8 + 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(i32+ib .gt.174) cycle + if(nsym.eq.1) then + bmeta(i32+ib)=bm + den=max(maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)), & + maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))) + if(den.gt.0.0) then + cm=bm/den + else ! erase it + cm=0.0 + endif + bmetd(i32+ib)=cm + elseif(nsym.eq.2) then + bmetb(i32+ib)=bm + elseif(nsym.eq.3) then + bmetc(i32+ib)=bm + endif + enddo + enddo + enddo + enddo + call normalizebmet(bmeta,174) + call normalizebmet(bmetb,174) + call normalizebmet(bmetc,174) + call normalizebmet(bmetd,174) + + scalefac=2.83 + llra=scalefac*bmeta + llrb=scalefac*bmetb + llrc=scalefac*bmetc + llrd=scalefac*bmetd + +! apmag=maxval(abs(llra))*1.01 + + MAXMSG=206 + pbest=0. + do imsg=1,MAXMSG + msg=trim(call_1)//' '//trim(call_2) + i=imsg + if(call_1(1:3).eq.'CQ ' .and. i.ne.5) msg='QQ0XYZ '//trim(call_2) + if(.not.std_1) then + if(i.eq.1 .or. i.ge.6) msg='<'//trim(call_1)//'> '//trim(call_2) + if(i.ge.2 .and. i.le.4) msg=trim(call_1)//' <'//trim(call_2)//'>' + else if(.not.std_2) then + if(i.le.4 .or. i.eq.6) msg='<'//trim(call_1)//'> '//trim(call_2) + if(i.ge.7) msg=trim(call_1)//' <'//trim(call_2)//'>' + endif + j0=len(trim(msg))+2 + if(i.eq.2) msg(j0:j0+2)='RRR' + if(i.eq.3) msg(j0:j0+3)='RR73' + if(i.eq.4) msg(j0:j0+1)='73' + if(i.eq.5) then + if(std_2) then + msg='CQ '//trim(call_2) + if(call_1(3:3).eq.'_') msg=trim(call_1)//' '//trim(call_2) + if(grid4.ne.'RR73') msg=trim(msg)//' '//grid4 + endif + if(.not.std_2) msg='CQ '//trim(call_2) + endif + if(i.eq.6 .and. std_2) msg(j0:j0+3)=grid4 + if(i.ge.7) then + isnr = -50 + (i-7)/2 + if(iand(i,1).eq.1) then + write(msg(j0:j0+2),'(i3.2)') isnr + if(msg(j0:j0).eq.' ') msg(j0:j0)='+' + else + write(msg(j0:j0+3),'("R",i3.2)') isnr + if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+' + endif + endif + +! Source-encode, then get codeword + i3=-1 + n3=-1 + call genft8(msg,i3,n3,msgsent,msgbits,itone) + call encode174_91(msgbits,cw) + rcw=2*cw-1 + pa=sum(llra*rcw) + pb=sum(llrb*rcw) + pc=sum(llrc*rcw) + pd=sum(llrd*rcw) + + if(pa.gt.pbest) then + pbest=pa + msgbest=msgsent + llrbest=llra + nharderrors=count((2*cw-1)*llra.lt.0.0) + hdec=0 + where(llra.ge.0.0) hdec=1 + nxor=ieor(hdec,cw) + dmin=sum(nxor*abs(llra)) + endif + enddo ! imsg + +! write(*,4001) pbest,nharderrors,dmin,trim(msgbest) +!4001 format('$$$',f7.1,i4,f7.1,2x,a) + msg37=msgbest + + return +end subroutine ft8c diff --git a/wsjtx_lib/lib/ft8/ft8code.f90 b/wsjtx_lib/lib/ft8/ft8code.f90 new file mode 100644 index 0000000..219fd2e --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8code.f90 @@ -0,0 +1,105 @@ +program ft8code + +! Provides examples of message packing, LDPC(174,91) encoding, bit and +! symbol ordering, and other details of the FT8 protocol. + + use packjt77 + include 'ft8_params.f90' !Set various constants + include 'ft8_testmsg.f90' + parameter (NWAVE=NN*NSPS) + + character*37 msg,msgsent + character*9 comment + character bad*1,msgtype*18 + integer itone(NN) + integer*1 msgbits(77),codeword(174) + logical short + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.1 .and. nargs.ne.3) then + print* + print*,'Program ft8code: Provides examples of message packing, ', & + 'LDPC(174,91) encoding,' + print*,'bit and symbol ordering, and other details of the FT8 protocol.' + print* + print*,'Usage: ft8code [-c grid] "message" # Results for specified message' + print*,' ft8code -T # Examples of all message types' + print*,' ft8code -t # Short format examples' + go to 999 + endif + + call getarg(1,msg) !Message to be transmitted + short=.false. + if(len(trim(msg)).eq.2 .and. (msg(1:2).eq.'-T' .or. msg(1:2).eq.'-t')) then + nmsg=NTEST + short=msg(1:2).eq.'-t' + else + call fmtmsg(msg,iz) !To upper case; collapse multiple blanks + nmsg=1 + endif + + if(.not.short) write(*,1010) +1010 format(4x,'Message',31x,'Decoded',29x,'Err i3.n3'/100('-')) + + do imsg=1,nmsg + if(nmsg.gt.1) msg=testmsg(imsg) + +! Generate msgsent, msgbits, and itone + i3=-1 + n3=-1 + call genft8(msg,i3,n3,msgsent,msgbits,itone) + call encode174_91(msgbits,codeword) + msgtype="" + if(i3.eq.0) then + if(n3.eq.0) msgtype="Free text" + if(n3.eq.1) msgtype="DXpedition mode" + if(n3.eq.2) msgtype="EU VHF Contest" + if(n3.eq.3) msgtype="ARRL Field Day" + if(n3.eq.4) msgtype="ARRL Field Day" + if(n3.eq.5) msgtype="Telemetry" + if(n3.ge.6) msgtype="Undefined type" + endif + if(i3.eq.1) msgtype="Standard msg" + if(i3.eq.2) msgtype="EU VHF Contest" + if(i3.eq.3) msgtype="ARRL RTTY Roundup" + if(i3.eq.4) msgtype="Nonstandard call" + if(i3.eq.5) msgtype="EU VHF Contest" + if(i3.ge.6) msgtype="Undefined type" + if(i3.ge.1) n3=-1 + bad=" " + comment=' ' + if(msg.ne.msgsent) bad="*" + if(short) then + if(n3.ge.0) then + write(*,1020) i3,n3,msg,bad,msgtype +1020 format(i1,'.',i1,2x,a37,1x,a1,1x,a18) + else + write(*,1022) i3,msg,bad,msgtype +1022 format(i1,'.',3x,a37,1x,a1,1x,a18) + endif + else + if(n3.ge.0) then + write(*,1024) imsg,msg,msgsent,bad,i3,n3,msgtype,comment +1024 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',i1,1x,a18,1x,a9) + else + write(*,1026) imsg,msg,msgsent,bad,i3,msgtype,comment +1026 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',1x,1x,a18,1x,a9) + endif + endif + enddo + + if(nmsg.eq.1) then + write(*,1030) msgbits +1030 format(/'Source-encoded message, 77 bits: ',/77i1) + write(*,1031) codeword(78:91) +1031 format(/'14-bit CRC: ',/14i1) + write(*,1032) codeword(92:174) +1032 format(/'83 Parity bits: ',/83i1) + write(*,1034) itone +1034 format(/'Channel symbols (79 tones):'/ & + ' Sync ',14x,'Data',15x,'Sync',15x,'Data',15x,'Sync'/ & + 7i1,1x,29i1,1x,7i1,1x,29i1,1x,7i1) + endif + +999 end program ft8code diff --git a/wsjtx_lib/lib/ft8/ft8d.f90 b/wsjtx_lib/lib/ft8/ft8d.f90 new file mode 100644 index 0000000..daee7b2 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8d.f90 @@ -0,0 +1,63 @@ +program ft8d + +! Decode FT8 data read from *.wav files. + + include 'ft8_params.f90' + character*12 arg + character infile*80,datetime*13,message*22 + real s(NH1,NHSYM) + real candidate(3,100) + integer ihdr(11) + integer*2 iwave(NMAX) !Generated full-length waveform + real dd(NMAX) + + nargs=iargc() + if(nargs.lt.3) then + print*,'Usage: ft8d MaxIt Norder file1 [file2 ...]' + print*,'Example ft8d 40 2 *.wav' + go to 999 + endif + call getarg(1,arg) + read(arg,*) max_iterations + call getarg(2,arg) + read(arg,*) norder + nfiles=nargs-2 + + twopi=8.0*atan(1.0) + fs=12000.0 !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 (baud) + txt=NZ*dt !Transmission length (s) + nfa=100.0 + nfb=3000.0 + nfqso=1500.0 + + do ifile=1,nfiles + call getarg(ifile+2,infile) + open(10,file=infile,status='old',access='stream') + read(10,end=999) ihdr,iwave + close(10) + j2=index(infile,'.wav') + read(infile(j2-6:j2-1),*) nutc + datetime=infile(j2-13:j2-1) + call sync8(iwave,nfa,nfb,nfqso,s,candidate,ncand) + syncmin=2.0 + dd=iwave + do icand=1,ncand + sync=candidate(3,icand) + if( sync.lt.syncmin) cycle + f1=candidate(1,icand) + xdt=candidate(2,icand) + nsnr=min(99,nint(10.0*log10(sync)-25.5)) + call ft8b(dd,nfqso,f1,xdt,nharderrors,dmin,nbadcrc,message,xsnr) + nsnr=xsnr + xdt=xdt-0.6 + write(*,1110) datetime,0,nsnr,xdt,f1,message,nharderrors,dmin +1110 format(a13,2i4,f6.2,f7.1,' ~ ',a22,i6,f7.1) + enddo + enddo ! ifile loop + +999 end program ft8d + diff --git a/wsjtx_lib/lib/ft8/ft8q3.f90 b/wsjtx_lib/lib/ft8/ft8q3.f90 new file mode 100644 index 0000000..122e49c --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8q3.f90 @@ -0,0 +1,109 @@ +subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr) + +! Get q3-style decodes for FT8. + + use packjt77 + parameter(NN=79,NSPS=32) + parameter(NWAVE=NN*NSPS) !2528 + parameter(NZ=3200,NLAGS=NZ-NWAVE) + character*12 call_1,call_2 + character*4 grid4 + character*37 msg,msgbest,msgsent + character c77*77 + complex cwave(0:NWAVE-1) + complex cd(0:NZ-1) + complex z + real xjunk(NWAVE) + real ccf(0:NLAGS-1) + real ccfmsg(206) + integer itone(NN) + integer*1 msgbits(77) + logical std_1,std_2 + + if(xdt.eq.-99.0) return !Silence compiler warning + call stdcall(call_1,std_1) + call stdcall(call_2,std_2) + + fs=200.0 !Sample rate (Hz) + dt=1.0/fs !Sample interval (s) + bt=2.0 + ccfbest=0. + lagbest=-1 + + do imsg=1,206 + msg=trim(call_1)//' '//trim(call_2) + i=imsg + if(.not.std_1) then + if(i.eq.1 .or. i.ge.6) msg='<'//trim(call_1)//'> '//trim(call_2) + if(i.ge.2 .and. i.le.4) msg=trim(call_1)//' <'//trim(call_2)//'>' + else if(.not.std_2) then + if(i.le.4 .or. i.eq.6) msg='<'//trim(call_1)//'> '//trim(call_2) + if(i.ge.7) msg=trim(call_1)//' <'//trim(call_2)//'>' + endif + j0=len(trim(msg))+2 + if(i.eq.2) msg(j0:j0+2)='RRR' + if(i.eq.3) msg(j0:j0+3)='RR73' + if(i.eq.4) msg(j0:j0+1)='73' + if(i.eq.5) then + if(std_2) msg='CQ '//trim(call_2)//' '//grid4 + if(.not.std_2) msg='CQ '//trim(call_2) + endif + if(i.eq.6 .and. std_2) msg(j0:j0+3)=grid4 + if(i.ge.7 .and. i.le.206) then + isnr = -50 + (i-7)/2 + if(iand(i,1).eq.1) then + write(msg(j0:j0+2),'(i3.2)') isnr + if(msg(j0:j0).eq.' ') msg(j0:j0)='+' + else + write(msg(j0:j0+3),'("R",i3.2)') isnr + if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+' + endif + endif + +! Source-encode, then get itone() + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + call genft8(msg,i3,n3,msgsent,msgbits,itone) +! Generate complex cwave + call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE) + + lagmax=-1 + ccfmax=0. + nsum=32*2 + do lag=0,nlags-1 + z=0. + s=0. + do i=0,NWAVE-1 + z=z + cd(i+lag)*conjg(cwave(i)) + if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then + s=s + abs(z) + z=0. + endif + enddo + ccf(lag)=s + if(ccf(lag).gt.ccfmax) then + ccfmax=ccf(lag) + lagmax=lag + endif + enddo ! lag + ccfmsg(imsg)=ccfmax + if(ccfmax.gt.ccfbest) then + ccfbest=ccfmax + lagbest=lagmax + msgbest=msg + endif + enddo ! imsg + + call pctile(ccfmsg,207,50,base) + call pctile(ccfmsg,207,67,sigma) + sigma=sigma-base + ccfmsg=(ccfmsg-base)/sigma +! do imsg=1,207 +! write(44,3044) imsg,ccfmsg(imsg) +!3044 format(i5,f10.3) +! enddo + snr=maxval(ccfmsg) + + return +end subroutine ft8q3 diff --git a/wsjtx_lib/lib/ft8/ft8sim.f90 b/wsjtx_lib/lib/ft8/ft8sim.f90 new file mode 100644 index 0000000..fd18dff --- /dev/null +++ b/wsjtx_lib/lib/ft8/ft8sim.f90 @@ -0,0 +1,131 @@ +program ft8sim_gfsk + +! Generate simulated "type 2" ft8 files +! Output is saved to a *.wav file. + + use wavhdr + use packjt77 + include 'ft8_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) + complex cwave(0:NWAVE-1) + real wave(NMAX) + real xjunk(NWAVE) + 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.7) then + print*,'Usage: ft8sim "message" f0 DT fdop del nfiles snr' + print*,'Examples: ft8sim "K1ABC W9XYZ EN37" 1500.0 0.0 0.1 1.0 10 -18' + print*,' ft8sim "WA9XYZ/R KA1ABC/R FN42" 1500.0 0.0 0.1 1.0 10 -18' + print*,' ft8sim "K1ABC RR73; W9XYZ -11" 300 0 0 0 25 1 -10' + print*,' ft8sim " R 570007 JO22DB" 1500 0 0 0 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,*) nfiles !Number of files + call getarg(7,arg) + read(arg,*) snrdb !SNR_2500 + + nsig=1 + if(f0.lt.100.0) then + nsig=f0 + f0=1500 + endif + + 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) + bw=8*baud !Occupied bandwidth (Hz) + txt=NZ*dt !Transmission length (s) + bt=2.0 + 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) + call genft8(msg37,i3,n3,msgsent37,msgbits,itone) + call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE) !Generate complex cwave + + write(*,*) + write(*,'(a23,a37,3x,a7,i1,a1,i1)') 'Decoded message: ',msgsent37,'i3.n3: ',i3,'.',n3 + write(*,1000) f0,xdt,txt,snrdb,bw +1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, & + ' BW:',f4.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() + + do ifile=1,nfiles + c0=0. + c0(0:NWAVE-1)=cwave + c0=cshift(c0,-nint((xdt+0.5)/dt)) + if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c0,NMAX,NWAVE,fs,delay,fspread) + c=sig*c0 + + wave=imag(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 ft8sim_gfsk diff --git a/wsjtx_lib/lib/ft8/gen_ft8wave.f90 b/wsjtx_lib/lib/ft8/gen_ft8wave.f90 new file mode 100644 index 0000000..c3ea609 --- /dev/null +++ b/wsjtx_lib/lib/ft8/gen_ft8wave.f90 @@ -0,0 +1,81 @@ +subroutine gen_ft8wave(itone,nsym,nsps,bt,fsample,f0,cwave,wave,icmplx,nwave) +! +! generate ft8 waveform using Gaussian-filtered frequency pulses. +! + use timer_module, only: timer + parameter(MAX_SECONDS=20,NTAB=65536) + real wave(nwave) + complex cwave(nwave),ctab(0:NTAB-1) + real pulse(23040) + real dphi(0:(nsym+2)*nsps-1) + integer itone(nsym) + data fchk0/0.0/ + save pulse,twopi,dt,hmod,fchk0,ctab + + ibt=nint(10*bt) + fchk=nsym+nsps+bt+fsample + if(fchk.ne.fchk0) then + twopi=8.0*atan(1.0) + dt=1.0/fsample + hmod=1.0 +! Compute the frequency-smoothing pulse + do i=1,3*nsps + tt=(i-1.5*nsps)/real(nsps) + pulse(i)=gfsk_pulse(bt,tt) + enddo + do i=0,NTAB-1 + phi=i*twopi/NTAB + ctab(i)=cmplx(cos(phi),sin(phi)) + enddo + fchk0=fchk + endif + +! Compute the smoothed frequency waveform. +! Length = (nsym+2)*nsps samples, first and last symbols extended + 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 +! Add dummy symbols at beginning and end with tone values equal to 1st and last symbol, respectively + dphi(0:2*nsps-1)=dphi(0:2*nsps-1)+dphi_peak*itone(1)*pulse(nsps+1:3*nsps) + dphi(nsym*nsps:(nsym+2)*nsps-1)=dphi(nsym*nsps:(nsym+2)*nsps-1)+dphi_peak*itone(nsym)*pulse(1:2*nsps) + +! Calculate and insert the audio waveform + phi=0.0 + dphi = dphi + twopi*f0*dt !Shift frequency up by f0 + if(icmplx .eq. 0) wave=0. + if(icmplx .ne. 0) cwave=0. !Avoid writing to memory we may not have access to + + k=0 + do j=nsps,nsps+nwave-1 !Don't include dummy symbols + k=k+1 + if(icmplx.eq.0) then + wave(k)=sin(phi) + else + i=phi*float(NTAB)/twopi + cwave(k)=ctab(i) + endif + phi=mod(phi+dphi(j),twopi) + enddo + +! Apply envelope shaping to the first and last symbols + nramp=nint(nsps/8.0) + if(icmplx.eq.0) then + wave(1:nramp)=wave(1:nramp) * & + (1.0-cos(twopi*(/(i,i=0,nramp-1)/)/(2.0*nramp)))/2.0 + k1=nsym*nsps-nramp+1 + wave(k1:k1+nramp-1)=wave(k1:k1+nramp-1) * & + (1.0+cos(twopi*(/(i,i=0,nramp-1)/)/(2.0*nramp)))/2.0 + else + cwave(1:nramp)=cwave(1:nramp) * & + (1.0-cos(twopi*(/(i,i=0,nramp-1)/)/(2.0*nramp)))/2.0 + k1=nsym*nsps-nramp+1 + cwave(k1:k1+nramp-1)=cwave(k1:k1+nramp-1) * & + (1.0+cos(twopi*(/(i,i=0,nramp-1)/)/(2.0*nramp)))/2.0 + endif + + return +end subroutine gen_ft8wave diff --git a/wsjtx_lib/lib/ft8/genft8.f90 b/wsjtx_lib/lib/ft8/genft8.f90 new file mode 100644 index 0000000..a03c3e5 --- /dev/null +++ b/wsjtx_lib/lib/ft8/genft8.f90 @@ -0,0 +1,46 @@ +subroutine genft8(msg,i3,n3,msgsent,msgbits,itone) + +! Encode an FT8 message, producing array itone(). + + use packjt77 + include 'ft8_params.f90' + character msg*37,msgsent*37 + character*77 c77 + integer*1 msgbits(77),codeword(174) + integer itone(79) + integer icos7(0:6) + integer graymap(0:7) + logical unpk77_success + data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern + data graymap/0,1,3,2,5,6,4,7/ + + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + call unpack77(c77,0,msgsent,unpk77_success) + read(c77,'(77i1)',err=1) msgbits + if(unpk77_success) go to 2 +1 msgbits=0 + itone=0 + msgsent='*** bad message *** ' + go to 900 + +entry get_ft8_tones_from_77bits(msgbits,itone) + +2 call encode174_91(msgbits,codeword) !Encode the test message + +! Message structure: S7 D29 S7 D29 S7 + itone(1:7)=icos7 + itone(36+1:36+7)=icos7 + itone(NN-6:NN)=icos7 + k=7 + do j=1,ND + i=3*j -2 + k=k+1 + if(j.eq.30) k=k+7 + indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2) + itone(k)=graymap(indx) + enddo + +900 return +end subroutine genft8 diff --git a/wsjtx_lib/lib/ft8/genft8refsig.f90 b/wsjtx_lib/lib/ft8/genft8refsig.f90 new file mode 100644 index 0000000..cd1468c --- /dev/null +++ b/wsjtx_lib/lib/ft8/genft8refsig.f90 @@ -0,0 +1,23 @@ +subroutine genft8refsig(itone,cref,f0) + complex cref(79*1920) + integer itone(79) +! real*8 twopi,phi,dphi,dt,xnsps + real twopi,phi,dphi,dt,xnsps + data twopi/0.d0/ + save twopi + if( twopi .lt. 0.1 ) twopi=8.d0*atan(1.d0) + + xnsps=1920.d0 + dt=1.d0/12000.d0 + phi=0.d0 + k=1 + do i=1,79 + dphi=twopi*(f0*dt+itone(i)/xnsps) + do is=1,1920 + cref(k)=cmplx(cos(phi),sin(phi)) + phi=mod(phi+dphi,twopi) + k=k+1 + enddo + enddo + return +end subroutine genft8refsig diff --git a/wsjtx_lib/lib/ft8/get_crc14.f90 b/wsjtx_lib/lib/ft8/get_crc14.f90 new file mode 100644 index 0000000..6358089 --- /dev/null +++ b/wsjtx_lib/lib/ft8/get_crc14.f90 @@ -0,0 +1,25 @@ +subroutine get_crc14(mc,len,ncrc) +! +! 1. To calculate 14-bit CRC, mc(1:len-14) is the message and mc(len-13: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 c14*14 + integer*1 mc(len) + integer*1 r(15),p(15) + integer ncrc +! polynomial for 14-bit CRC 0x6757 + data p/1,1,0,0,1,1,1,0,1,0,1,0,1,1,1/ + +! divide by polynomial + r=mc(1:15) + do i=0,len-15 + r(15)=mc(i+15) + r=mod(r+r(1)*p,2) + r=cshift(r,1) + enddo + + write(c14,'(14b1)') r(1:14) + read(c14,'(b14.14)') ncrc + +end subroutine get_crc14 diff --git a/wsjtx_lib/lib/ft8/get_spectrum_baseline.f90 b/wsjtx_lib/lib/ft8/get_spectrum_baseline.f90 new file mode 100644 index 0000000..51a618d --- /dev/null +++ b/wsjtx_lib/lib/ft8/get_spectrum_baseline.f90 @@ -0,0 +1,54 @@ +subroutine get_spectrum_baseline(dd,nfa,nfb,sbase) + + include 'ft8_params.f90' + parameter(NST=NFFT1/2,NF=93) !NF=NMAX/NST-1 + real s(NH1,NF) + real savg(NH1) + real sbase(NH1) + real x(NFFT1) + real window(NFFT1) + complex cx(0:NH1) + real dd(NMAX) + equivalence (x,cx) + logical first + data first/.true./ + save first,window + + if(first) then + first=.false. + pi=4.0*atan(1.) + window=0. + call nuttal_window(window,NFFT1) + window=window/sum(window)*NSPS*2/300.0 + endif + +! Compute symbol spectra, stepping by NSTEP steps. + savg=0. + df=12000.0/NFFT1 + do j=1,NF + ia=(j-1)*NST + 1 + ib=ia+NFFT1-1 + if(ib.gt.NMAX) exit + x=dd(ia:ib)*window + call four2a(x,NFFT1,1,-1,0) !r2c FFT + s(1:NH1,j)=abs(cx(1:NH1))**2 + savg=savg + s(1:NH1,j) !Average spectrum + enddo + + nwin=nfb-nfa + if(nfa.lt.100) then + nfa=100 + if(nwin.lt.100) then ! nagain + nfb=nfa+nwin + endif + endif + if(nfb.gt.4910) then + nfb=4910 + if(nwin.lt.100) then + nfa=nfb-nwin + endif + endif + call baseline(savg,nfa,nfb,sbase) + +return +end subroutine get_spectrum_baseline diff --git a/wsjtx_lib/lib/ft8/h1.f90 b/wsjtx_lib/lib/ft8/h1.f90 new file mode 100644 index 0000000..8e93122 --- /dev/null +++ b/wsjtx_lib/lib/ft8/h1.f90 @@ -0,0 +1,17 @@ +real function h1(x) + +! sigma=1.0/sqrt(2.0) + sigma=1.0 + xlim=sigma/sqrt(6.0) + ax=abs(x) + sgnx=1.0 + if(x.lt.0) sgnx=-1.0 + if(ax.le.xlim) then + h1=x + else + z=exp(1.0/6.0 - (ax/sigma)**2) + h1=sgnx*sqrt(6.0)*sigma*(2.0/3.0 - 0.5*z) + endif + + return +end function h1 diff --git a/wsjtx_lib/lib/ft8/ldpc_174_87_params.f90 b/wsjtx_lib/lib/ft8/ldpc_174_87_params.f90 new file mode 100644 index 0000000..35af9b8 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ldpc_174_87_params.f90 @@ -0,0 +1,102 @@ +integer, parameter:: N=174, K=87, M=N-K +character*22 g(87) +integer colorder(N) +data g/ & !parity generator matrix for (174,87) code +"23bba830e23b6b6f50982e", & +"1f8e55da218c5df3309052", & +"ca7b3217cd92bd59a5ae20", & +"56f78313537d0f4382964e", & +"29c29dba9c545e267762fe", & +"6be396b5e2e819e373340c", & +"293548a138858328af4210", & +"cb6c6afcdc28bb3f7c6e86", & +"3f2a86f5c5bd225c961150", & +"849dd2d63673481860f62c", & +"56cdaec6e7ae14b43feeee", & +"04ef5cfa3766ba778f45a4", & +"c525ae4bd4f627320a3974", & +"fe37802941d66dde02b99c", & +"41fd9520b2e4abeb2f989c", & +"40907b01280f03c0323946", & +"7fb36c24085a34d8c1dbc4", & +"40fc3e44bb7d2bb2756e44", & +"d38ab0a1d2e52a8ec3bc76", & +"3d0f929ef3949bd84d4734", & +"45d3814f504064f80549ae", & +"f14dbf263825d0bd04b05e", & +"f08a91fb2e1f78290619a8", & +"7a8dec79a51e8ac5388022", & +"ca4186dd44c3121565cf5c", & +"db714f8f64e8ac7af1a76e", & +"8d0274de71e7c1a8055eb0", & +"51f81573dd4049b082de14", & +"d037db825175d851f3af00", & +"d8f937f31822e57c562370", & +"1bf1490607c54032660ede", & +"1616d78018d0b4745ca0f2", & +"a9fa8e50bcb032c85e3304", & +"83f640f1a48a8ebc0443ea", & +"eca9afa0f6b01d92305edc", & +"3776af54ccfbae916afde6", & +"6abb212d9739dfc02580f2", & +"05209a0abb530b9e7e34b0", & +"612f63acc025b6ab476f7c", & +"0af7723161ec223080be86", & +"a8fc906976c35669e79ce0", & +"45b7ab6242b77474d9f11a", & +"b274db8abd3c6f396ea356", & +"9059dfa2bb20ef7ef73ad4", & +"3d188ea477f6fa41317a4e", & +"8d9071b7e7a6a2eed6965e", & +"a377253773ea678367c3f6", & +"ecbd7c73b9cd34c3720c8a", & +"b6537f417e61d1a7085336", & +"6c280d2a0523d9c4bc5946", & +"d36d662a69ae24b74dcbd8", & +"d747bfc5fd65ef70fbd9bc", & +"a9fa2eefa6f8796a355772", & +"cc9da55fe046d0cb3a770c", & +"f6ad4824b87c80ebfce466", & +"cc6de59755420925f90ed2", & +"164cc861bdd803c547f2ac", & +"c0fc3ec4fb7d2bb2756644", & +"0dbd816fba1543f721dc72", & +"a0c0033a52ab6299802fd2", & +"bf4f56e073271f6ab4bf80", & +"57da6d13cb96a7689b2790", & +"81cfc6f18c35b1e1f17114", & +"481a2a0df8a23583f82d6c", & +"1ac4672b549cd6dba79bcc", & +"c87af9a5d5206abca532a8", & +"97d4169cb33e7435718d90", & +"a6573f3dc8b16c9d19f746", & +"2c4142bf42b01e71076acc", & +"081c29a10d468ccdbcecb6", & +"5b0f7742bca86b8012609a", & +"012dee2198eba82b19a1da", & +"f1627701a2d692fd9449e6", & +"35ad3fb0faeb5f1b0c30dc", & +"b1ca4ea2e3d173bad4379c", & +"37d8e0af9258b9e8c5f9b2", & +"cd921fdf59e882683763f6", & +"6114e08483043fd3f38a8a", & +"2e547dd7a05f6597aac516", & +"95e45ecd0135aca9d6e6ae", & +"b33ec97be83ce413f9acc8", & +"c8b5dffc335095dcdcaf2a", & +"3dd01a59d86310743ec752", & +"14cd0f642fc0c5fe3a65ca", & +"3a0a1dfd7eee29c2e827e0", & +"8abdb889efbe39a510a118", & +"3f231f212055371cf3e2a2"/ +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/ + diff --git a/wsjtx_lib/lib/ft8/ldpc_174_91_c_colorder.f90 b/wsjtx_lib/lib/ft8/ldpc_174_91_c_colorder.f90 new file mode 100644 index 0000000..a83de09 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ldpc_174_91_c_colorder.f90 @@ -0,0 +1,11 @@ +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, 43, 19, 20, 42, 21, 40, 30, 37, 22, 47, 61, 45, 44, 23, 41, 39, & + 49, 24, 46, 50, 48, 26, 31, 33, 51, 38, 52, 59, 55, 66, 57, 27, 60, 35, 54, 58, & + 25, 56, 62, 64, 67, 69, 63, 68, 70, 72, 65, 73, 75, 74, 71, 77, 78, 76, 79, 80, & + 53, 81, 83, 82, 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/wsjtx_lib/lib/ft8/ldpc_174_91_c_generator.f90 b/wsjtx_lib/lib/ft8/ldpc_174_91_c_generator.f90 new file mode 100644 index 0000000..675bae5 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ldpc_174_91_c_generator.f90 @@ -0,0 +1,86 @@ +character*23 g(83) + +data g/ & + "8329ce11bf31eaf509f27fc", & + "761c264e25c259335493132", & + "dc265902fb277c6410a1bdc", & + "1b3f417858cd2dd33ec7f62", & + "09fda4fee04195fd034783a", & + "077cccc11b8873ed5c3d48a", & + "29b62afe3ca036f4fe1a9da", & + "6054faf5f35d96d3b0c8c3e", & + "e20798e4310eed27884ae90", & + "775c9c08e80e26ddae56318", & + "b0b811028c2bf997213487c", & + "18a0c9231fc60adf5c5ea32", & + "76471e8302a0721e01b12b8", & + "ffbccb80ca8341fafb47b2e", & + "66a72a158f9325a2bf67170", & + "c4243689fe85b1c51363a18", & + "0dff739414d1a1b34b1c270", & + "15b48830636c8b99894972e", & + "29a89c0d3de81d665489b0e", & + "4f126f37fa51cbe61bd6b94", & + "99c47239d0d97d3c84e0940", & + "1919b75119765621bb4f1e8", & + "09db12d731faee0b86df6b8", & + "488fc33df43fbdeea4eafb4", & + "827423ee40b675f756eb5fe", & + "abe197c484cb74757144a9a", & + "2b500e4bc0ec5a6d2bdbdd0", & + "c474aa53d70218761669360", & + "8eba1a13db3390bd6718cec", & + "753844673a27782cc42012e", & + "06ff83a145c37035a5c1268", & + "3b37417858cc2dd33ec3f62", & + "9a4a5a28ee17ca9c324842c", & + "bc29f465309c977e89610a4", & + "2663ae6ddf8b5ce2bb29488", & + "46f231efe457034c1814418", & + "3fb2ce85abe9b0c72e06fbe", & + "de87481f282c153971a0a2e", & + "fcd7ccf23c69fa99bba1412", & + "f0261447e9490ca8e474cec", & + "4410115818196f95cdd7012", & + "088fc31df4bfbde2a4eafb4", & + "b8fef1b6307729fb0a078c0", & + "5afea7acccb77bbc9d99a90", & + "49a7016ac653f65ecdc9076", & + "1944d085be4e7da8d6cc7d0", & + "251f62adc4032f0ee714002", & + "56471f8702a0721e00b12b8", & + "2b8e4923f2dd51e2d537fa0", & + "6b550a40a66f4755de95c26", & + "a18ad28d4e27fe92a4f6c84", & + "10c2e586388cb82a3d80758", & + "ef34a41817ee02133db2eb0", & + "7e9c0c54325a9c15836e000", & + "3693e572d1fde4cdf079e86", & + "bfb2cec5abe1b0c72e07fbe", & + "7ee18230c583cccc57d4b08", & + "a066cb2fedafc9f52664126", & + "bb23725abc47cc5f4cc4cd2", & + "ded9dba3bee40c59b5609b4", & + "d9a7016ac653e6decdc9036", & + "9ad46aed5f707f280ab5fc4", & + "e5921c77822587316d7d3c2", & + "4f14da8242a8b86dca73352", & + "8b8b507ad467d4441df770e", & + "22831c9cf1169467ad04b68", & + "213b838fe2ae54c38ee7180", & + "5d926b6dd71f085181a4e12", & + "66ab79d4b29ee6e69509e56", & + "958148682d748a38dd68baa", & + "b8ce020cf069c32a723ab14", & + "f4331d6d461607e95752746", & + "6da23ba424b9596133cf9c8", & + "a636bcbc7b30c5fbeae67fe", & + "5cb0d86a07df654a9089a20", & + "f11f106848780fc9ecdd80a", & + "1fbb5364fb8d2c9d730d5ba", & + "fcb86bc70a50c9d02a5d034", & + "a534433029eac15f322e34c", & + "c989d9c7c3d3b8c55d75130", & + "7bb38b2f0186d46643ae962", & + "2644ebadeb44b9467d1f42c", & + "608cc857594bfbb55d69600"/ diff --git a/wsjtx_lib/lib/ft8/ldpc_174_91_c_parity.f90 b/wsjtx_lib/lib/ft8/ldpc_174_91_c_parity.f90 new file mode 100644 index 0000000..2309ad8 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ldpc_174_91_c_parity.f90 @@ -0,0 +1,270 @@ +data Mn/ & + 16, 45, 73, & + 25, 51, 62, & + 33, 58, 78, & + 1, 44, 45, & + 2, 7, 61, & + 3, 6, 54, & + 4, 35, 48, & + 5, 13, 21, & + 8, 56, 79, & + 9, 64, 69, & + 10, 19, 66, & + 11, 36, 60, & + 12, 37, 58, & + 14, 32, 43, & + 15, 63, 80, & + 17, 28, 77, & + 18, 74, 83, & + 22, 53, 81, & + 23, 30, 34, & + 24, 31, 40, & + 26, 41, 76, & + 27, 57, 70, & + 29, 49, 65, & + 3, 38, 78, & + 5, 39, 82, & + 46, 50, 73, & + 51, 52, 74, & + 55, 71, 72, & + 44, 67, 72, & + 43, 68, 78, & + 1, 32, 59, & + 2, 6, 71, & + 4, 16, 54, & + 7, 65, 67, & + 8, 30, 42, & + 9, 22, 31, & + 10, 18, 76, & + 11, 23, 82, & + 12, 28, 61, & + 13, 52, 79, & + 14, 50, 51, & + 15, 81, 83, & + 17, 29, 60, & + 19, 33, 64, & + 20, 26, 73, & + 21, 34, 40, & + 24, 27, 77, & + 25, 55, 58, & + 35, 53, 66, & + 36, 48, 68, & + 37, 46, 75, & + 38, 45, 47, & + 39, 57, 69, & + 41, 56, 62, & + 20, 49, 53, & + 46, 52, 63, & + 45, 70, 75, & + 27, 35, 80, & + 1, 15, 30, & + 2, 68, 80, & + 3, 36, 51, & + 4, 28, 51, & + 5, 31, 56, & + 6, 20, 37, & + 7, 40, 82, & + 8, 60, 69, & + 9, 10, 49, & + 11, 44, 57, & + 12, 39, 59, & + 13, 24, 55, & + 14, 21, 65, & + 16, 71, 78, & + 17, 30, 76, & + 18, 25, 80, & + 19, 61, 83, & + 22, 38, 77, & + 23, 41, 50, & + 7, 26, 58, & + 29, 32, 81, & + 33, 40, 73, & + 18, 34, 48, & + 13, 42, 64, & + 5, 26, 43, & + 47, 69, 72, & + 54, 55, 70, & + 45, 62, 68, & + 10, 63, 67, & + 14, 66, 72, & + 22, 60, 74, & + 35, 39, 79, & + 1, 46, 64, & + 1, 24, 66, & + 2, 5, 70, & + 3, 31, 65, & + 4, 49, 58, & + 1, 4, 5, & + 6, 60, 67, & + 7, 32, 75, & + 8, 48, 82, & + 9, 35, 41, & + 10, 39, 62, & + 11, 14, 61, & + 12, 71, 74, & + 13, 23, 78, & + 11, 35, 55, & + 15, 16, 79, & + 7, 9, 16, & + 17, 54, 63, & + 18, 50, 57, & + 19, 30, 47, & + 20, 64, 80, & + 21, 28, 69, & + 22, 25, 43, & + 13, 22, 37, & + 2, 47, 51, & + 23, 54, 74, & + 26, 34, 72, & + 27, 36, 37, & + 21, 36, 63, & + 29, 40, 44, & + 19, 26, 57, & + 3, 46, 82, & + 14, 15, 58, & + 33, 52, 53, & + 30, 43, 52, & + 6, 9, 52, & + 27, 33, 65, & + 25, 69, 73, & + 38, 55, 83, & + 20, 39, 77, & + 18, 29, 56, & + 32, 48, 71, & + 42, 51, 59, & + 28, 44, 79, & + 34, 60, 62, & + 31, 45, 61, & + 46, 68, 77, & + 6, 24, 76, & + 8, 10, 78, & + 40, 41, 70, & + 17, 50, 53, & + 42, 66, 68, & + 4, 22, 72, & + 36, 64, 81, & + 13, 29, 47, & + 2, 8, 81, & + 56, 67, 73, & + 5, 38, 50, & + 12, 38, 64, & + 59, 72, 80, & + 3, 26, 79, & + 45, 76, 81, & + 1, 65, 74, & + 7, 18, 77, & + 11, 56, 59, & + 14, 39, 54, & + 16, 37, 66, & + 10, 28, 55, & + 15, 60, 70, & + 17, 25, 82, & + 20, 30, 31, & + 12, 67, 68, & + 23, 75, 80, & + 27, 32, 62, & + 24, 69, 75, & + 19, 21, 71, & + 34, 53, 61, & + 35, 46, 47, & + 33, 59, 76, & + 40, 43, 83, & + 41, 42, 63, & + 49, 75, 83, & + 20, 44, 48, & + 42, 49, 57/ + +data Nm/ & + 4, 31, 59, 91, 92, 96, 153, & + 5, 32, 60, 93, 115, 146, 0, & + 6, 24, 61, 94, 122, 151, 0, & + 7, 33, 62, 95, 96, 143, 0, & + 8, 25, 63, 83, 93, 96, 148, & + 6, 32, 64, 97, 126, 138, 0, & + 5, 34, 65, 78, 98, 107, 154, & + 9, 35, 66, 99, 139, 146, 0, & + 10, 36, 67, 100, 107, 126, 0, & + 11, 37, 67, 87, 101, 139, 158, & + 12, 38, 68, 102, 105, 155, 0, & + 13, 39, 69, 103, 149, 162, 0, & + 8, 40, 70, 82, 104, 114, 145, & + 14, 41, 71, 88, 102, 123, 156, & + 15, 42, 59, 106, 123, 159, 0, & + 1, 33, 72, 106, 107, 157, 0, & + 16, 43, 73, 108, 141, 160, 0, & + 17, 37, 74, 81, 109, 131, 154, & + 11, 44, 75, 110, 121, 166, 0, & + 45, 55, 64, 111, 130, 161, 173, & + 8, 46, 71, 112, 119, 166, 0, & + 18, 36, 76, 89, 113, 114, 143, & + 19, 38, 77, 104, 116, 163, 0, & + 20, 47, 70, 92, 138, 165, 0, & + 2, 48, 74, 113, 128, 160, 0, & + 21, 45, 78, 83, 117, 121, 151, & + 22, 47, 58, 118, 127, 164, 0, & + 16, 39, 62, 112, 134, 158, 0, & + 23, 43, 79, 120, 131, 145, 0, & + 19, 35, 59, 73, 110, 125, 161, & + 20, 36, 63, 94, 136, 161, 0, & + 14, 31, 79, 98, 132, 164, 0, & + 3, 44, 80, 124, 127, 169, 0, & + 19, 46, 81, 117, 135, 167, 0, & + 7, 49, 58, 90, 100, 105, 168, & + 12, 50, 61, 118, 119, 144, 0, & + 13, 51, 64, 114, 118, 157, 0, & + 24, 52, 76, 129, 148, 149, 0, & + 25, 53, 69, 90, 101, 130, 156, & + 20, 46, 65, 80, 120, 140, 170, & + 21, 54, 77, 100, 140, 171, 0, & + 35, 82, 133, 142, 171, 174, 0, & + 14, 30, 83, 113, 125, 170, 0, & + 4, 29, 68, 120, 134, 173, 0, & + 1, 4, 52, 57, 86, 136, 152, & + 26, 51, 56, 91, 122, 137, 168, & + 52, 84, 110, 115, 145, 168, 0, & + 7, 50, 81, 99, 132, 173, 0, & + 23, 55, 67, 95, 172, 174, 0, & + 26, 41, 77, 109, 141, 148, 0, & + 2, 27, 41, 61, 62, 115, 133, & + 27, 40, 56, 124, 125, 126, 0, & + 18, 49, 55, 124, 141, 167, 0, & + 6, 33, 85, 108, 116, 156, 0, & + 28, 48, 70, 85, 105, 129, 158, & + 9, 54, 63, 131, 147, 155, 0, & + 22, 53, 68, 109, 121, 174, 0, & + 3, 13, 48, 78, 95, 123, 0, & + 31, 69, 133, 150, 155, 169, 0, & + 12, 43, 66, 89, 97, 135, 159, & + 5, 39, 75, 102, 136, 167, 0, & + 2, 54, 86, 101, 135, 164, 0, & + 15, 56, 87, 108, 119, 171, 0, & + 10, 44, 82, 91, 111, 144, 149, & + 23, 34, 71, 94, 127, 153, 0, & + 11, 49, 88, 92, 142, 157, 0, & + 29, 34, 87, 97, 147, 162, 0, & + 30, 50, 60, 86, 137, 142, 162, & + 10, 53, 66, 84, 112, 128, 165, & + 22, 57, 85, 93, 140, 159, 0, & + 28, 32, 72, 103, 132, 166, 0, & + 28, 29, 84, 88, 117, 143, 150, & + 1, 26, 45, 80, 128, 147, 0, & + 17, 27, 89, 103, 116, 153, 0, & + 51, 57, 98, 163, 165, 172, 0, & + 21, 37, 73, 138, 152, 169, 0, & + 16, 47, 76, 130, 137, 154, 0, & + 3, 24, 30, 72, 104, 139, 0, & + 9, 40, 90, 106, 134, 151, 0, & + 15, 58, 60, 74, 111, 150, 163, & + 18, 42, 79, 144, 146, 152, 0, & + 25, 38, 65, 99, 122, 160, 0, & + 17, 42, 75, 129, 170, 172, 0/ + +data nrw/ & +7,6,6,6,7,6,7,6,6,7,6,6,7,7,6,6, & +6,7,6,7,6,7,6,6,6,7,6,6,6,7,6,6, & +6,6,7,6,6,6,7,7,6,6,6,6,7,7,6,6, & +6,6,7,6,6,6,7,6,6,6,6,7,6,6,6,7, & +6,6,6,7,7,6,6,7,6,6,6,6,6,6,6,7, & +6,6,6/ + +ncw=3 diff --git a/wsjtx_lib/lib/ft8/ldpcsim174_91.f90 b/wsjtx_lib/lib/ft8/ldpcsim174_91.f90 new file mode 100644 index 0000000..994b783 --- /dev/null +++ b/wsjtx_lib/lib/ft8/ldpcsim174_91.f90 @@ -0,0 +1,134 @@ +program ldpcsim174_91 +! End to end test of the (174,91)/crc14 encoder and decoder. + use packjt77 + + integer, parameter:: N=174, K=91, M=N-K + character*37 msg,msgsent,msgreceived + character*77 c77 + character*8 arg + character*6 grid + character*96 tmpchar + integer*1, allocatable :: codeword(:), decoded(:), message(:) + integer*1 msgbits(77) + integer*1 message77(77),message91(91) + integer*1 apmask(N), cw(N) + integer nerrtot(0:N),nerrdec(0:N) + logical unpk77_success + real*8, allocatable :: rxdata(:) + real, allocatable :: llr(:) + + nerrtot=0 + nerrdec=0 + + nargs=iargc() + if(nargs.ne.6) then + print*,'Usage: ldpcsim niter ndepth #trials s Keff nbposd' + print*,'eg: ldpcsim 10 2 1000 0.84 91 1' + print*,'niter: max BP iterations' + print*,'ndepth: OSD order' + print*,'s: noise sigma; if negative value is ignored and sigma is calculated from SNR.' + print*,'nbposd=0, no coupling. nbposd>0, maxsuper=nbposd; nbposd<0, no OSD' + 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 + call getarg(5,arg) + read(arg,*) Keff + call getarg(6,arg) + read(arg,*) nbposd + +! scale Eb/No for a (174,91) 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="K9ABC K1ABC FN20" + i3=0 + n3=1 + call pack77(msg,i3,n3,c77) !Pack into 12 6-bit bytes + call unpack77(c77,1,msgsent,unpk77_success) !Unpack to get msgsent + write(*,*) "message sent ",msgsent + + read(c77,'(77i1)') msgbits(1:77) + write(*,*) 'message' + write(*,'(a71,1x,a3,1x,a3)') c77(1:71),c77(72:74),c77(75:77) + + call init_random_seed() + + call encode174_91(msgbits,codeword) + write(*,*) 'crc14' + write(*,'(14i1)') codeword(78:91) + write(*,*) 'codeword' + write(*,'(22(8i1,1x))') codeword + + write(*,*) "Eb/N0 Es/N0 ngood nundetected sigma psymerr" + do idb = 10,-4,-1 + db=idb/2.0-1.0 + sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) + ngood=0 + nue=0 + nsumerr=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 + + 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) + nap=0 ! number of AP bits + llr(1:nap)=5*(2.0*msgbits(1:nap)-1.0) + apmask=0 + apmask(1:nap)=1 + call decode174_91(llr,Keff,nbposd,ndepth,apmask,message91,cw,ntype,nharderrors,dmin) +! If the decoder finds a valid codeword, nharderrors will be .ge. 0. + if( nharderrors.ge.0 ) then + nhw=count(cw.ne.codeword) + if(nhw.eq.0) then ! this is a good decode + ngood=ngood+1 + nerrdec(nerr)=nerrdec(nerr)+1 + else + nue=nue+1 + endif + endif + nsumerr=nsumerr+nerr + enddo + + esn0=db+10.0*log10(rate) + pberr=real(nsumerr)/(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 + + 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) + +end program ldpcsim174_91 diff --git a/wsjtx_lib/lib/ft8/osd174_91.f90 b/wsjtx_lib/lib/ft8/osd174_91.f90 new file mode 100644 index 0000000..89677eb --- /dev/null +++ b/wsjtx_lib/lib/ft8/osd174_91.f90 @@ -0,0 +1,409 @@ +subroutine osd174_91(llr,k,apmask,ndeep,message91,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (174,91) code. +! Message payload is 77 bits. Any or all of a 14-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.14) is the number of CRC14 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,91]. +! + character*14 c14 + 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 message91(91),m96(96) + 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=91-k and p1+p2=14. +! +! The last p2 bits of the CRC14 are cascaded with the LDPC code. +! +! The first p1=k-77 CRC14 bits will be used for error detection. +! + allocate( gen(k,N) ) + gen=0 + do i=1,k + message91=0 + message91(i)=1 + if(i.le.77) then + m96=0 + m96(1:91)=message91 + call get_crc14(m96,96,ncrc14) + write(c14,'(b14.14)') ncrc14 + read(c14,'(14i1)') message91(78:91) + message91(78:k)=0 + endif + call encode174_91_nocrc(message91,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 mrbencode91(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 + ntheta=10 + 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 + else !ndeep=6 + 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 mrbencode91(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 mrbencode91(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 nextpat91(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 boxit91(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 mrbencode91(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 fetchit91(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 mrbencode91(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 nextpat91(misub,k,nord,iflag) + enddo + endif + +998 continue +! Re-order the codeword to [message bits][parity bits] format. + cw(indices)=cw + hdec(indices)=hdec + message91=cw(1:91) + m96=0 + m96(1:77)=cw(1:77) + m96(83:96)=cw(78:91) + call get_crc14(m96,96,nbadcrc) + if(nbadcrc.ne.0) nhardmin=-nhardmin + + return +end subroutine osd174_91 + +subroutine mrbencode91(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 mrbencode91 + +subroutine nextpat91(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 nextpat91 + +subroutine boxit91(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 boxit91 + +subroutine fetchit91(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 fetchit91 + diff --git a/wsjtx_lib/lib/ft8/subtractft8.f90 b/wsjtx_lib/lib/ft8/subtractft8.f90 new file mode 100644 index 0000000..40657e7 --- /dev/null +++ b/wsjtx_lib/lib/ft8/subtractft8.f90 @@ -0,0 +1,106 @@ +subroutine subtractft8(dd0,itone,f0,dt,lrefinedt) + +! Subtract an ft8 signal +! +! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) +! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) +! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ] +! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt} + + parameter (NMAX=15*12000,NFRAME=1920*79) + parameter (NFFT=NMAX,NFILT=4000) + real dd(NMAX),dd0(NMAX) + real window(-NFILT/2:NFILT/2) + real x(NFFT+2) + real endcorrection(NFILT/2+1) + complex cx(0:NFFT/2) + complex cref,camp,cfilt,cw,z + integer itone(79) + logical first,lrefinedt,ldt + data first/.true./ + common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX) + equivalence (x,cx) + save first,/heap8/,endcorrection + + if(first) then ! Create and normalize the filter + pi=4.0*atan(1.0) + fac=1.0/float(nfft) + sumw=0.0 + do j=-NFILT/2,NFILT/2 + window(j)=cos(pi*j/NFILT)**2 + sumw=sumw+window(j) + enddo + cw=0. + cw(1:NFILT+1)=window/sumw + cw=cshift(cw,NFILT/2+1) + call four2a(cw,nfft,1,-1,1) + cw=cw*fac + first=.false. + do j=1,NFILT/2+1 + endcorrection(j)=1.0/(1.0-sum(window(j-1:NFILT/2))/sumw) + enddo + endif + +! Generate complex reference waveform cref + call gen_ft8wave(itone,79,1920,2.0,12000.0,f0,cref,xjunk,1,NFRAME) + + ldt=lrefinedt + if(ldt) then !Are we refining DT ? + sqa=sqf(-90) + sqb=sqf(+90) + sq0=sqf(0) + call peakup(sqa,sq0,sqb,dx) + if(abs(dx).gt.1.0) return !No acceptable minimum: do not subtract + i2=nint(90.0*dx) !Best estimate of idt + ldt=.false. + sq0=sqf(i2) !Do the subtraction with idt=i2 + else + sq0=sqf(0) !Do the subtraction with idt=0 + endif + dd0=dd !Return dd0 with this signal subtracted +! write(44,3044) nint(f0),dt-0.5,1.e-8*sum(dd*dd) +!3044 format(i4,f7.2,f10.6) + return + +contains + + real function sqf(idt) !Internal function: all variables accessible + nstart=dt*12000+1 + idt + camp=0. + dd=dd0 + do i=1,nframe + j=nstart-1+i + if(j.ge.1.and.j.le.NMAX) camp(i)=dd(j)*conjg(cref(i)) + enddo + + cfilt(1:nframe)=camp(1:nframe) + cfilt(nframe+1:)=0.0 + call four2a(cfilt,nfft,1,-1,1) + cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft) + call four2a(cfilt,nfft,1,1,1) + cfilt(1:NFILT/2+1)=cfilt(1:NFILT/2+1)*endcorrection + cfilt(nframe:nframe-NFILT/2:-1)=cfilt(nframe:nframe-NFILT/2:-1)*endcorrection + x=0. + do i=1,nframe + j=nstart+i-1 + if(j.ge.1 .and. j.le.NMAX) then + z=cfilt(i)*cref(i) + dd(j)=dd(j)-2.0*real(z) !Subtract the reconstructed signal + x(i)=dd(j) + endif + enddo + sqq=0. + if(ldt) then + call four2a(cx,NFFT,1,-1,0) !Forward FFT, r2c + df=12000.0/NFFT + ia=(f0-1.5*6.25)/df + ib=(f0+8.5*6.25)/df + do i=ia,ib + sqq=sqq + real(cx(i))*real(cx(i)) + aimag(cx(i))*aimag(cx(i)) + enddo + endif + sqf=sqq + return + end function sqf + +end subroutine subtractft8 diff --git a/wsjtx_lib/lib/ft8/sync8.f90 b/wsjtx_lib/lib/ft8/sync8.f90 new file mode 100644 index 0000000..57af21a --- /dev/null +++ b/wsjtx_lib/lib/ft8/sync8.f90 @@ -0,0 +1,176 @@ +subroutine sync8(dd,npts,nfa,nfb,syncmin,nfqso,maxcand,candidate,ncand,sbase) + + include 'ft8_params.f90' + parameter (MAXPRECAND=1000) +! Maximum sync correlation lag +/- 2.5s relative to 0.5s TX start time. +! 2.5s / 0.16s/symbol * 4 samples/symbol = 62.5 lag steps in 2.5s + parameter (JZ=62) + complex cx(0:NH1) + real s(NH1,NHSYM) + real savg(NH1) + real sbase(NH1) + real x(NFFT1+2) + real sync2d(NH1,-JZ:JZ) + real red(NH1) + real red2(NH1) + real candidate0(3,MAXPRECAND) + real candidate(3,maxcand) + real dd(npts) + integer jpeak(NH1) + integer jpeak2(NH1) + integer indx(NH1) + integer indx2(NH1) + integer ii(1) + integer icos7(0:6) + data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern + 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*dd(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 + call get_spectrum_baseline(dd,nfa,nfb,sbase) + + ia=max(1,nint(nfa/df)) + ib=nint(nfb/df) + nssy=NSPS/NSTEP ! # steps per symbol + nfos=NFFT1/NSPS ! # frequency bin oversampling factor + jstrt=0.5/tstep + candidate0=0. + k=0 + + do i=ia,ib + do j=-JZ,+JZ + ta=0. + tb=0. + tc=0. + t0a=0. + t0b=0. + t0c=0. + do n=0,6 + m=j+jstrt+nssy*n + if(m.ge.1.and.m.le.NHSYM) then + ta=ta + s(i+nfos*icos7(n),m) + t0a=t0a + sum(s(i:i+nfos*6:nfos,m)) + endif + tb=tb + s(i+nfos*icos7(n),m+nssy*36) + t0b=t0b + sum(s(i:i+nfos*6:nfos,m+nssy*36)) + if(m+nssy*72.le.NHSYM) then + tc=tc + s(i+nfos*icos7(n),m+nssy*72) + t0c=t0c + sum(s(i:i+nfos*6:nfos,m+nssy*72)) + endif + enddo + t=ta+tb+tc + t0=t0a+t0b+t0c + t0=(t0-t)/6.0 + sync_abc=t/t0 + t=tb+tc + t0=t0b+t0c + t0=(t0-t)/6.0 + sync_bc=t/t0 + sync2d(i,j)=max(sync_abc,sync_bc) + enddo + enddo + + red=0. + red2=0. + mlag=13 + mlag2=JZ + do i=ia,ib + ii=maxloc(sync2d(i,-mlag:mlag)) - 1 - mlag + jpeak(i)=ii(1) + red(i)=sync2d(i,jpeak(i)) + ii=maxloc(sync2d(i,-mlag2:mlag2)) - 1 - mlag2 + jpeak2(i)=ii(1) + red2(i)=sync2d(i,jpeak2(i)) + enddo + iz=ib-ia+1 + call indexx(red(ia:ib),iz,indx) + npctile=nint(0.40*iz) + if(npctile.lt.1) then ! something is wrong; bail out + ncand=0 + return; + endif + ibase=indx(npctile) - 1 + ia + if(ibase.lt.1) ibase=1 + if(ibase.gt.nh1) ibase=nh1 + base=red(ibase) + red=red/base + call indexx(red2(ia:ib),iz,indx2) + ibase2=indx2(npctile) - 1 + ia + if(ibase2.lt.1) ibase2=1 + if(ibase2.gt.nh1) ibase2=nh1 + base2=red2(ibase2) + red2=red2/base2 + do i=1,min(MAXPRECAND,iz) + n=ia + indx(iz+1-i) - 1 + if(k.ge.MAXPRECAND) exit + if( (red(n).ge.syncmin) .and. (.not.isnan(red(n))) ) then + k=k+1 + candidate0(1,k)=n*df + candidate0(2,k)=(jpeak(n)-0.5)*tstep + candidate0(3,k)=red(n) + endif + if(abs(jpeak2(n)-jpeak(n)).eq.0) cycle + if(k.ge.MAXPRECAND) exit + if( (red2(n).ge.syncmin) .and. (.not.isnan(red2(n))) ) then + k=k+1 + candidate0(1,k)=n*df + candidate0(2,k)=(jpeak2(n)-0.5)*tstep + candidate0(3,k)=red2(n) + endif + enddo + ncand=k + +! Save only the best of near-dupe freqs. + do i=1,ncand + if(i.ge.2) then + do j=1,i-1 + fdiff=abs(candidate0(1,i))-abs(candidate0(1,j)) + tdiff=abs(candidate0(2,i)-candidate0(2,j)) + if(abs(fdiff).lt.4.0.and.tdiff.lt.0.04) then + if(candidate0(3,i).ge.candidate0(3,j)) candidate0(3,j)=0. + if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0. + endif + enddo + endif + enddo + fac=20.0/maxval(s) + s=fac*s + +! Sort by sync + call indexx(candidate0(3,1:ncand),ncand,indx) +! Place candidates within 10 Hz of nfqso at the top of the list + k=1 + do i=1,ncand + if( abs( candidate0(1,i)-nfqso ).le.10.0 .and. candidate0(3,i).ge.syncmin ) then + candidate(1:3,k)=candidate0(1:3,i) + candidate0(3,i)=0.0 + k=k+1 + endif + enddo + + do i=ncand,1,-1 + j=indx(i) + if( candidate0(3,j) .ge. syncmin ) then + candidate(2:3,k)=candidate0(2:3,j) + candidate(1,k)=abs(candidate0(1,j)) + k=k+1 + if(k.gt.maxcand) exit + endif + enddo + ncand=k-1 + return +end subroutine sync8 diff --git a/wsjtx_lib/lib/ft8/sync8d.f90 b/wsjtx_lib/lib/ft8/sync8d.f90 new file mode 100644 index 0000000..33b19d7 --- /dev/null +++ b/wsjtx_lib/lib/ft8/sync8d.f90 @@ -0,0 +1,50 @@ +subroutine sync8d(cd0,i0,ctwk,itwk,sync) + +! Compute sync power for a complex, downsampled FT8 signal. + + parameter(NP2=2812,NDOWN=60) + complex cd0(0:3199) + complex csync(0:6,32) + complex csync2(32) + complex ctwk(32) + complex z1,z2,z3 + logical first + integer icos7(0:6) + data icos7/3,1,4,0,6,5,2/ + data first/.true./ + save first,twopi,csync + + p(z1)=real(z1)**2 + aimag(z1)**2 !Statement function for power + +! Set some constants and compute the csync array. + if( first ) then + twopi=8.0*atan(1.0) + do i=0,6 + phi=0.0 + dphi=twopi*icos7(i)/32.0 + do j=1,32 + csync(i,j)=cmplx(cos(phi),sin(phi)) !Waveform for 7x7 Costas array + phi=mod(phi+dphi,twopi) + enddo + enddo + first=.false. + endif + + sync=0 + do i=0,6 !Sum over 7 Costas frequencies and + i1=i0+i*32 !three Costas arrays + i2=i1+36*32 + i3=i1+72*32 + csync2=csync(i,1:32) + if(itwk.eq.1) csync2=ctwk*csync2 !Tweak the frequency + z1=0. + z2=0. + z3=0. + if(i1.ge.0 .and. i1+31.le.NP2-1) z1=sum(cd0(i1:i1+31)*conjg(csync2)) + if(i2.ge.0 .and. i2+31.le.NP2-1) z2=sum(cd0(i2:i2+31)*conjg(csync2)) + if(i3.ge.0 .and. i3+31.le.NP2-1) z3=sum(cd0(i3:i3+31)*conjg(csync2)) + sync = sync + p(z1) + p(z2) + p(z3) + enddo + + return +end subroutine sync8d diff --git a/wsjtx_lib/lib/ft8/test_ft8q3.f90 b/wsjtx_lib/lib/ft8/test_ft8q3.f90 new file mode 100644 index 0000000..4a3802c --- /dev/null +++ b/wsjtx_lib/lib/ft8/test_ft8q3.f90 @@ -0,0 +1,41 @@ +program test_ft8q3 + +! Test q3-style decodes for FT8. + + use packjt77 + parameter(NN=79,NSPS=32) + parameter(NWAVE=NN*NSPS) !2528 + parameter(NZ=3200,NLAGS=NZ-NWAVE) + character arg*12 + character*37 msg + character*12 call_1,call_2 + character*4 grid4 + complex cd(0:NZ-1) + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.4 .and. nargs.ne.5) then + print*,'Usage: ft8q3 DT f0 call_1 call_2 [grid4]' + go to 999 + endif + call getarg(1,arg) + read(arg,*) xdt !Time offset from nominal (s) + call getarg(2,arg) + read(arg,*) f0 !Frequency (Hz) + call getarg(3,call_1) !First callsign + call getarg(4,call_2) !Second callsign + grid4=' ' + if(nargs.eq.5) call getarg(5,grid4) !Locator for call_2 + + do i=0,NZ-1 + read(40,3040) cd(i) +3040 format(17x,2f10.3) + enddo + + call sec0(0,t) + call ft8q3(cd,xdt,f0,call_1,call_2,grid4,msg,snr) + call sec0(1,t) + write(*,1100) t,snr,trim(msg) +1100 format('Time:',f6.2,' S/N:',f6.1,' msg: ',a) + +999 end program test_ft8q3 diff --git a/wsjtx_lib/lib/ft8/twkfreq1.f90 b/wsjtx_lib/lib/ft8/twkfreq1.f90 new file mode 100644 index 0000000..76327f0 --- /dev/null +++ b/wsjtx_lib/lib/ft8/twkfreq1.f90 @@ -0,0 +1,26 @@ +subroutine twkfreq1(ca,npts,fsample,a,cb) + + complex ca(npts) + complex cb(npts) + complex w,wstep + real a(5) + data twopi/6.283185307/ + +! Mix the complex signal + w=1.0 + wstep=1.0 + x0=0.5*(npts+1) + s=2.0/npts + do i=1,npts + x=s*(i-x0) + p2=1.5*x*x - 0.5 + p3=2.5*(x**3) - 1.5*x + p4=4.375*(x**4) - 3.75*(x**2) + 0.375 + dphi=(a(1) + x*a(2) + p2*a(3) + p3*a(4) + p4*a(5)) * (twopi/fsample) + wstep=cmplx(cos(dphi),sin(dphi)) + w=w*wstep + cb(i)=w*ca(i) + enddo + + return +end subroutine twkfreq1 diff --git a/wsjtx_lib/lib/ft8/watterson.f90 b/wsjtx_lib/lib/ft8/watterson.f90 new file mode 100644 index 0000000..b6fbfc2 --- /dev/null +++ b/wsjtx_lib/lib/ft8/watterson.f90 @@ -0,0 +1,69 @@ +subroutine watterson(c,npts,nsig,fs,delay,fspread) +! +! npts is the total length of the simulated data vector +! nsig is the number of points that are occupied by signal +! + complex c(0:npts-1) + complex c2(0:npts-1) + complex cs1(0:npts-1) + complex cs2(0:npts-1) + + nonzero=0 + df=fs/npts + if(fspread.gt.0.0) then + do i=0,npts-1 + xx=gran() + yy=gran() + cs1(i)=0.707*cmplx(xx,yy) + xx=gran() + yy=gran() + cs2(i)=0.707*cmplx(xx,yy) + enddo + call four2a(cs1,npts,1,-1,1) !To freq domain + call four2a(cs2,npts,1,-1,1) + do i=0,npts-1 + f=i*df + if(i.gt.npts/2) f=(i-npts)*df + x=(f/(0.5*fspread))**2 + a=0. + if(x.le.50.0) then + a=exp(-x) + endif + cs1(i)=a*cs1(i) + cs2(i)=a*cs2(i) + if(abs(f).lt.10.0) then + p1=real(cs1(i))**2 + aimag(cs1(i))**2 + p2=real(cs2(i))**2 + aimag(cs2(i))**2 + if(p1.gt.0.0) nonzero=nonzero+1 +! write(62,3101) f,p1,p2,db(p1+1.e-12)-60,db(p2+1.e-12)-60 +!3101 format(f10.3,2f12.3,2f10.3) + endif + enddo + call four2a(cs1,npts,1,1,1) !Back to time domain + call four2a(cs2,npts,1,1,1) + cs1(0:npts-1)=cs1(0:npts-1)/npts + cs2(0:npts-1)=cs2(0:npts-1)/npts + endif + + nshift=nint(0.001*delay*fs) + if(delay.gt.0.0) then + c2(0:npts-1)=cshift(c(0:npts-1),-nshift) !negative shifts are right shifts + else + c2(0:npts-1)=0.0 + endif + sq=0. + do i=0,npts-1 + if(nonzero.gt.1) then + c(i)=0.5*(cs1(i)*c(i) + cs2(i)*c2(i)) + else + c(i)=0.5*(c(i) + c2(i)) + endif + sq=sq + real(c(i))**2 + aimag(c(i))**2 +! write(61,3001) i/12000.0,c(i) +!3001 format(3f12.6) + enddo + rms=sqrt(sq/nsig) + c=c/rms + + return +end subroutine watterson diff --git a/wsjtx_lib/lib/ft8_decode.f90 b/wsjtx_lib/lib/ft8_decode.f90 new file mode 100644 index 0000000..5402cc6 --- /dev/null +++ b/wsjtx_lib/lib/ft8_decode.f90 @@ -0,0 +1,330 @@ +module ft8_decode + + parameter (MAXFOX=1000) + character*12 c2fox(MAXFOX) + character*4 g2fox(MAXFOX) + integer nsnrfox(MAXFOX) + integer nfreqfox(MAXFOX) + integer n30fox(MAXFOX) + integer n30z + integer nfox + + type :: ft8_decoder + procedure(ft8_decode_callback), pointer :: callback + contains + procedure :: decode + end type ft8_decoder + + abstract interface + subroutine ft8_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual) + import ft8_decoder + implicit none + class(ft8_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: nap + real, intent(in) :: qual + end subroutine ft8_decode_callback + end interface + +contains + + subroutine decode(this,callback,iwave,nQSOProgress,nfqso,nftx,newdat, & + nutc,nfa,nfb,nzhsym,ndepth,emedelay,ncontest,nagain,lft8apon, & + ltry_a8,lapcqonly,napwid,mycall12,hiscall12,hisgrid,ldiskdat) + use iso_c_binding, only: c_bool, c_int + use timer_module, only: timer + use shmem, only: shmem_lock, shmem_unlock + use ft8_a7 + + include 'ft8/ft8_params.f90' + + class(ft8_decoder), intent(inout) :: this + procedure(ft8_decode_callback) :: callback + parameter (MAXCAND=1000,MAX_EARLY=200,NPTS=15*12000) + real*8 tsec,tseq + real sbase(NH1) + real candidate(3,MAXCAND) + real dd(NPTS),dd1(NPTS) + logical, intent(in) :: lft8apon,lapcqonly,nagain + logical newdat,lsubtract,ldupe,lrefinedt,ltry_a8 + logical*1 ldiskdat + logical lsubtracted(MAX_EARLY) + logical la8 + character*12 mycall12,hiscall12,call_1,call_2 + character*6 hisgrid + character*4 grid4 + integer*2 iwave(NPTS) + integer apsym2(58),aph10(10) + character datetime*13,msg37*37 + character*37 allmessages(MAX_EARLY) + character*12 ctime + integer allsnrs(MAX_EARLY) + integer itone(NN) + integer itone_save(NN,MAX_EARLY) + real f1_save(MAX_EARLY) + real xdt_save(MAX_EARLY) + data nutc0/-1/ + + save dd,dd1,nutc0,ndec_early,itone_save,f1_save,xdt_save,lsubtracted, & + allmessages + this%callback => callback + write(datetime,1001) nutc !### TEMPORARY ### +1001 format("000000_",i6.6) + + la8=.true. + if(nzhsym .eq. 41) jseq=mod(nutc/5,2) + if(nutc0.eq.-1) then + msg0=' ' + dt0=0. + f0=0. + endif + +! Added 41==nzhsym to force a reset if the same wav file is processed twice or +! more in a row, in which case nutc.eq.nutc0 and ndec(jseq,1) doesn't get reset + if(nzhsym==41 .or. (nutc.ne.nutc0)) then +! New UTC. Move previously saved 'a7' data from k=1 to k=0 + iz=ndec(jseq,1) + dt0(1:iz,jseq,0) = dt0(1:iz,jseq,1) + f0(1:iz,jseq,0) = f0(1:iz,jseq,1) + msg0(1:iz,jseq,0) = msg0(1:iz,jseq,1) + + ndec(jseq,0)=iz + ndec(jseq,1)=0 + nutc0=nutc + dt0(:,jseq,1)=0. + f0(:,jseq,1)=0. + endif + + if(ndepth.eq.1 .and. nzhsym.lt.50) then + ndec_early=0 + return + endif + if(ndepth.eq.1 .and. nzhsym.eq.50) then + dd=iwave + endif + call ft8apset(mycall12,hiscall12,ncontest,apsym2,aph10) + + if(nzhsym.le.47) then + dd=iwave + dd1=dd + endif + + if(nzhsym.eq.41) then + ndecodes=0 + allmessages=' ' + allsnrs=0 + else + ndecodes=ndec_early + endif + + if(nzhsym.eq.47 .and. ndec_early.eq.0) then + dd1=dd + go to 800 + endif + + if(nzhsym.eq.47 .and. ndec_early.ge.1) then + lsubtracted=.false. + lrefinedt=.true. + if(ndepth.le.2) lrefinedt=.false. + call timer('sub_ft8b',0) + do i=1,ndec_early + if(xdt_save(i)-0.5.lt.0.396) then + call subtractft8(dd,itone_save(1,i),f1_save(i),xdt_save(i), & + lrefinedt) + lsubtracted(i)=.true. + endif + call timestamp(tsec,tseq,ctime) + if(.not.ldiskdat .and. tseq.ge.14.3d0) then !Bail out before done + call timer('sub_ft8b',1) + dd1=dd + go to 800 + endif + enddo + call timer('sub_ft8b',1) + dd1=dd + go to 900 + endif + + if(nzhsym.eq.50 .and. ndec_early.ge.1 .and. .not.nagain) then + n=47*3456 + dd(1:n)=dd1(1:n) + dd(n+1:)=iwave(n+1:) + call timer('sub_ft8c',0) + do i=1,ndec_early + if(lsubtracted(i)) cycle + call subtractft8(dd,itone_save(1,i),f1_save(i),xdt_save(i),.true.) + enddo + call timer('sub_ft8c',1) + endif + + ifa=nfa + ifb=nfb + if(nzhsym.eq.50 .and. nagain) then + dd=iwave + ifa=nfqso-20 + ifb=nfqso+20 + endif + +! For now: +! ndepth=1: 1 pass, bp +! ndepth=2: subtraction, 3 passes, bp+osd (no subtract refinement) +! ndepth=3: subtraction, 3 passes, bp+osd + npass=3 + imetric=1 + if(ndepth.eq.1) npass=2 + do ipass=1,npass + newdat=.true. + syncmin=1.3 + if(ndepth.le.2) syncmin=2.1 +! if(nzhsym.eq.41) syncmin=2.0 + if(ipass.eq.1) then + lsubtract=.true. + imetric=1 + elseif(ipass.eq.2) then + n2=ndecodes + imetric=2 +! if(ndecodes.eq.0) imetric=2 + lsubtract=.true. + elseif(ipass.eq.3) then + imetric=2 +! if((ndecodes-n2).eq.0) cycle + if(ndecodes.eq.0) cycle + lsubtract=.true. + endif + call timer('sync8 ',0) + maxc=MAXCAND + call sync8(dd,NPTS,ifa,ifb,syncmin,nfqso,maxc,candidate,ncand,sbase) + call timer('sync8 ',1) + do icand=1,ncand + sync=candidate(3,icand) + f1=candidate(1,icand) + xdt=candidate(2,icand) + xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0)) + msg37=' ' + call timer('ft8b ',0) + call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,nzhsym,lft8apon, & + lapcqonly,napwid,lsubtract,nagain,ncontest,imetric,iaptype,mycall12, & + hiscall12,f1,xdt,xbase,apsym2,aph10,nharderrors,dmin, & + nbadcrc,iappass,msg37,xsnr,itone) + call timer('ft8b ',1) + nsnr=nint(xsnr) + xdt=xdt-0.5 + hd=nharderrors+dmin + if(nbadcrc.eq.0) then + ldupe=.false. + do id=1,ndecodes + if(msg37.eq.allmessages(id)) ldupe=.true. + enddo + if(.not.ldupe) then + if(ndecodes.ge.MAX_EARLY) then + cycle + endif + ndecodes=ndecodes+1 + allmessages(ndecodes)=msg37 + allsnrs(ndecodes)=nsnr + f1_save(ndecodes)=f1 + xdt_save(ndecodes)=xdt+0.5 + itone_save(1:NN,ndecodes)=itone + endif + if(.not.ldupe .and. associated(this%callback)) then + qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] + if(emedelay.ne.0) xdt=xdt+2.0 + call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual) + call ft8_a7_save(jseq,xdt,f1,msg37) !Enter decode in table + endif + endif + call timestamp(tsec,tseq,ctime) + if(.not.ldiskdat .and. nzhsym.eq.41 .and. & + tseq.ge.13.4d0) go to 800 !Bail out before done + enddo ! icand + enddo ! ipass + +800 ndec_early=0 + if(nzhsym.lt.50) ndec_early=ndecodes + +900 continue + + if(lft8apon .and. ncontest.ne.6 .and. ncontest.ne.7 .and. nzhsym.eq.50 .and. & + ndec(jseq,0).ge.1) then + newdat=.true. + do i=1,ndec(jseq,0) + if(f0(i,jseq,0).eq.-99.0) exit + if(f0(i,jseq,0).eq.-98.0) cycle + if(index(msg0(i,jseq,0),'<').ge.1) cycle !### Temporary ### + msg37=msg0(i,jseq,0) + i1=index(msg37,' ') + i2=index(msg37(i1+1:),' ') + i1 + call_1=msg37(1:i1-1) + call_2=msg37(i1+1:i2-1) + grid4=msg37(i2+1:i2+4) + if(grid4.eq.'RR73' .or. index(grid4,'+').gt.0 .or. & + index(grid4,'-').gt.0) grid4=' ' + xdt=dt0(i,jseq,0) + f1=f0(i,jseq,0) + xbase=10.0**(0.1*(sbase(max(1,nint(f1/3.125)))-40.0)) + msg37=' ' + call timer('ft8_a7d ',0) + call ft8_a7d(dd,newdat,call_1,call_2,grid4,xdt,f1,xbase,nharderrors, & + dmin,msg37,xsnr) + call timer('ft8_a7d ',1) + + if(nharderrors.ge.0) then + if(associated(this%callback)) then + nsnr=xsnr + iaptype=7 + qual=1.0 + if(index(msg37,trim(hiscall12)).gt.0) la8=.false. + call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual) + call ft8_a7_save(jseq,xdt,f1,msg37) !Enter decode in table + endif + endif + enddo + endif + + if(lft8apon .and. ncontest.ne.6 .and. ncontest.ne.7 .and. nzhsym.eq.50 .and. & + la8 .and. len(trim(hiscall12)).ge.3 .and. len(trim(hisgrid)).ge.4 .and. & + ltry_a8) then +! Try for an a8 decode at nfqso + f1=nfqso + call timer('ft8_a8d ',0) + call ft8_a8d(dd,mycall12,hiscall12,hisgrid,f1,xdt,fbest,xsnr,plog,msg37) + call timer('ft8_a8d ',1) + + if(msg37(1:1).ne.' ') then + if(associated(this%callback)) then + sync=10.0 !### ??? + nsnr=nint(xsnr) + iaptype=8 + qual=1.0 + if(plog.lt.-147.0) qual=0.16 + call this%callback(sync,nsnr,xdt,fbest,msg37,iaptype,qual) + call ft8_a7_save(jseq,xdt,f1,msg37) !Enter decode in the a7 table + endif + endif + endif + + return +end subroutine decode + +subroutine timestamp(tsec,tseq,ctime) + real*8 tsec,tseq + character*12 ctime + integer itime(8) + call date_and_time(values=itime) + tsec=3600.d0*(itime(5)-itime(4)/60.d0) + 60.d0*itime(6) + & + itime(7) + 0.001d0*itime(8) + tsec=mod(tsec+2*86400.d0,86400.d0) + tseq=mod(itime(7)+0.001d0*itime(8),15.d0) + if(tseq.lt.10.d0) tseq=tseq+15.d0 + sec=itime(7)+0.001*itime(8) + write(ctime,1000) itime(5)-itime(4)/60,itime(6),sec +1000 format(i2.2,':',i2.2,':',f6.3) + if(ctime(7:7).eq.' ') ctime(7:7)='0' + return +end subroutine timestamp + +end module ft8_decode diff --git a/wsjtx_lib/lib/ftrsd/Makefile b/wsjtx_lib/lib/ftrsd/Makefile new file mode 100644 index 0000000..61b1357 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/Makefile @@ -0,0 +1,53 @@ +# Makefile for Windows in JTSDK-PY environment + +# Re-direct stdout and stderr: cmd.exe bash +# make > junk 2>&1 make &> junk + +CC = gcc +FC = gfortran + +FFLAGS = -O2 -DWIN32 -fbounds-check -fno-second-underscore -Wall \ + -Wno-conversion -Wno-character-truncation +CFLAGS = -I. -DWIN32 -DWin32 -DBIGSYM -DHAVE_STRUCT_TIMESPEC + +# Default rules +%.o: %.c + ${CC} ${CFLAGS} -c $< +%.o: %.f + ${FC} ${FFLAGS} -c $< +%.o: %.F + ${FC} ${FFLAGS} -c $< +%.o: %.f90 + ${FC} ${FFLAGS} -c $< +%.o: %.F90 + ${FC} ${FFLAGS} -c $< + +all: libftrsd.a + +OBJS1 = extract2.o ftrsd2.o init_rs_int.o encode_rs_int.o decode_rs_int.o +libftrsd.a: $(OBJS1) + ar cr libftrsd.a $(OBJS1) + ranlib libftrsd.a + cp libftrsd.a .. + +# Build rsdtest +OBJS2 = rsdtest.o +rsdtest: $(OBJS2) ../libjt.a + $(FC) -o rsdtest $(OBJS2) libftrsd.a ../libjt.a ../libpthreadGC2.a + +ftrsd: ftrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o + gcc -g -o $@ $^ + +encode_rs_int.o: encode_rs.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +decode_rs_int.o: decode_rs.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +init_rs_int.o: init_rs.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +.PHONY : clean + +clean: + rm -rf *.o libjt.a rsdtest ftrsd diff --git a/wsjtx_lib/lib/ftrsd/Makefile.sfrsd b/wsjtx_lib/lib/ftrsd/Makefile.sfrsd new file mode 100644 index 0000000..3f68f7e --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/Makefile.sfrsd @@ -0,0 +1,30 @@ +srcdir = . +prefix = /usr/local +exec_prefix=${prefix} +CC=gcc + +CFLAGS=-I/usr/local/include -Wall -O2 + +all: encode_rs_int.o decode_rs_int.o init_rs_int.o sfrsd2.o sfrsd.o sfrsd + +encode_rs_int.o: encode_rs.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +decode_rs_int.o: decode_rs.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +init_rs_int.o: init_rs.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +sfrsd2.o: sfrsd2.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +sfrsd.o: sfrsd.c + gcc -DBIGSYM=1 $(CFLAGS) -c -o $@ $^ + +sfrsd: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o sfrsd2.o + gcc -g -o $@ $^ + +clean: + rm -f *.o *.a sfrsd + diff --git a/wsjtx_lib/lib/ftrsd/Makefile.sfrsd3 b/wsjtx_lib/lib/ftrsd/Makefile.sfrsd3 new file mode 100644 index 0000000..93023f3 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/Makefile.sfrsd3 @@ -0,0 +1,38 @@ +# Makefile for Windows in JTSDK-PY environment + +# Re-direct stdout and stderr: cmd.exe bash +# make > junk 2>&1 make &> junk + +CC = gcc +FC = gfortran + +FFLAGS = -O2 -DWIN32 -fbounds-check -fno-second-underscore -Wall \ + -Wno-conversion -Wno-character-truncation +CFLAGS = -I. -DWIN32 -DWin32 -DBIGSYM -DHAVE_STRUCT_TIMESPEC + +# Default rules +%.o: %.c + ${CC} ${CFLAGS} -c $< +%.o: %.f + ${FC} ${FFLAGS} -c $< +%.o: %.F + ${FC} ${FFLAGS} -c $< +%.o: %.f90 + ${FC} ${FFLAGS} -c $< +%.o: %.F90 + ${FC} ${FFLAGS} -c $< + +all: rsdtest + +# Build rsdtest +OBJS2 = rsdtest.o extract2.o demod64b.o sfrsd3.o +rsdtest: $(OBJS2) ../libjt.a + $(FC) -o rsdtest $(OBJS2) ../libjt.a ../libpthreadGC2.a + +sfrsd: sfrsd.o encode_rs_int.o decode_rs_int.o init_rs_int.o + gcc -g -o $@ $^ + +.PHONY : clean + +clean: + rm -rf *.o libjt.a rsdtest sfrsd diff --git a/wsjtx_lib/lib/ftrsd/decode_rs.c b/wsjtx_lib/lib/ftrsd/decode_rs.c new file mode 100644 index 0000000..990b687 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/decode_rs.c @@ -0,0 +1,268 @@ +/* Reed-Solomon decoder + * Copyright 2002 Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + * Modified by Steve Franke, K9AN, for use in a soft-symbol RS decoder + */ + +#ifdef DEBUG +#include +#endif + +#include +#include + +#define min(a,b) ((a) < (b) ? (a) : (b)) + +#ifdef FIXED +#include "fixed.h" +#elif defined(BIGSYM) +#include "int.h" +#else +#include "char.h" +#endif + +int DECODE_RS( +#ifndef FIXED + void *p, +#endif + DTYPE *data, int *eras_pos, int no_eras, int calc_syn){ + +#ifndef FIXED + struct rs *rs = (struct rs *)p; +#endif + int deg_lambda, el, deg_omega; + int i, j, r,k; + DTYPE u,q,tmp,num1,num2,den,discr_r; + DTYPE lambda[NROOTS+1]; // Err+Eras Locator poly + static DTYPE s[51]; // and syndrome poly + DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1]; + DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS]; + int syn_error, count; + + if( calc_syn ) { + /* form the syndromes; i.e., evaluate data(x) at roots of g(x) */ + for(i=0;i 0) { + /* Init lambda to be the erasure locator polynomial */ + lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))]; + for (i = 1; i < no_eras; i++) { + u = MODNN(PRIM*(NN-1-eras_pos[i])); + for (j = i+1; j > 0; j--) { + tmp = INDEX_OF[lambda[j - 1]]; + if(tmp != A0) + lambda[j] ^= ALPHA_TO[MODNN(u + tmp)]; + } + } + +#if DEBUG >= 1 + /* Test code that verifies the erasure locator polynomial just constructed + Needed only for decoder debugging. */ + + /* find roots of the erasure location polynomial */ + for(i=1;i<=no_eras;i++) + reg[i] = INDEX_OF[lambda[i]]; + + count = 0; + for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) { + q = 1; + for (j = 1; j <= no_eras; j++) + if (reg[j] != A0) { + reg[j] = MODNN(reg[j] + j); + q ^= ALPHA_TO[reg[j]]; + } + if (q != 0) + continue; + /* store root and error location number indices */ + root[count] = i; + loc[count] = k; + count++; + } + if (count != no_eras) { + printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras); + count = -1; + goto finish; + } +#if DEBUG >= 2 + printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n"); + for (i = 0; i < count; i++) + printf("%d ", loc[i]); + printf("\n"); +#endif +#endif + } + for(i=0;i 0; j--){ + if (reg[j] != A0) { + reg[j] = MODNN(reg[j] + j); + q ^= ALPHA_TO[reg[j]]; + } + } + if (q != 0) + continue; /* Not a root */ + /* store root (index-form) and error location number */ +#if DEBUG>=2 + printf("count %d root %d loc %d\n",count,i,k); +#endif + root[count] = i; + loc[count] = k; + /* If we've already found max possible roots, + * abort the search to save time + */ + if(++count == deg_lambda) + break; + } + if (deg_lambda != count) { + /* + * deg(lambda) unequal to number of roots => uncorrectable + * error detected + */ + count = -1; + goto finish; + } + /* + * Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo + * x**NROOTS). in index form. Also find deg(omega). + */ + deg_omega = 0; + for (i = 0; i < NROOTS;i++){ + tmp = 0; + j = (deg_lambda < i) ? deg_lambda : i; + for(;j >= 0; j--){ + if ((s[i - j] != A0) && (lambda[j] != A0)) + tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])]; + } + if(tmp != 0) + deg_omega = i; + omega[i] = INDEX_OF[tmp]; + } + omega[NROOTS] = A0; + + /* + * Compute error values in poly-form. num1 = omega(inv(X(l))), num2 = + * inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form + */ + for (j = count-1; j >=0; j--) { + num1 = 0; + for (i = deg_omega; i >= 0; i--) { + if (omega[i] != A0) + num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])]; + } + num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)]; + den = 0; + + /* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */ + for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) { + if(lambda[i+1] != A0) + den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])]; + } + if (den == 0) { +#if DEBUG >= 1 + printf("\n ERROR: denominator = 0\n"); +#endif + count = -1; + goto finish; + } + /* Apply error to data */ + if (num1 != 0) { + data[loc[j]] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])]; + } + } +finish: + if(eras_pos != NULL){ + for(i=0;i + +#ifdef FIXED +#include "fixed.h" +#elif defined(BIGSYM) +#include "int.h" +#else +#include "char.h" +#endif + +void ENCODE_RS( +#ifndef FIXED +void *p, +#endif +DTYPE *data, DTYPE *bb){ +#ifndef FIXED + struct rs *rs = (struct rs *)p; +#endif + int i, j; + DTYPE feedback; + + memset(bb,0,NROOTS*sizeof(DTYPE)); + + for(i=0;i +#include +#include +#include +#include +#include "rs2.h" + +static void *rs; +void getpp_(int workdat[], float *pp); + +void ftrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[], + int* ntrials0, int correct[], int param[], int ntry[]) +{ + int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63]; + int workdat[63]; + int indexes[63]; + int era_pos[51]; + int i, j, numera, nerr, nn=63; + int ntrials = *ntrials0; + int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768; + int ntotal=0,ntotal_min=32768,ncandidates; + int nera_best=0; + float pp,pp1,pp2; + static unsigned int nseed; + +// Power-percentage symbol metrics - composite gnnf/hf + int perr[8][8] = { + { 4, 9, 11, 13, 14, 14, 15, 15}, + { 2, 20, 20, 30, 40, 50, 50, 50}, + { 7, 24, 27, 40, 50, 50, 50, 50}, + {13, 25, 35, 46, 52, 70, 50, 50}, + {17, 30, 42, 54, 55, 64, 71, 70}, + {25, 39, 48, 57, 64, 66, 77, 77}, + {32, 45, 54, 63, 66, 75, 78, 83}, + {51, 58, 57, 66, 72, 77, 82, 86}}; + + +// Initialize the KA9Q Reed-Solomon encoder/decoder + unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51; + rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0); + +// Reverse the received symbol vectors for BM decoder + for (i=0; i<63; i++) { + rxdat[i]=mrsym[62-i]; + rxprob[i]=mrprob[62-i]; + rxdat2[i]=mr2sym[62-i]; + rxprob2[i]=mr2prob[62-i]; + } + +// Sort rxprob to find indexes of the least reliable symbols + int k, pass, tmp, nsym=63; + int probs[63]; + for (i=0; i<63; i++) { + indexes[i]=i; + probs[i]=rxprob[i]; + } + for (pass = 1; pass <= nsym-1; pass++) { + for (k = 0; k < nsym - pass; k++) { + if( probs[k] < probs[k+1] ) { + tmp = probs[k]; + probs[k] = probs[k+1]; + probs[k+1] = tmp; + tmp = indexes[k]; + indexes[k] = indexes[k+1]; + indexes[k+1] = tmp; + } + } + } + +// See if we can decode using BM HDD, and calculate the syndrome vector. + memset(era_pos,0,51*sizeof(int)); + numera=0; + memcpy(workdat,rxdat,sizeof(rxdat)); + nerr=decode_rs_int(rs,workdat,era_pos,numera,1); + if( nerr >= 0 ) { + // Hard-decision decoding succeeded. Save codeword and some parameters. + nhard=0; + for (i=0; i<63; i++) { + if( workdat[i] != rxdat[i] ) nhard=nhard+1; + } + memcpy(correct,workdat,63*sizeof(int)); + param[0]=0; + param[1]=nhard; + param[2]=0; + param[3]=0; + param[4]=0; + param[5]=0; + param[7]=1000*1000; + ntry[0]=0; + return; + } + +/* +Hard-decision decoding failed. Try the FT soft-decision method. +Generate random erasure-locator vectors and see if any of them +decode. This will generate a list of "candidate" codewords. The +soft distance between each candidate codeword and the received +word is estimated by finding the largest (pp1) and second-largest +(pp2) outputs from a synchronized filter-bank operating on the +symbol spectra, and using these to decide which candidate +codeword is "best". +*/ + + nseed=1; //Seed for random numbers + float ratio; + int thresh, nsum; + int thresh0[63]; + ncandidates=0; + nsum=0; + int ii,jj; + for (i=0; i= 0 ) { + // We have a candidate codeword. Find its hard and soft distance from + // the received word. Also find pp1 and pp2 from the full array + // s3(64,63) of synchronized symbol spectra. + ncandidates=ncandidates+1; + nhard=0; + nsoft=0; + for (i=0; i<63; i++) { + if(workdat[i] != rxdat[i]) { + nhard=nhard+1; + if(workdat[i] != rxdat2[i]) { + nsoft=nsoft+rxprob[i]; + } + } + } + nsoft=63*nsoft/nsum; + ntotal=nsoft+nhard; + + getpp_(workdat,&pp); + if(pp>pp1) { + pp2=pp1; + pp1=pp; + nsoft_min=nsoft; + nhard_min=nhard; + ntotal_min=ntotal; + memcpy(correct,workdat,63*sizeof(int)); + nera_best=numera; + ntry[0]=k; + } else { + if(pp>pp2 && pp!=pp1) pp2=pp; + } + if(nhard_min <= 41 && ntotal_min <= 71) break; + } + if(k == ntrials) ntry[0]=k; + } + + param[0]=ncandidates; + param[1]=nhard_min; + param[2]=nsoft_min; + param[3]=nera_best; + param[4]= pp1 > 0 ? 1000.0*pp2/pp1 : 1000.0; + param[5]=ntotal_min; + param[6]=ntry[0]; + param[7]=1000.0*pp2; + param[8]=1000.0*pp1; + if(param[0]==0) param[2]=-1; + return; +} diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/JT65B_EME.png b/wsjtx_lib/lib/ftrsd/ftrsd_paper/JT65B_EME.png new file mode 100644 index 0000000..d5c86fb Binary files /dev/null and b/wsjtx_lib/lib/ftrsd/ftrsd_paper/JT65B_EME.png differ diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/Makefile b/wsjtx_lib/lib/ftrsd/ftrsd_paper/Makefile new file mode 100644 index 0000000..a594397 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/Makefile @@ -0,0 +1,40 @@ +CC = gcc +FC = gfortran + +# 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: mfsk probs.out + +OBJS1 = prob.o binomial_subs.o +prob: $(OBJS1) + $(FC) -o prob $(OBJS1) + +OBJS2 = mfsk.o binomial_subs.o +mfsk: $(OBJS2) + $(FC) -o mfsk $(OBJS2) + +OBJS3 = bodide.o binomial_subs.o +bodide: $(OBJS3) + $(FC) -o bodide $(OBJS3) + + +probs.out: prob +# x N X s + prob 35 63 40 40 > probs.out + prob 37 63 40 45 >> probs.out + prob 37 53 40 45 >> probs.out + prob 38 53 40 47 >> probs.out + +clean: + rm -rf *.o prob probs.out + diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/binomial.c b/wsjtx_lib/lib/ftrsd/ftrsd_paper/binomial.c new file mode 100644 index 0000000..fcbdafd --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/binomial.c @@ -0,0 +1,69 @@ +#include +#include + +/* Original code copied from + http://rosettacode.org/wiki/Evaluate_binomial_coefficients +*/ + +/* We go to some effort to handle overflow situations */ + +static unsigned long gcd_ui(unsigned long x, unsigned long y) { + unsigned long t; + if (y < x) { t = x; x = y; y = t; } + while (y > 0) { + t = y; y = x % y; x = t; /* y1 <- x0 % y0 ; x1 <- y0 */ + } + return x; +} + +unsigned long binomial(unsigned long n, unsigned long k) { + unsigned long d, g, r = 1; + if (k == 0) return 1; + if (k == 1) return n; + if (k >= n) return (k == n); + if (k > n/2) k = n-k; + for (d = 1; d <= k; d++) { + if (r >= ULONG_MAX/n) { /* Possible overflow */ + unsigned long nr, dr; /* reduced numerator / denominator */ + g = gcd_ui(n, d); nr = n/g; dr = d/g; + g = gcd_ui(r, dr); r = r/g; dr = dr/g; + if (r >= ULONG_MAX/nr) return 0; /* Unavoidable overflow */ + r *= nr; + r /= dr; + n--; + } else { + r *= n--; + r /= d; + } + } + return r; +} + +int main() { + + //Get test results + printf("%lu\n", binomial(5, 3)); // 10 + printf("%lu\n", binomial(40, 19)); // 131282408400 + printf("%lu\n", binomial(67, 31)); // 11923179284862717872 + + // Compute special cases for paper on TF soft-decision RS decoder: + double a,b,c,p; + a=(double)binomial(40, 35); + b=(double)binomial(23, 5); + c=(double)binomial(63, 40); + p=a*b/c; + printf("%e %e %e %e\n",a,b,c,p); + + a=(double)binomial(40, 36); + b=(double)binomial(23, 4); + c=(double)binomial(63, 40); + p=a*b/c; + printf("%e %e %e %e\n",a,b,c,p); + + a=(double)binomial(40, 37); + b=(double)binomial(23, 8); + c=(double)binomial(63, 45); + p=a*b/c; + printf("%e %e %e %e\n",a,b,c,p); + return 0; +} diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/binomial_subs.c b/wsjtx_lib/lib/ftrsd/ftrsd_paper/binomial_subs.c new file mode 100644 index 0000000..be4a0ae --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/binomial_subs.c @@ -0,0 +1,55 @@ +#include +#include + +/* Original code copied from + http://rosettacode.org/wiki/Evaluate_binomial_coefficients +*/ + +/* We go to some effort to handle overflow situations */ + +static unsigned long long gcd_ui(unsigned long long x, unsigned long long y) { + unsigned long long t; + if (y < x) { t = x; x = y; y = t; } + while (y > 0) { + t = y; y = x % y; x = t; /* y1 <- x0 % y0 ; x1 <- y0 */ + } + return x; +} + +unsigned long long binomial(unsigned long long n, unsigned long long k) { + unsigned long long d, g, r = 1; + if (k == 0) return 1; + if (k == 1) return n; + if (k >= n) return (k == n); + if (k > n/2) k = n-k; + for (d = 1; d <= k; d++) { + if (r >= ULLONG_MAX/n) { /* Possible overflow */ + unsigned long long nr, dr; /* reduced numerator / denominator */ + g = gcd_ui(n, d); nr = n/g; dr = d/g; + g = gcd_ui(r, dr); r = r/g; dr = dr/g; + if (r >= ULLONG_MAX/nr) return 0; /* Unavoidable overflow */ + r *= nr; + r /= dr; + n--; + } else { + r *= n--; + r /= d; + } + } + return r; +} + +unsigned long long binomial_(int *n, int *k) +{ + // printf("n=%d k=%d %lu\n",*n,*k,binomial(*n,*k)); + return binomial(*n,*k); +} + +double hypergeo_(int *x, int *NN, int *XX, int *s) +{ + double a,b,c; + a=(double)binomial(*XX, *x); + b=(double)binomial(*NN-*XX, *s-*x); + c=(double)binomial(*NN, *s); + return a*b/c; +} diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmdata-rf.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmdata-rf.dat new file mode 100644 index 0000000..17d5331 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmdata-rf.dat @@ -0,0 +1,11 @@ +fspread0 0.2, BM (ntrials=0) +-22.0 0.09 +-21.5 0.20 +-21.0 0.36 +-20.5 0.55 +-20.0 0.69 +-19.5 0.83 +-19.0 0.91 +-18.5 0.960 +-18.0 0.978 +-17.5 0.987 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmdata.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmdata.dat new file mode 100644 index 0000000..987bbbb --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmdata.dat @@ -0,0 +1,8 @@ +-24.5 0.000 +-24.0 0.006 +-23.5 0.046 0.066 +-23.0 0.250 0.305 +-22.5 0.630 0.701 +-22.0 0.900 0.945 +-21.5 0.992 0.9974 +-21.0 0.99987 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory25.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory25.dat new file mode 100644 index 0000000..de85456 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory25.dat @@ -0,0 +1,43 @@ +Es/No P(word error) +---------------------- + 0.0 0.9008E+00 0.1000E+01 + 0.5 0.8877E+00 0.1000E+01 + 1.0 0.8724E+00 0.1000E+01 + 1.5 0.8545E+00 0.1000E+01 + 2.0 0.8338E+00 0.1000E+01 + 2.5 0.8096E+00 0.1000E+01 + 3.0 0.7817E+00 0.1000E+01 + 3.5 0.7496E+00 0.1000E+01 + 4.0 0.7128E+00 0.1000E+01 + 4.5 0.6712E+00 0.1000E+01 + 5.0 0.6246E+00 0.9998E+00 + 5.5 0.5731E+00 0.9964E+00 + 6.0 0.5170E+00 0.9629E+00 + 6.5 0.4572E+00 0.7979E+00 + 7.0 0.3949E+00 0.4327E+00 + 7.5 0.3316E+00 0.1100E+00 + 8.0 0.2696E+00 0.9707E-02 + 8.5 0.2109E+00 0.2303E-03 + 9.0 0.1578E+00 0.1170E-05 + 9.5 0.1121E+00 0.1027E-08 +10.0 0.7499E-01 0.1263E-12 +10.5 0.4684E-01 0.1768E-17 +11.0 0.2703E-01 0.2282E-23 +11.5 0.1426E-01 0.2200E-30 +12.0 0.6789E-02 -.1348E-32 +12.5 0.2879E-02 -.1733E-32 +13.0 0.1072E-02 -.2119E-32 +13.5 0.3448E-03 0.3081E-32 +14.0 0.9421E-04 0.3852E-33 +14.5 0.2148E-04 -.1156E-32 +15.0 0.4006E-05 -.1733E-32 +15.5 0.5984E-06 0.2215E-32 +16.0 0.6994E-07 -.4430E-32 +16.5 0.6230E-08 -.3081E-32 +17.0 0.4105E-09 -.2889E-32 +17.5 0.1934E-10 -.1926E-33 +18.0 0.6266E-12 0.3852E-32 +18.5 0.1335E-13 -.1926E-33 +19.0 0.1777E-15 0.2119E-32 +19.5 0.1396E-17 0.1733E-32 +20.0 0.6076E-20 -.3852E-33 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory40.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory40.dat new file mode 100644 index 0000000..4903ef5 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory40.dat @@ -0,0 +1,43 @@ +Es/No P(word error) +---------------------- + 0.0 0.9008E+00 0.1000E+01 + 0.5 0.8877E+00 0.1000E+01 + 1.0 0.8724E+00 0.1000E+01 + 1.5 0.8545E+00 0.1000E+01 + 2.0 0.8338E+00 0.9999E+00 + 2.5 0.8096E+00 0.9991E+00 + 3.0 0.7817E+00 0.9944E+00 + 3.5 0.7496E+00 0.9713E+00 + 4.0 0.7128E+00 0.8887E+00 + 4.5 0.6712E+00 0.6883E+00 + 5.0 0.6246E+00 0.3865E+00 + 5.5 0.5731E+00 0.1310E+00 + 6.0 0.5170E+00 0.2215E-01 + 6.5 0.4572E+00 0.1536E-02 + 7.0 0.3949E+00 0.3562E-04 + 7.5 0.3316E+00 0.2223E-06 + 8.0 0.2696E+00 0.2951E-09 + 8.5 0.2109E+00 0.6449E-13 + 9.0 0.1578E+00 0.1758E-17 + 9.5 0.1121E+00 0.4426E-23 +10.0 0.7499E-01 0.7428E-30 +10.5 0.4684E-01 -.1733E-32 +11.0 0.2703E-01 0.1348E-32 +11.5 0.1426E-01 0.2985E-32 +12.0 0.6789E-02 -.1348E-32 +12.5 0.2879E-02 -.1733E-32 +13.0 0.1072E-02 -.2119E-32 +13.5 0.3448E-03 0.3081E-32 +14.0 0.9421E-04 0.3852E-33 +14.5 0.2148E-04 -.1156E-32 +15.0 0.4006E-05 -.1733E-32 +15.5 0.5984E-06 0.2215E-32 +16.0 0.6994E-07 -.4430E-32 +16.5 0.6230E-08 -.3081E-32 +17.0 0.4105E-09 -.2889E-32 +17.5 0.1934E-10 -.1926E-33 +18.0 0.6266E-12 0.3852E-32 +18.5 0.1335E-13 -.1926E-33 +19.0 0.1777E-15 0.2119E-32 +19.5 0.1396E-17 0.1733E-32 +20.0 0.6076E-20 -.3852E-33 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory43.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory43.dat new file mode 100644 index 0000000..b22ab8d --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bmtheory43.dat @@ -0,0 +1,43 @@ +Es/No P(word error) +---------------------- + 0.0 0.9008E+00 0.1000E+01 + 0.5 0.8877E+00 0.1000E+01 + 1.0 0.8724E+00 0.9999E+00 + 1.5 0.8545E+00 0.9996E+00 + 2.0 0.8338E+00 0.9977E+00 + 2.5 0.8096E+00 0.9889E+00 + 3.0 0.7817E+00 0.9559E+00 + 3.5 0.7496E+00 0.8599E+00 + 4.0 0.7128E+00 0.6586E+00 + 4.5 0.6712E+00 0.3780E+00 + 5.0 0.6246E+00 0.1397E+00 + 5.5 0.5731E+00 0.2826E-01 + 6.0 0.5170E+00 0.2632E-02 + 6.5 0.4572E+00 0.9396E-04 + 7.0 0.3949E+00 0.1052E-05 + 7.5 0.3316E+00 0.2965E-08 + 8.0 0.2696E+00 0.1650E-11 + 8.5 0.2109E+00 0.1388E-15 + 9.0 0.1578E+00 0.1316E-20 + 9.5 0.1121E+00 0.1021E-26 +10.0 0.7499E-01 -.9630E-33 +10.5 0.4684E-01 -.1733E-32 +11.0 0.2703E-01 0.1348E-32 +11.5 0.1426E-01 0.2985E-32 +12.0 0.6789E-02 -.1348E-32 +12.5 0.2879E-02 -.1733E-32 +13.0 0.1072E-02 -.2119E-32 +13.5 0.3448E-03 0.3081E-32 +14.0 0.9421E-04 0.3852E-33 +14.5 0.2148E-04 -.1156E-32 +15.0 0.4006E-05 -.1733E-32 +15.5 0.5984E-06 0.2215E-32 +16.0 0.6994E-07 -.4430E-32 +16.5 0.6230E-08 -.3081E-32 +17.0 0.4105E-09 -.2889E-32 +17.5 0.1934E-10 -.1926E-33 +18.0 0.6266E-12 0.3852E-32 +18.5 0.1335E-13 -.1926E-33 +19.0 0.1777E-15 0.2119E-32 +19.5 0.1396E-17 0.1733E-32 +20.0 0.6076E-20 -.3852E-33 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bodide.f90 b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bodide.f90 new file mode 100644 index 0000000..72e0f13 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bodide.f90 @@ -0,0 +1,54 @@ +program bodide +! Compute probability of word error for a bounded distance decoder. +! Hardwired for non-coherent 64-FSK and the JT65 RS (63,12) code on GF(64). +! +! Let ps be symbol error probability. +! The probability of getting an error pattern with e symbol errors is: +! ps^e * (1-ps)*(n-e) +! The number of error patterns with e errors is binomial(63,e) +! Overall probability of getting a word with e errors is: +! P(e)= binomial(63,e)* ps^e * (1-ps)*(n-e) +! Probability that word is correct is P(0 to 25 errors) = sum{e=0}^{25} P(e) +! Probability that word is wrong is 1-P(0 to 25 errors) +! P_word_error=1-( sum_{e=0}^{t} P(e) ) +! + implicit real*16 (a-h,o-z) + + integer*8 binomial + integer x,s,XX,NN,M + character arg*8 + + nargs=iargc() + if(nargs.ne.1) then + print*,'Probability of word error for noncoherent 64-FSK with bounded distance decoding' + print*,'Usage: bounded_distance D' + print*,'Example: bounded_distance 25' + go to 999 + endif + call getarg(1,arg) + read(arg,*) nt + M=64 + write(*,1012) +1012 format('Es/No P(word error)'/ & + '----------------------') + do isnr=0,40 + esno=10**(isnr/2.0/10.0) + hsum=0.d0 + do k=1,M-1 + h=binomial(M-1,k) + h=h*((-1)**(k+1))/(k+1) + h=h*exp(-esno*k/(k+1)) + hsum=hsum + h + enddo + ps=hsum + hsum=0.d0 + do i=0,nt + h=binomial(63,i) + h=h*ps**i + h=h*(1-ps)**(63-i) + hsum=hsum+h + enddo + pw=1-hsum + write(*,'(f4.1,4x,e10.4,4x,e10.4)') isnr/2.0, ps, pw + enddo +999 end program bodide diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/bodide.lab b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bodide.lab new file mode 100644 index 0000000..6fa108e --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/bodide.lab @@ -0,0 +1,4 @@ +7.5 0.05 BM +6.9 0.015 Theory +5.55 0.05 KV +5.3 0.005 FT diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_bodide.gnuplot b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_bodide.gnuplot new file mode 100644 index 0000000..b8bb0ad --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_bodide.gnuplot @@ -0,0 +1,24 @@ +# gnuplot script for comparison to theoretical word error rate for +# bounded distance decoding + +# run: gnuplot fig_bodide.gnuplot +# then: pdflatex fig_bodide.tex + +set term epslatex standalone size 6in,2*6/3in +set output "fig_bodide.tex" +set xlabel "$E_b/N_0$ (dB)" +set ylabel "Word Error Rate" +set style func linespoints +set key off +set tics in +set mxtics 2 +set mytics 10 +set grid +set logscale y +plot [3:9] [1e-4:1] \ + "bmdata.dat" using ($1+29.1):(1-$2) with linespoints lt 2 lw 2 pt 2, \ + "ftdata-100000.dat" using ($1+29.1):(1-$3) with linespoints lt 1 lw 2 pt 7, \ + "bmtheory25.dat" using ($1-0.6):3 with linespoints lt 1 pt 5, \ + "kvasd-15.dat" using ($1+29.1):(1-$3) with linespoints lt 4 pt 6, \ + "bodide.lab" with labels + diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_ntrials_vs_nhard.gnuplot b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_ntrials_vs_nhard.gnuplot new file mode 100644 index 0000000..9a6c9b0 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_ntrials_vs_nhard.gnuplot @@ -0,0 +1,14 @@ +# gnuplot script for "ntrials_vs_nhard" figure +# run: gnuplot fig_ntrials_vs_nhard.gnuplot +# then: pdflatex fig_ntrials_vs_nhard.tex +# +set term epslatex standalone size 6in,2*6/3in +set output "fig_ntrials_vs_nhard.tex" +set xlabel "Errors in received word, $X$" +set ylabel "Number of trials" +set tics in +set mxtics 5 +set mytics 10 +#set grid +set logscale y +plot "stats-100000-24db-3.dat" using 1:4 pt 12 notitle diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_psuccess.gnuplot b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_psuccess.gnuplot new file mode 100644 index 0000000..3718e29 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_psuccess.gnuplot @@ -0,0 +1,25 @@ +# gnuplot script for "Percent copy" figure +# run: gnuplot fig_psuccess.gnuplot +# then: pdflatex fig_psuccess.tex +# +set term epslatex standalone size 6in,4in +set output "fig_psuccess.tex" +set xlabel "SNR in 2500 Hz Bandwidth (dB)" +set ylabel "Percent copy" +set style func linespoints +set key off +set tics in +set mxtics 2 +set mytics 2 +set grid +plot [-30:-18] [0:105] \ + "stats_0.0" using 1:($4)/10.0 with linespoints lt 2 lw 2 pt 2, \ + "stats_0.0" using 1:($5)/10.0 with linespoints lt 1 lw 2 pt 3, \ + "stats_0.0" using 1:($6)/10.0 with linespoints lt 3 lw 2 pt 4, \ + "stats_0.2" using 1:($4)/10.0 with linespoints lt 2 pt 2, \ + "stats_0.2" using 1:($5)/10.0 with linespoints lt 1 pt 3, \ + "stats_0.2" using 1:($6)/10.0 with linespoints lt 3 pt 4, \ + "stats_1.0" using 1:($4)/10.0 with linespoints lt 2 pt 2, \ + "stats_1.0" using 1:($5)/10.0 with linespoints lt 1 pt 3, \ + "stats_1.0" using 1:($6)/10.0 with linespoints lt 3 pt 4, \ + "psuccess.lab" with labels diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_psuccess.pdf b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_psuccess.pdf new file mode 100644 index 0000000..7464629 Binary files /dev/null and b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_psuccess.pdf differ diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_subtracted.tiff b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_subtracted.tiff new file mode 100644 index 0000000..b6f0f2f Binary files /dev/null and b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_subtracted.tiff differ diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_waterfall.png b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_waterfall.png new file mode 100644 index 0000000..b2a8dd9 Binary files /dev/null and b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_waterfall.png differ diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_waterfall.tiff b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_waterfall.tiff new file mode 100644 index 0000000..ae2cbdd Binary files /dev/null and b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_waterfall.tiff differ diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer.gnuplot b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer.gnuplot new file mode 100644 index 0000000..bff0533 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer.gnuplot @@ -0,0 +1,23 @@ +# gnuplot script for "Percent copy" figure +# run: gnuplot fig_wer.gnuplot +# then: pdflatex fig_wer.tex +# +set term epslatex standalone size 6in,4in +set output "fig_wer.tex" +set xlabel "$E_b/N_0$ (dB)" +set ylabel "Word Error Rate" +set style func linespoints +set key off +set tics in +set mxtics 2 +set mytics 10 +set grid +set logscale y +plot [3:7] "ftdata-100000.dat" using ($1+29.1):(1-$2) with linespoints lt 1 pt 7 title 'FT-100K', \ + "ftdata-10000.dat" using ($1+29.1):(1-$2) with linespoints lt 1 pt 7 title 'FT-10K', \ + "ftdata-1000.dat" using ($1+29.1):(1-$2) with linespoints lt 1 pt 7 title 'FT-1K', \ + "kvasd-8.dat" using ($1+29.1):(1-$2) with linespoints lt 2 pt 8 title 'KV-8', \ + "kvasd-12.dat" using ($1+29.1):(1-$2) with linespoints lt 2 pt 8 title 'KV-12', \ + "kvasd-15.dat" using ($1+29.1):(1-$2) with linespoints lt 2 pt 8 title 'KV-15', \ + "bmdata.dat" using ($1+29.1):(1-$2) with linespoints pt 7 title 'BM', \ + "wer.lab" with labels diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer.pdf b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer.pdf new file mode 100644 index 0000000..6533f00 Binary files /dev/null and b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer.pdf differ diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer2.gnuplot b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer2.gnuplot new file mode 100644 index 0000000..dc8edc9 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer2.gnuplot @@ -0,0 +1,23 @@ +# gnuplot script for "Percent copy" figure +# run: gnuplot fig_wer2.gnuplot +# then: pdflatex fig_wer2.tex +# +set term epslatex standalone size 6in,6*2/3in +set output "fig_wer2.tex" +set xlabel "SNR in 2500 Hz Bandwidth (dB)" +set ylabel "Percent Copy" +set style func linespoints +set key off +set tics in +set mxtics 2 +set mytics 5 +set grid +plot [-27:-22] [0:110] \ + "ftdata-100000.dat" using 1:(100*$3) with linespoints lt 1 lw 2 pt 7, \ + "ftdata-10000.dat" using 1:(100*$3) with linespoints lt 1 lw 2 pt 7, \ + "ftdata-1000.dat" using 1:(100*$3) with linespoints lt 1 lw 2 pt 7, \ + "ftdata-100.dat" using 1:(100*$3) with linespoints lt 1 lw 2 pt 7, \ + "ftdata-10.dat" using 1:(100*$2) with linespoints lt 1 lw 2 pt 7, \ + "kvasd-15.dat" using 1:(100*$2) with linespoints lt 4 pt 6, \ + "bmdata.dat" using 1:(100*$2) with linespoints lt 2 lw 2 pt 2, \ + "wer2.lab" with labels diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer3.gnuplot b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer3.gnuplot new file mode 100644 index 0000000..f3c9d27 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/fig_wer3.gnuplot @@ -0,0 +1,21 @@ +# gnuplot script for "Percent copy" figure +# run: gnuplot fig_wer3.gnuplot +# then: pdflatex fig_wer3.tex +# +set term epslatex standalone size 6in,6*2/3in +set output "fig_wer3.tex" +set xlabel "SNR in 2500 Hz Bandwidth (dB)" +set ylabel "Percent Copy" +set style func linespoints +set key off +set tics in +set mxtics 2 +set mytics 10 +set grid +set label "r6315" at -25.25,30 +set label "r6330" at -26.0,30 +set label "$T=10^5$" at -22.8,15 +set label "$d=0.0$" at -22.8,10 +plot [-27:-22] [0:110] \ + "ftdata-100000.dat" using 1:(100*$3) with linespoints lt 1 pt 7 title 'FT-100K', \ + "ftdata-100000.dat" using 1:(100*$2) with linespoints lt 1 pt 7 title 'FT-100K' diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-10.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-10.dat new file mode 100644 index 0000000..467be38 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-10.dat @@ -0,0 +1,10 @@ + snr psuccess ntrials 10, r6321, r6333 +-26.0 0.0 +-25.5 0.007 +-25.0 0.039 +-24.5 0.157 0.14 +-24.0 0.362 +-23.5 0.701 0.681 +-23.0 0.914 +-22.5 0.985 0.988 +-22.0 1.0 1.0 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-100.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-100.dat new file mode 100644 index 0000000..a5d547c --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-100.dat @@ -0,0 +1,10 @@ + snr psuccess ntrials 100, r6321, r6333 +-26.0 0.003 0.003 +-25.5 0.033 0.037 +-25.0 0.113 0.113 +-24.5 0.315 0.330 +-24.0 0.635 0.670 +-23.5 0.908 0.903 +-23.0 0.977 0.984 +-22.5 0.9986 0.999 +-22.0 1.0 1.0 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-1000.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-1000.dat new file mode 100644 index 0000000..156a0b3 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-1000.dat @@ -0,0 +1,9 @@ + snr psuccess ntrials 1000, r6315, r6333 +-26.0 0.010 0.022 +-25.5 0.052 0.097 +-25.0 0.22 0.262 +-24.5 0.51 0.535 +-24.0 0.80 0.844 +-23.5 0.956 0.968 +-23.0 0.9958 0.9963 +-22.5 1.0 1.0 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-10000.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-10000.dat new file mode 100644 index 0000000..99d4859 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-10000.dat @@ -0,0 +1,11 @@ + snr psuccess ntrials 10000 r6315, r6330 +-27.0 0.000 0.001 +-26.5 0.004 0.014 +-26.0 0.03 0.066 +-25.5 0.107 0.208 0.19 +-25.0 0.353 0.424 0.40 (2) +-24.5 0.653 0.725 +-24.0 0.913 0.913 +-23.5 0.983 0.988 +-23.0 0.998 0.999 +-22.0 1.0 1.0 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-100000.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-100000.dat new file mode 100644 index 0000000..e2db520 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftdata-100000.dat @@ -0,0 +1,11 @@ +snr psuccess 100000 trials r6315, r6330, +-27.0 0.0 0.011 +-26.5 0.007 0.035 +-26.0 0.057 0.135 +-25.5 0.207 0.326 +-25.0 0.531 0.568 +-24.5 0.822 0.836 +-24.0 0.953 0.966 +-23.5 0.99423 0.996 +-23.0 0.99967 0.99974 302956/303056, 218991/219046 + diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftrsd.lyx b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftrsd.lyx new file mode 100644 index 0000000..4549c76 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/ftrsd.lyx @@ -0,0 +1,3289 @@ +#LyX 2.1 created this file. For more info see http://www.lyx.org/ +\lyxformat 474 +\begin_document +\begin_header +\textclass paper +\begin_preamble +\usepackage{ragged2e} +\exhyphenpenalty=10000\hyphenpenalty=10000 + +\fancyhf{} +\fancyhead[L]{Franke \& Taylor: {\it Open Source Soft-Decision Decoder \ldots}} +\fancyhead[R]{\thepage} +\makeatletter +\let\ps@plain\ps@fancy % Plain page style = fancy page style +\makeatother + +\usepackage{nomencl} +\usepackage{overcite} + +\renewcommand{\nomname}{Sidebar: Glossary of Specialized Terms} +\end_preamble +\use_default_options true +\begin_modules +boxedfloat +\end_modules +\maintain_unincluded_children false +\language english +\language_package default +\inputencoding auto +\fontencoding global +\font_roman lmodern +\font_sans lmss +\font_typewriter lmtt +\font_math auto +\font_default_family default +\use_non_tex_fonts false +\font_sc false +\font_osf false +\font_sf_scale 100 +\font_tt_scale 100 +\graphics default +\default_output_format default +\output_sync 0 +\bibtex_command default +\index_command default +\float_placement H +\paperfontsize 12 +\spacing onehalf +\use_hyperref false +\papersize default +\use_geometry true +\use_package amsmath 1 +\use_package amssymb 1 +\use_package cancel 1 +\use_package esint 1 +\use_package mathdots 1 +\use_package mathtools 1 +\use_package mhchem 1 +\use_package stackrel 1 +\use_package stmaryrd 1 +\use_package undertilde 1 +\cite_engine basic +\cite_engine_type default +\biblio_style plain +\use_bibtopic false +\use_indices false +\paperorientation portrait +\suppress_date false +\justification false +\use_refstyle 1 +\index Index +\shortcut idx +\color #008000 +\end_index +\leftmargin 1in +\topmargin 1in +\rightmargin 1in +\bottommargin 1in +\secnumdepth 3 +\tocdepth 3 +\paragraph_separation skip +\defskip bigskip +\quotes_language english +\papercolumns 1 +\papersides 1 +\paperpagestyle fancy +\tracking_changes false +\output_changes false +\html_math_output 0 +\html_css_as_file 0 +\html_be_strict false +\end_header + +\begin_body + +\begin_layout Title +Open Source Soft-Decision Decoder for the JT65 (63,12) Reed-Solomon Code +\end_layout + +\begin_layout SubTitle + +\emph on +Under-the-hood description of the JT65 decoding procedure, including a wholly + new algorithm for its powerful error-correcting code. +\end_layout + +\begin_layout Author +Steven J. + Franke, K9AN and Joseph H. + Taylor, K1JT +\end_layout + +\begin_layout Section +\begin_inset CommandInset label +LatexCommand label +name "sec:Introduction-and-Motivation" + +\end_inset + +Background and Motivation +\end_layout + +\begin_layout Standard +\begin_inset ERT +status open + +\begin_layout Plain Layout + + +\backslash +RaggedRight +\end_layout + +\end_inset + + The JT65 protocol has revolutionized amateur-radio weak-signal communication + by enabling operators with small or compromise antennas and relatively + low-power transmitters to communicate over propagation paths not usable + with traditional technologies. + The protocol was developed in 2003 for Earth-Moon-Earth (EME, or +\begin_inset Quotes eld +\end_inset + +moonbounce +\begin_inset Quotes erd +\end_inset + +) communication +\begin_inset CommandInset citation +LatexCommand cite +key "jt65_protocol" + +\end_inset + +, where the scattered return signals are always weak. + It was soon found that JT65 also enables worldwide communication on the + HF bands with low power, modest antennas, and efficient spectral usage. + Thousands of amateurs now use JT65 on a regular basis, making contacts + on all bands from 160 meters through microwaves. +\end_layout + +\begin_layout Standard +JT65 uses timed transmitting and receiving sequences one minute long. + Messages are short and structured so as to streamline minimal exchanges + between two amateur operators over potentially difficult radio paths. + Most messages contain two callsigns and a grid locator, signal report, + acknowledgment, or sign-off; one of the tokens CQ, QRZ, or DE may be substitute +d for the first callsign. + Alternatively, a message may contain up to 13 Latin characters of arbitrary + text. + All messages are efficiently compressed into exactly 72 bits of digital + information. + It should be obvious that the JT65 protocol is intended for the basic purpose + of completing legitimate, documented two-way contacts, but not for extended + conversations. + Full details of the message structure and encoding procedure were presented + in an earlier publication +\begin_inset CommandInset citation +LatexCommand cite +key "jt65_protocol" + +\end_inset + +. + For a concise description of the overall process of transmitting and receiving + a JT65 message, see the accompanying sidebar +\series bold +JT65 Message Processing +\series default +. +\end_layout + +\begin_layout Standard +A major reason for the success and popularity of JT65 is its use of a strong + error-correction code. + Before transmission, each 72-bit message is divided into 12 six-bit +\emph on +symbols +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Symbol: }" +description "The information carried in one signalling interval, usually an integral number of bits. JT65 uses 6-bit symbols." + +\end_inset + + +\emph default + and augmented with 51 additional symbols of error-correcting information. + These 51 +\emph on +parity symbols +\emph default + are computed according to information-theory rules that maximize the probabilit +y of correctly decoding the message, even if many symbols are received incorrect +ly. + The JT65 code is properly described as a short block-length, low-rate Reed-Solo +mon code based on a 64-symbol +\emph on +alphabet. + +\emph default + +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Alphabet: }" +description "A sequence of possible symbol values used for signaling. JT65 uses a 64-character alphabet, values in the range 0 to 63." + +\end_inset + + Characters in this alphabet are mapped onto 64 different frequencies for + transmission. + +\end_layout + +\begin_layout Standard +Reed Solomon codes are widely used to ensure reliability in data transmission + and storage. + In hardware implementations, decoding is generally accomplished with a + procedure such as the Berlekamp-Massey (BM) algorithm, based on +\emph on +hard decisions +\emph default + +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Hard decision: }" +description "Received symbols are assigned definite values by the demodulator." + +\end_inset + + for each of the symbol values received. + +\emph on +Soft decisions +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Soft decision: }" +description "Received symbols are assigned tentative values (most probable, second most probable, etc.) and quality indicators." + +\end_inset + + +\emph default + are potentially more powerful, however. + For each received JT65 symbol we can estimate not only the value most likely + to be correct, but also the second, third, etc., most likely. + Most importantly, we can also estimate the probability that each of those + possible values is the correct one. + Decoders that make use of such information are called +\emph on +soft-decision decoders. +\end_layout + +\begin_layout Standard +Until now, nearly all programs implementing JT65 have used the patented + Kötter-Vardy (KV) algebraic soft-decision decoder +\begin_inset CommandInset citation +LatexCommand cite +key "kv2001" + +\end_inset + +, licensed to and implemented by K1JT as a closed-source executable for + use only in amateur radio applications. + Since 2001 the KV decoder has been considered the best available soft-decision + decoder for Reed Solomon codes. +\end_layout + +\begin_layout Standard +We describe here a new open-source alternative called the Franke-Taylor + (FT, or K9AN-K1JT) soft-decision decoding algorithm. + It is conceptually simple, built on top of the BM hard-decision decoder, + and in this application it performs even better than the KV decoder. + The FT algorithm is implemented in the popular programs +\emph on +WSJT +\emph default +, +\emph on +MAP65 +\emph default +, and +\emph on +WSJT-X +\emph default +, widely used for amateur weak-signal communication using JT65 and other + specialized digital protocols. + These programs are open-source, freely available +\begin_inset CommandInset citation +LatexCommand cite +key "wsjt" + +\end_inset + +, and licensed under the GNU General Public License. +\end_layout + +\begin_layout Standard +The JT65 protocol specifies transmissions that start one second into a UTC + minute and last for 46.8 seconds. + Receiving software therefore has as much as ten seconds to decode a message + before the start of the next minute, when the operator will send a reply. + With today's personal computers, this relatively long time encourages experimen +tation with decoders of high computational complexity. + With time to spare, the FT algorithm lowers the decoding threshold on a + typical fading channel by many dB over the hard-decision BM decoder, and + by a meaningful amount over the KV decoder. + In addition to its excellent performance, the new algorithm has other desirable + properties, not least of which is its conceptual simplicity. + Decoding performance and computational complexity scale in a convenient + way, providing steadily increasing soft-decision decoding gain as a tunable + parameter is increased over more than five orders of magnitude. + Appreciable gain is available from our decoder even on very simple (and + relatively slow) computers. + On the other hand, because the algorithm benefits from a large number of + independent decoding trials, further performance gains should be achievable + through parallelization on high-performance computers. +\end_layout + +\begin_layout Standard +The remainder of this paper is organized as follows. + Section 2 presents a brief overview of the nature of Reed Solomon codes + and their error-correcting capabilities. + Section 3 provides statistical motivation for the FT algorithm, and Section + 4 describes the algorithm in full detail. + Material in these two sections is important because it documents our approach + and underlines its fundamental technical contributions. + These sections are heavier in formal mathematics than common in +\emph on +QEX +\emph default +; for this reason, some readers may choose to skip or skim them and proceed + more quickly to the results. + Most readers will benefit by reviewing the original paper on the JT65 protocol + +\begin_inset CommandInset citation +LatexCommand cite +key "jt65_protocol" + +\end_inset + +. + A procedure for +\emph on +hinted decoding +\emph default +--- determining which one, if any, of a list of likely messages matches + the one that was received --- is outlined in Section 5. + Finally, in Section 6 we present performance measurements of the FT and + hinted decoding algorithms and make explicit comparisons to the BM and + KV decoders familiar to users of older versions of +\emph on +WSJT +\emph default +, +\emph on +MAP65 +\emph default + and +\emph on +WSJT-X +\emph default +. + Section 7 summarizes some on-the-air experiences with the new decoder. + Refer to the sidebar +\series bold +Glossary of Specialized Terms +\series default + for brief definitions of some potentially unfamiliar language. +\end_layout + +\begin_layout Section +\begin_inset CommandInset label +LatexCommand label +name "sec:JT65-messages-and" + +\end_inset + +JT65 Messages and Reed Solomon Codes +\end_layout + +\begin_layout Standard +The JT65 message frame consists of a short, compressed 72-bit message encoded + for transmission with a Reed-Solomon code. + Reed-Solomon codes are +\emph on +block codes +\emph default + +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Block code: }" +description "An error-correcting code that treats data in blocks of fixed size." + +\end_inset + + characterized by +\begin_inset Formula $n$ +\end_inset + +, the length of their +\emph on +codewords +\emph default +; +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Codeword:}" +description "For the JT65 code, a vector of 63 symbol values each in the range 0 to 63." + +\end_inset + + +\begin_inset Formula $k$ +\end_inset + +, the number of message symbols conveyed by the codeword; and the transmission + alphabet, or number of possible values for each symbol in a codeword. + The codeword length and the number of message symbols are specified with + the notation +\begin_inset Formula $(n,k)$ +\end_inset + +. + JT65 uses a (63,12) Reed-Solomon code with an alphabet of 64 possible values + for each symbol. + Each of the 12 message symbols represents +\begin_inset Formula $\log_{2}64=6$ +\end_inset + + message bits. + The source-encoded +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Source encoding: }" +description "Compression of a message to use a minimum number or bits. JT65 source-encodes all messages to 72 bits." + +\end_inset + + message conveyed by a 63-symbol JT65 frame thus consists of 72 information + bits. + The JT65 code is +\emph on +systematic +\emph default +, which means that the 12 message symbols are embedded in the codeword without + modification and another 51 parity symbols derived from the message symbols + are added to form a codeword of 63 symbols. + +\end_layout + +\begin_layout Standard +In coding theory the concept of +\emph on +Hamming distance +\emph default + +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Hamming distance: }" +description "The Hamming distance between two codewords, or between a received word and a codeword, is equal to the number of symbol positions in which they differ." + +\end_inset + + is used as a measure of disagreement between different codewords, or between + a received word +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Received word: }" +description "A vector of symbol values, possibly accompanied by soft information on individual reliabilities." + +\end_inset + + and a codeword. + Hamming distance is the number of code symbols that differ in two words + being compared. + Reed-Solomon codes have guaranteed minimum Hamming distance +\begin_inset Formula $d$ +\end_inset + +, where +\begin_inset Formula +\begin{equation} +d=n-k+1.\label{eq:minimum_distance} +\end{equation} + +\end_inset + +With +\begin_inset Formula $n=63$ +\end_inset + + and +\begin_inset Formula $k=12$ +\end_inset + + the minimum Hamming distance of the JT65 code is +\begin_inset Formula $d=52$ +\end_inset + +. + With 72 information bits in each message, JT65 can transmit any one of + +\begin_inset Formula $2^{72}\approx4.7\times10^{21}$ +\end_inset + + possible messages. + The codeword for any message differs from every other codeword in at least + 52 of the 63 symbol positions. +\end_layout + +\begin_layout Standard +A received word containing some +\emph on +errors +\emph default + (incorrect symbols) can be decoded into the correct codeword using a determinis +tic, +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Deterministic algorithm: }" +description "A series of computational steps that for the same input always produces the same output." + +\end_inset + + algebraic algorithm provided that no more than +\begin_inset Formula $t$ +\end_inset + + symbols were received incorrectly, where +\begin_inset Formula +\begin{equation} +t=\left\lfloor \frac{n-k}{2}\right\rfloor .\label{eq:t} +\end{equation} + +\end_inset + +For the JT65 code +\begin_inset Formula $t=25$ +\end_inset + +, so it is always possible to decode a received word having 25 or fewer + symbol errors. + Any one of several well-known algebraic algorithms, such as the BM algorithm, + can carry out this hard-decision decoding. + Two steps are necessarily involved in this process. + We must (1) determine which symbols were received incorrectly, and (2) + find the correct value of the incorrect symbols. + If we somehow know that certain symbols are incorrect, that information + can be used to reduce the work involved in step 1 and allow step 2 to correct + more than +\begin_inset Formula $t$ +\end_inset + + errors. + In the unlikely event that the location of every error is known, and if + no correct symbols are accidentally labeled as errors, the BM algorithm + can correct up to +\begin_inset Formula $d-1=n-k$ +\end_inset + + errors. + +\end_layout + +\begin_layout Standard +The FT algorithm creates lists of symbols suspected of being incorrect and + sends them to the BM decoder. + Symbols flagged in this way are called +\emph on +erasures +\emph default + +\begin_inset CommandInset nomenclature +LatexCommand nomenclature +symbol "{\\bf Erasure: }" +description "A received symbol may be ``erased'' when confidence in its value is so low that it is unlikely to provide useful information. " + +\end_inset + +. + With perfect erasure information up to +\begin_inset Formula $n-k=51$ +\end_inset + + incorrect symbols can be corrected for the JT65 code. + Imperfect erasure information means that some erased symbols may be correct, + and some other symbols in error. + If +\begin_inset Formula $s$ +\end_inset + + symbols are erased and the remaining +\begin_inset Formula $n-s$ +\end_inset + + symbols contain +\begin_inset Formula $e$ +\end_inset + + errors, the BM algorithm can find the correct codeword as long as +\begin_inset Formula +\begin{equation} +s+2e\le d-1.\label{eq:erasures_and_errors} +\end{equation} + +\end_inset + +If +\begin_inset Formula $s=0$ +\end_inset + +, the decoder is said to be an +\emph on +errors-only +\emph default + decoder. + If +\begin_inset Formula $0=x|N,X,s) '/ & + '-------------------------------') + + hsum=0.d0 + do ix=x,XX + h=hypergeo(ix,NN,XX,s) + hsum=hsum + h + write(*,1020) ix,h,hsum +1020 format(i3,2d13.4) + enddo + +999 end program prob diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/psuccess.lab b/wsjtx_lib/lib/ftrsd/ftrsd_paper/psuccess.lab new file mode 100644 index 0000000..21ed973 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/psuccess.lab @@ -0,0 +1,14 @@ +-21.5 55 BM +-24.5 50 FT +-27.0 68 DS +-25.2 25 0 +-25.7 37 0.2 +-24.6 16 1.0 +-22.6 35 0 +-20.9 29 0.2 +-19.5 35 1.0 +-28.5 25 1.0 +-28.2 56 0.2 +-28.5 72 0 + + diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats-100000-24db-3.dat b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats-100000-24db-3.dat new file mode 100644 index 0000000..bd2a10f --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats-100000-24db-3.dat @@ -0,0 +1,930 @@ + 35 19 45 12 + 34 20 46 6 + 35 27 43 4519 + 33 21 44 11 + 32 22 39 8 + 34 21 48 333 + 30 20 42 2 + 38 25 43 12 + 38 25 49 2958 + 28 20 43 10 + 41 29 44 4070 + 32 19 44 1 + 28 19 43 2 + 38 28 43 10421 + 25 0 0 0 + 36 24 42 8 + 38 25 42 243 + 39 25 45 81 + 33 17 39 2 + 38 25 39 157 + 37 27 45 1 + 31 18 39 8 + 35 22 41 2 + 31 20 45 32 + 40 30 45 11123 + 34 25 48 516 + 37 22 49 73 + 32 19 45 2 + 39 25 43 49 + 35 25 42 12 + 43 32 45 3645 + 35 21 45 124 + 39 26 48 31 + 40 26 48 23 + 36 25 43 169 + 33 21 41 8 + 31 21 49 3 + 37 23 46 2 + 32 27 41 8 + 36 23 43 2112 + 29 19 49 4 + 34 24 41 170 + 27 15 44 1 + 34 21 43 2 + 39 25 47 28 + 30 18 43 10 + 37 22 40 8 + 42 33 48 64709 + 36 25 43 10 + 35 20 51 17 + 37 28 45 301 + 34 18 40 9 + 34 25 47 23 + 39 28 43 4856 + 36 24 45 7057 + 35 25 47 769 + 38 28 47 208 + 39 27 47 52290 + 35 22 44 85 + 34 23 48 7 + 37 21 47 82 + 42 25 39 1677 + 29 17 41 8 + 41 24 46 656 + 35 24 43 2 + 38 22 45 10400 + 36 20 42 14 + 33 22 46 2 + 25 0 0 0 + 33 20 45 12 + 30 17 45 1 + 34 20 43 40 + 32 21 42 14 + 28 15 44 1 + 37 23 42 8 + 32 21 40 8 + 39 28 44 65 + 30 17 41 2 + 32 25 44 134 + 38 24 43 12 + 38 23 47 153 + 39 26 42 8 + 37 20 47 35 + 39 27 47 1003 + 36 23 45 215 + 38 28 49 46 + 34 24 47 200 + 35 23 40 8 + 30 19 44 1 + 38 25 43 32 + 32 22 39 103 + 33 23 42 2 + 34 24 47 6 + 33 22 43 13 + 42 28 43 2127 + 34 22 41 113 + 39 30 41 517 + 30 17 42 8 + 32 20 45 1 + 34 20 51 17 + 32 15 39 9 + 37 23 47 223 + 28 15 43 1 + 38 24 42 251 + 41 26 45 2 + 39 25 49 7 + 35 26 47 237 + 32 18 43 25 + 33 23 43 8 + 41 29 43 2667 + 28 17 45 1 + 34 23 47 53 + 32 19 39 9 + 34 24 42 59 + 36 22 44 8 + 34 20 45 59 + 37 24 45 12 + 28 17 44 1 + 41 29 43 24865 + 32 19 46 6 + 33 22 47 6 + 36 20 47 143 + 36 22 47 34 + 33 19 39 9 + 38 22 44 523 + 34 24 42 737 + 36 24 39 170 + 35 22 43 2 + 32 19 48 22 + 33 20 49 76 + 42 24 49 6910 + 37 22 47 94 + 40 24 43 6 + 35 25 45 33 + 29 22 41 2 + 40 24 46 2096 + 37 20 45 135 + 36 26 43 113 + 36 21 43 13 + 37 24 47 49 + 35 24 43 54 + 37 22 43 8 + 35 23 44 2 + 30 20 43 11 + 39 30 47 2870 + 42 33 44 585 + 26 17 45 2 + 41 29 47 79 + 40 24 46 836 + 33 19 45 201 + 34 21 39 13 + 33 21 49 60 + 35 24 44 248 + 33 24 43 24 + 39 29 44 151 + 31 23 46 1 + 36 23 46 1 + 41 27 47 5565 + 42 26 47 378 + 35 27 45 4571 + 40 30 47 6422 + 32 20 42 8 + 38 28 45 449 + 38 26 47 595 + 39 24 47 1555 + 41 25 49 645 + 32 19 40 8 + 35 25 45 97 + 25 0 0 0 + 30 19 44 25 + 31 18 45 1 + 41 24 51 6915 + 34 23 46 1917 + 30 19 43 2 + 35 22 47 20 + 38 23 43 882 + 30 20 48 5 + 37 25 44 919 + 34 20 45 74 + 38 25 46 394 + 39 21 49 738 + 35 20 47 22 + 40 30 47 190 + 41 27 45 1515 + 39 27 49 55 + 35 25 41 994 + 39 27 47 7117 + 37 22 46 19 + 33 21 41 2 + 34 18 47 19 + 30 20 46 6 + 31 21 46 1 + 36 24 47 98 + 40 24 43 39 + 38 25 45 138 + 41 27 47 33 + 40 29 49 2510 + 36 26 43 2 + 34 21 45 1 + 40 26 49 1924 + 36 17 43 2 + 38 27 45 68 + 34 22 45 61 + 32 22 40 8 + 37 19 43 4784 + 32 16 43 8 + 38 27 50 46 + 35 21 43 38 + 35 22 49 4 + 38 27 49 31 + 39 28 47 4677 + 30 18 45 2 + 43 28 47 8235 + 38 28 43 830 + 32 21 47 15 + 37 24 42 10 + 37 23 45 259 + 37 25 45 35 + 40 24 45 524 + 35 19 44 1 + 36 23 45 84 + 36 24 50 17 + 31 20 46 1 + 35 24 42 74 + 42 27 47 1445 + 40 28 48 31 + 36 23 45 151 + 34 22 46 6 + 33 24 49 16 + 30 20 45 2 + 38 22 43 125 + 40 25 49 64 + 35 23 49 86 + 38 24 46 613 + 42 25 47 4232 + 34 24 43 31 + 32 18 41 2 + 37 26 43 70 + 37 27 41 14 + 37 22 39 129 + 38 27 49 3 + 32 22 47 15 + 41 27 41 472 + 38 24 43 25 + 35 28 43 309 + 41 25 47 82 + 40 23 43 8 + 40 21 43 1716 + 38 22 48 5 + 37 20 47 22 + 42 28 43 315 + 32 23 43 79 + 25 0 0 0 + 42 23 47 2245 + 35 24 45 2 + 41 25 44 12 + 36 23 43 1 + 36 19 45 151 + 41 28 45 2207 + 40 27 45 76 + 34 20 47 6 + 41 28 46 370 + 38 20 45 12 + 32 20 43 8 + 39 24 45 8 + 41 27 47 26941 + 35 23 46 3 + 34 25 41 14 + 43 27 47 26905 + 35 25 45 2 + 32 20 50 3 + 31 17 41 2 + 38 26 47 4157 + 33 24 41 2 + 41 29 43 26513 + 35 22 45 297 + 37 26 44 99 + 33 19 43 10 + 39 23 45 138 + 39 26 47 1320 + 33 22 42 2 + 42 32 45 791 + 33 23 51 3 + 38 25 43 8 + 40 27 49 1210 + 43 27 45 32969 + 37 26 49 108 + 38 18 45 1268 + 40 28 49 7810 + 36 25 44 47 + 38 27 48 20 + 34 20 44 10 + 41 27 45 429 + 33 18 43 8 + 29 17 45 1 + 40 25 42 9 + 30 21 49 4 + 37 22 45 10 + 23 0 0 0 + 36 15 45 2509 + 29 21 45 18 + 33 23 45 53 + 43 27 49 7533 + 37 28 45 2652 + 36 24 49 31 + 32 20 43 25 + 42 27 49 1500 + 41 26 45 8 + 40 25 47 152 + 37 26 45 151 + 37 27 43 139 + 34 20 47 4 + 31 21 43 44 + 37 28 45 241 + 35 25 45 422 + 33 22 45 6 + 39 26 48 23 + 38 27 49 359 + 42 26 45 1430 + 36 28 47 116 + 33 23 41 232 + 38 25 47 73 + 35 24 43 16 + 42 29 47 398 + 38 27 49 2203 + 32 20 47 3 + 32 18 48 3 + 36 23 47 44 + 37 24 48 147 + 39 22 45 31 + 31 20 44 1 + 34 21 43 8 + 39 27 47 201 + 34 23 44 12 + 34 24 43 8 + 36 17 46 2 + 41 27 47 8709 + 41 26 45 112 + 37 23 47 216 + 38 24 45 93 + 32 19 45 44 + 34 22 45 8 + 33 24 41 14 + 34 22 41 9 + 35 23 42 136 + 36 26 43 3272 + 34 18 44 40 + 38 25 43 316 + 29 23 39 9 + 35 23 45 2 + 41 29 42 136 + 37 26 43 12 + 34 21 46 43 + 39 21 47 23 + 40 29 49 14666 + 36 19 45 400 + 37 24 43 8 + 35 19 44 2 + 36 26 45 14 + 36 22 43 103 + 33 19 45 6 + 35 24 43 1 + 31 22 43 80 + 35 23 46 22 + 28 18 41 2 + 35 24 45 31 + 34 24 47 46 + 37 24 42 2 + 37 27 43 525 + 31 16 41 9 + 30 18 45 2 + 39 25 47 1416 + 37 24 46 23 + 40 28 49 5 + 39 26 46 2071 + 28 13 42 8 + 31 17 47 3 + 34 22 49 3 + 42 23 47 61 + 30 21 41 2 + 40 23 47 208 + 38 22 48 6 + 35 17 40 8 + 36 20 45 32 + 37 22 47 1116 + 41 28 47 14145 + 43 28 49 96342 + 35 19 45 102 + 31 23 43 8 + 33 20 43 1 + 30 19 46 90 + 41 27 45 19090 + 35 26 45 2942 + 40 25 47 127 + 35 23 45 12 + 37 26 46 76 + 31 19 44 32 + 42 31 49 4951 + 43 30 44 38924 + 35 19 51 17 + 41 31 44 6637 + 33 22 42 2 + 33 25 46 12 + 31 24 44 10 + 27 16 49 4 + 39 24 45 16 + 33 20 40 8 + 39 31 48 5073 + 39 21 47 72 + 35 21 47 3 + 38 27 41 1168 + 35 22 43 8 + 28 18 45 1 + 38 28 40 776 + 33 22 51 3 + 34 22 41 370 + 37 25 43 3210 + 32 24 43 8 + 35 24 46 3 + 39 20 45 41 + 35 17 43 49 + 39 29 46 20 + 31 21 44 1 + 43 24 48 4400 + 36 23 48 350 + 38 29 47 520 + 36 24 45 49 + 39 27 43 493 + 34 15 45 6 + 41 31 43 59993 + 34 24 42 27 + 31 14 41 1 + 40 30 47 13295 + 35 23 47 202 + 36 22 47 35 + 38 26 45 18576 + 34 26 43 54 + 40 30 51 173 + 43 29 47 105 + 34 24 39 9 + 33 20 43 8 + 35 27 45 65 + 31 18 42 2 + 31 21 45 6 + 40 27 45 979 + 36 21 47 3 + 29 14 43 1 + 37 24 47 432 + 39 24 50 4778 + 33 20 44 2 + 40 27 44 7398 + 36 22 47 148 + 35 21 44 11 + 35 22 45 206 + 30 18 42 8 + 40 30 43 8 + 30 22 42 9 + 29 21 39 9 + 41 26 43 1248 + 39 24 43 14 + 38 24 49 605 + 35 20 42 155 + 33 22 47 53 + 34 20 43 10 + 35 26 49 21 + 31 18 45 1 + 32 19 39 9 + 31 20 43 19 + 41 23 41 157 + 36 23 42 9 + 28 19 45 1 + 33 19 43 10 + 38 22 44 25 + 29 19 41 2 + 34 19 42 8 + 35 21 39 9 + 34 23 45 2 + 41 30 47 71025 + 40 26 48 3059 + 36 24 45 1346 + 35 19 47 34 + 36 25 45 112 + 39 27 41 7065 + 38 24 47 4 + 29 18 42 1 + 30 20 41 2 + 32 22 49 3 + 40 29 45 4589 + 38 25 42 234 + 42 28 49 3171 + 35 22 45 34 + 39 24 41 5693 + 29 20 43 2 + 29 16 44 14 + 37 25 45 19 + 36 18 44 8 + 36 27 45 1224 + 38 28 47 8906 + 29 15 51 3 + 33 20 47 46 + 33 17 41 9 + 40 22 45 1775 + 32 22 45 8 + 35 21 43 8 + 38 24 41 9 + 41 22 47 10005 + 36 27 43 12 + 33 21 47 35 + 35 21 39 9 + 34 22 44 2 + 34 17 45 67 + 31 18 45 1 + 34 21 46 32 + 35 26 44 1 + 34 23 44 8 + 31 24 47 3 + 43 23 49 9210 + 40 20 48 114 + 36 25 42 8 + 37 24 46 336 + 37 23 43 138 + 38 26 47 89 + 38 24 47 6494 + 30 18 45 1 + 43 28 47 677 + 31 23 48 3 + 32 19 43 1 + 36 23 44 19 + 43 30 47 81276 + 37 22 48 106 + 37 24 45 12 + 37 22 45 68 + 28 17 43 24 + 43 28 45 1446 + 40 30 46 2753 + 35 23 44 1 + 28 16 43 2 + 29 19 42 2 + 31 21 42 2 + 39 26 48 98 + 41 30 47 21848 + 35 22 47 5 + 40 31 45 448 + 34 23 45 94 + 29 17 42 8 + 39 30 46 1231 + 41 22 47 49 + 30 15 51 7 + 35 26 41 9 + 29 17 49 7 + 33 22 43 12 + 33 19 46 5 + 35 24 45 12 + 33 22 42 9 + 34 18 43 13 + 36 21 43 63 + 37 27 45 32 + 37 23 49 474 + 31 17 46 19 + 38 24 41 2 + 40 28 47 1621 + 39 25 47 214 + 32 21 42 19 + 34 22 47 105 + 35 26 42 2 + 35 21 44 13 + 40 25 47 556 + 39 27 49 3 + 36 25 45 32 + 39 27 41 10 + 35 20 45 1 + 28 17 45 1 + 35 23 47 6 + 33 20 50 137 + 34 22 43 177 + 30 19 41 9 + 33 23 47 579 + 33 22 39 9 + 39 20 42 74 + 42 28 47 112 + 40 29 44 197 + 36 23 43 2 + 30 17 49 3 + 37 27 45 3815 + 35 24 43 74 + 35 22 47 24 + 40 27 46 82 + 36 25 41 366 + 33 23 44 1 + 37 21 40 131 + 34 22 45 16 + 36 24 45 306 + 39 26 47 82 + 29 17 45 1 + 36 23 48 3 + 35 20 44 63 + 35 23 46 5 + 39 25 43 792 + 32 22 49 5 + 35 23 41 9 + 37 24 41 12711 + 41 32 43 36575 + 34 23 42 8 + 31 21 43 2 + 35 24 41 2 + 35 24 39 8 + 37 23 48 75 + 35 19 43 12 + 40 25 49 914 + 38 22 49 60 + 34 19 42 10 + 42 33 44 9038 + 37 27 45 1849 + 29 20 42 138 + 37 27 43 332 + 36 26 45 36 + 32 18 45 6 + 37 25 46 4676 + 29 18 45 6 + 34 22 43 8 + 41 32 45 1966 + 30 18 42 12 + 33 20 45 1 + 31 23 45 6 + 30 21 46 1 + 36 21 43 14 + 34 18 45 37 + 42 32 47 3508 + 41 32 41 13 + 37 25 45 719 + 33 20 45 111 + 38 28 42 8 + 35 23 43 14 + 39 23 47 123 + 28 13 44 1 + 34 19 41 38 + 35 21 43 8 + 33 26 47 124 + 30 18 41 9 + 43 30 46 11935 + 40 28 48 2329 + 35 19 45 286 + 30 21 43 80 + 37 21 49 474 + 41 27 49 1560 + 42 24 46 1802 + 38 28 42 6807 + 38 24 43 63 + 33 24 49 35 + 41 27 41 9795 + 29 16 41 2 + 29 17 43 2 + 34 21 45 125 + 39 28 45 1008 + 34 21 42 8 + 36 23 45 2 + 34 22 41 8 + 34 21 41 74 + 37 21 43 262 + 30 18 41 8 + 33 22 49 3 + 33 21 42 1 + 35 28 49 21 + 31 19 43 1 + 36 24 44 10 + 40 23 49 583 + 33 19 37 9 + 32 21 45 6 + 38 24 47 15 + 42 27 47 2847 + 36 28 45 106 + 39 28 43 53 + 30 16 42 2 + 28 18 49 3 + 33 21 44 1 + 36 24 45 3050 + 37 27 40 8 + 35 19 43 12 + 41 29 43 19008 + 21 0 0 0 + 38 26 41 762 + 33 21 46 12 + 41 26 47 14517 + 33 24 49 3 + 41 31 47 287 + 35 24 51 17 + 37 27 42 38 + 34 22 43 24 + 39 26 46 135 + 38 26 41 493 + 35 22 42 8 + 38 24 41 1082 + 32 23 42 1 + 33 24 40 8 + 37 25 48 640 + 28 14 39 9 + 39 20 45 212 + 37 29 45 610 + 34 26 47 57 + 29 21 41 8 + 35 16 45 53 + 35 21 44 2 + 38 26 48 188 + 34 25 41 10 + 36 23 44 8 + 35 21 45 8 + 35 26 41 8 + 37 26 40 9 + 28 12 43 1 + 34 22 51 3 + 35 25 44 13 + 32 16 44 32 + 32 19 45 143 + 29 17 43 1 + 35 22 43 93 + 38 21 43 99 + 36 26 49 242 + 34 22 45 8 + 40 24 45 136 + 40 24 48 88 + 38 21 46 49 + 40 27 49 116 + 41 26 44 3696 + 35 23 42 8 + 28 15 45 104 + 33 21 43 106 + 35 25 45 31 + 33 24 40 113 + 36 24 46 23 + 37 25 45 334 + 32 21 46 12 + 35 21 41 2 + 36 22 45 8 + 37 18 43 13 + 37 26 47 48 + 39 25 46 400 + 37 27 43 174 + 37 23 47 41 + 40 21 47 1811 + 38 26 45 79 + 26 15 43 1 + 39 27 49 19 + 31 19 44 1 + 37 22 43 8 + 32 24 38 9 + 34 23 48 3 + 37 24 51 22 + 27 18 42 2 + 31 22 47 5 + 33 17 41 2 + 40 28 45 14534 + 37 21 47 5 + 27 15 43 2 + 43 26 47 46658 + 39 22 43 8 + 36 23 41 2 + 31 19 43 12 + 36 24 43 10 + 33 20 43 149 + 30 19 47 3 + 39 27 51 1236 + 41 26 45 4744 + 39 22 47 100 + 32 18 44 6 + 32 21 43 54 + 40 30 46 777 + 35 25 43 355 + 36 24 41 138 + 40 30 47 3056 + 39 28 46 19 + 34 21 46 6 + 34 18 46 52 + 36 27 41 232 + 35 25 51 3 + 36 28 44 110 + 33 23 45 1 + 37 22 46 64301 + 39 23 49 41 + 39 30 40 25 + 36 23 48 6 + 29 17 42 2 + 36 23 44 1 + 32 17 43 40 + 32 16 49 86 + 29 19 49 5 + 38 26 41 9 + 40 28 43 56710 + 41 29 45 1711 + 36 23 49 345 + 35 25 43 8 + 35 24 46 19 + 37 23 41 648 + 30 18 45 1 + 30 21 43 1 + 34 20 45 12 + 42 25 47 431 + 40 27 41 15878 + 34 22 43 8 + 41 29 48 49 + 32 21 43 2 + 37 22 43 2 + 39 28 49 86 + 43 28 45 8032 + 41 30 49 15674 + 34 22 48 17 + 36 24 48 107 + 28 20 44 1 + 43 28 48 1986 + 40 25 47 2585 + 38 21 43 59 + 38 28 41 167 + 34 22 39 9 + 43 27 48 4196 + 32 20 44 120 + 33 25 45 99 + 26 12 42 2 + 26 15 47 4 + 37 21 42 10 + 35 25 49 3 + 42 30 49 11151 + 33 20 44 2 + 39 26 45 65238 + 31 16 40 2 + 38 26 39 8 + 36 22 45 82 + 32 22 49 7 + 33 20 45 2 + 40 24 43 12 + 32 18 50 3 + 31 21 40 2 + 34 18 44 2 + 38 28 46 194 + 36 21 43 12 + 32 20 43 8 + 30 18 42 2 + 37 21 47 31 + 36 23 47 15 + 36 21 45 113 + 34 23 44 1 + 43 29 49 3889 + 37 24 47 32 + 41 22 43 243 + 38 25 47 707 + 35 22 43 18399 + 33 22 45 123 + 37 24 42 8 + 39 25 47 1087 + 34 23 47 107 + 32 21 42 2 + 42 25 47 106 + 39 24 42 13560 + 42 29 49 52387 + 38 27 43 59 + 31 18 39 9 + 40 28 48 41 + 37 25 45 11 + 30 23 45 242 + 38 23 47 1673 + 36 23 45 751 + 29 22 41 2 + 36 19 48 3 + 36 22 45 12 + 35 18 47 20 + 40 28 49 17369 + 29 19 46 2 + 36 26 42 25 + 42 30 49 4767 + 30 20 45 6 + 35 24 44 12 + 41 24 42 1537 + 38 25 47 629 + 31 21 44 2 + 34 22 43 1 + 33 20 47 3 + 34 20 43 8 + 40 26 49 4320 + 31 16 43 9 + 34 22 45 8 + 32 22 46 124 + 32 20 43 13 + 40 28 47 1185 + 41 24 45 30643 + 39 23 43 1658 + 33 23 44 8 + 36 22 46 23 + 41 25 47 114 + 36 21 42 12 + 33 19 48 31 + 42 28 48 76 + 29 22 39 9 + 36 21 47 3 + 37 27 45 282 + 42 29 46 24995 + 36 26 39 9 + 40 25 46 123 + 39 26 41 8 + 41 30 45 3143 + 34 20 41 27 + 38 31 42 17297 + 40 24 51 3052 + 36 28 45 190 + 31 23 42 8 + 42 26 42 68 + 39 31 45 37327 + 37 27 41 8 + 36 20 45 76 + 38 26 42 10 + 36 21 45 63 + 40 31 43 140 + 40 27 49 21 + 31 22 36 9 + 34 22 39 9 + 29 17 43 2 + 36 26 45 61 + 38 23 45 15 + 31 21 43 54 + 36 22 41 93 + 31 18 43 2 + 35 25 49 108 + 41 29 45 18292 + 37 25 45 104 + 28 20 41 2 + 35 26 46 35 + 34 20 46 19 + 38 22 51 183 + 34 14 43 8 + 32 23 43 16 + 27 17 44 1 + 29 15 42 2 + 37 26 41 129 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_0.0 b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_0.0 new file mode 100644 index 0000000..75c9778 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_0.0 @@ -0,0 +1,27 @@ + SNR Files Sync BM FT Hint Total False BadSync +-------------------------------------------------------- +-18.0 1000 1000 1000 1000 1000 1000 0 0 +-18.5 1000 1000 1000 1000 1000 1000 0 0 +-19.0 1000 1000 1000 1000 1000 1000 0 0 +-19.5 1000 1000 1000 1000 1000 1000 0 0 +-20.0 1000 1000 1000 1000 1000 1000 0 0 +-20.5 1000 1000 1000 1000 1000 1000 0 0 +-21.0 1000 1000 1000 1000 1000 1000 0 0 +-21.5 1000 1000 991 1000 1000 1000 0 0 +-22.0 1000 1000 918 1000 1000 1000 0 0 +-22.5 1000 1000 631 1000 1000 1000 0 0 +-23.0 1000 1000 261 1000 1000 1000 0 0 +-23.5 1000 1000 57 990 1000 1000 0 0 +-24.0 1000 1000 0 925 1000 1000 0 0 +-24.5 1000 1000 0 737 1000 1000 0 0 +-25.0 1000 999 0 445 999 999 1 ? +-25.5 1000 996 0 191 996 996 2 ? +-26.0 1000 980 0 68 985 985 3 ? +-26.5 1000 953 0 18 975 975 3 ? +-27.0 1000 904 0 3 926 926 4 ? +-27.5 1000 816 0 2 874 874 3 ? +-28.0 1000 722 0 0 786 786 7 ? +-28.5 1000 590 0 0 616 616 12 ? +-29.0 1000 451 0 0 479 479 15 ? +-29.5 1000 355 0 0 303 303 27 ? +-30.0 1000 277 0 0 173 173 28 ? diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_0.2 b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_0.2 new file mode 100644 index 0000000..1e0cb00 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_0.2 @@ -0,0 +1,27 @@ + SNR Files Sync BM FT Hint Total False BadSync +-------------------------------------------------------- +-18.0 1000 998 973 998 998 998 0 2 +-18.5 1000 1000 960 1000 1000 1000 0 0 +-19.0 1000 1000 917 1000 1000 1000 0 0 +-19.5 1000 1000 849 1000 1000 1000 0 0 +-20.0 1000 1000 725 1000 1000 1000 0 0 +-20.5 1000 1000 549 1000 1000 1000 0 0 +-21.0 1000 1000 373 1000 1000 1000 0 0 +-21.5 1000 1000 216 1000 1000 1000 0 0 +-22.0 1000 1000 100 998 1000 1000 0 0 +-22.5 1000 1000 32 998 1000 1000 0 0 +-23.0 1000 1000 12 991 1000 1000 0 0 +-23.5 1000 998 2 958 1000 1000 0 2 +-24.0 1000 992 0 878 998 998 1 8 +-24.5 1000 986 0 739 995 995 0 14 +-25.0 1000 977 0 533 991 991 0 23 +-25.5 1000 959 0 324 975 975 3 41 +-26.0 1000 930 0 153 953 953 1 70 +-26.5 1000 874 0 51 924 924 8 126 +-27.0 1000 808 0 14 866 866 6 192 +-27.5 1000 716 0 3 799 799 10 284 +-28.0 1000 610 0 1 689 689 14 390 +-28.5 1000 497 0 0 596 596 19 503 +-29.0 1000 399 0 0 451 451 21 601 +-29.5 1000 300 0 0 270 270 27 700 +-30.0 1000 243 0 0 172 172 26 757 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_1.0 b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_1.0 new file mode 100644 index 0000000..34f94c6 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/stats_1.0 @@ -0,0 +1,27 @@ + SNR Files Sync BM FT Hint Total False BadSync +-------------------------------------------------------- +-18.0 1000 998 917 998 998 998 1 2 +-18.5 1000 998 824 998 998 998 0 2 +-19.0 1000 999 695 999 999 999 0 1 +-19.5 1000 999 504 999 999 999 0 1 +-20.0 1000 1000 300 1000 1000 1000 0 0 +-20.5 1000 1000 148 1000 1000 1000 0 0 +-21.0 1000 1000 56 1000 1000 1000 0 0 +-21.5 1000 1000 10 1000 1000 1000 0 0 +-22.0 1000 999 3 995 1000 1000 0 1 +-22.5 1000 998 0 972 1000 1000 0 2 +-23.0 1000 997 0 899 999 999 0 3 +-23.5 1000 996 0 758 999 999 0 4 +-24.0 1000 990 0 545 999 999 0 10 +-24.5 1000 981 0 305 988 988 2 19 +-25.0 1000 964 0 128 987 987 0 36 +-25.5 1000 930 0 43 956 956 4 70 +-26.0 1000 870 0 15 932 932 4 130 +-26.5 1000 810 0 4 889 889 8 190 +-27.0 1000 737 0 0 798 798 9 263 +-27.5 1000 632 0 0 650 650 10 368 +-28.0 1000 522 0 0 526 526 15 478 +-28.5 1000 426 0 0 383 383 19 574 +-29.0 1000 332 0 0 226 226 34 668 +-29.5 1000 260 0 0 136 136 32 740 +-30.0 1000 209 0 0 64 64 47 791 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/wer.lab b/wsjtx_lib/lib/ftrsd/ftrsd_paper/wer.lab new file mode 100644 index 0000000..e69de29 diff --git a/wsjtx_lib/lib/ftrsd/ftrsd_paper/wer2.lab b/wsjtx_lib/lib/ftrsd/ftrsd_paper/wer2.lab new file mode 100644 index 0000000..b3440f8 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsd_paper/wer2.lab @@ -0,0 +1,7 @@ +-25.7 30 $10^5$ +-25.25 36 $10^4$ +-24.5 44 $10^3$ +-24.15 48 $10^2$ +-23.7 44 10 +-22.5 48 BM +-25.2 24 KV \ No newline at end of file diff --git a/wsjtx_lib/lib/ftrsd/ftrsdap.c b/wsjtx_lib/lib/ftrsd/ftrsdap.c new file mode 100644 index 0000000..b2b85dd --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/ftrsdap.c @@ -0,0 +1,227 @@ +/* + ftrsdap.c + + A soft-decision decoder for the JT65 (63,12) Reed-Solomon code. + + This decoding scheme is built around Phil Karn's Berlekamp-Massey + errors and erasures decoder. The approach is inspired by a number of + publications, including the stochastic Chase decoder described + in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al., + IEEE Communications Letters, Vol. 14, No. 9, September 2010 and + "Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error- + and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar. + + Steve Franke K9AN and Joe Taylor K1JT + */ + +#include +#include +#include +#include +#include +#include "../ftrsd/rs2.h" + +static void *rs; +void getpp_(int workdat[], float *pp); + +void ftrsdap_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[], + int ap[], int* ntrials0, int correct[], int param[], int ntry[]) +{ + int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63]; + int workdat[63]; + int indexes[63]; + int era_pos[51]; + int i, j, numera, nerr, nn=63; + int ntrials = *ntrials0; + int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768; + int ntotal=0,ntotal_min=32768,ncandidates; + int nera_best=0; + float pp,pp1,pp2; + static unsigned int nseed; + +// Power-percentage symbol metrics - composite gnnf/hf + int perr[8][8] = { + { 4, 9, 11, 13, 14, 14, 15, 15}, + { 2, 20, 20, 30, 40, 50, 50, 50}, + { 7, 24, 27, 40, 50, 50, 50, 50}, + {13, 25, 35, 46, 52, 70, 50, 50}, + {17, 30, 42, 54, 55, 64, 71, 70}, + {25, 39, 48, 57, 64, 66, 77, 77}, + {32, 45, 54, 63, 66, 75, 78, 83}, + {51, 58, 57, 66, 72, 77, 82, 86}}; + + +// Initialize the KA9Q Reed-Solomon encoder/decoder + unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51; + rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0); + +// Reverse the received symbol vectors for BM decoder + for (i=0; i<63; i++) { + rxdat[i]=mrsym[62-i]; + rxprob[i]=mrprob[62-i]; + rxdat2[i]=mr2sym[62-i]; + rxprob2[i]=mr2prob[62-i]; + } + +// Set ap symbols and ap mask + for (i=0; i<12; i++) { + if(ap[i]>=0) { + rxdat[11-i]=ap[i]; + rxprob2[11-i]=-1; + } + } + +// Sort rxprob to find indexes of the least reliable symbols + int k, pass, tmp, nsym=63; + int probs[63]; + for (i=0; i<63; i++) { + indexes[i]=i; + probs[i]=rxprob[i]; + } + for (pass = 1; pass <= nsym-1; pass++) { + for (k = 0; k < nsym - pass; k++) { + if( probs[k] < probs[k+1] ) { + tmp = probs[k]; + probs[k] = probs[k+1]; + probs[k+1] = tmp; + tmp = indexes[k]; + indexes[k] = indexes[k+1]; + indexes[k+1] = tmp; + } + } + } + +// See if we can decode using BM HDD, and calculate the syndrome vector. + memset(era_pos,0,51*sizeof(int)); + numera=0; + memcpy(workdat,rxdat,sizeof(rxdat)); + nerr=decode_rs_int(rs,workdat,era_pos,numera,1); + if( nerr >= 0 ) { + // Hard-decision decoding succeeded. Save codeword and some parameters. + nhard=0; + for (i=0; i<63; i++) { + if( workdat[i] != rxdat[i] ) nhard=nhard+1; + } + memcpy(correct,workdat,63*sizeof(int)); + param[0]=0; + param[1]=nhard; + param[2]=0; + param[3]=0; + param[4]=0; + param[5]=0; + param[7]=1000*1000; + ntry[0]=0; + return; + } + +/* +Hard-decision decoding failed. Try the FT soft-decision method. +Generate random erasure-locator vectors and see if any of them +decode. This will generate a list of "candidate" codewords. The +soft distance between each candidate codeword and the received +word is estimated by finding the largest (pp1) and second-largest +(pp2) outputs from a synchronized filter-bank operating on the +symbol spectra, and using these to decide which candidate +codeword is "best". +*/ + + nseed=1; //Seed for random numbers + float ratio; + int thresh, nsum; + int thresh0[63]; + ncandidates=0; + nsum=0; + int ii,jj; + for (i=0; i=0 ) { + ratio = (float)rxprob2[j]/((float)rxprob[j]+0.01); + ii = 7.999*ratio; + jj = (62-i)/8; + thresh0[i] = 1.3*perr[ii][jj]; + } else { + thresh0[i] = 0.0; + } +//printf("%d %d %d\n",i,j,rxdat[i]); + } + + if(nsum<=0) return; + + pp1=0.0; + pp2=0.0; + for (k=1; k<=ntrials; k++) { + memset(era_pos,0,51*sizeof(int)); + memcpy(workdat,rxdat,sizeof(rxdat)); + +/* +Mark a subset of the symbols as erasures. +Run through the ranked symbols, starting with the worst, i=0. +NB: j is the symbol-vector index of the symbol with rank i. +*/ + numera=0; + for (i=0; i= 0 ) { + // We have a candidate codeword. Find its hard and soft distance from + // the received word. Also find pp1 and pp2 from the full array + // s3(64,63) of synchronized symbol spectra. + ncandidates=ncandidates+1; + nhard=0; + nsoft=0; + for (i=0; i<63; i++) { + if(workdat[i] != rxdat[i]) { + nhard=nhard+1; + if(workdat[i] != rxdat2[i]) { + nsoft=nsoft+rxprob[i]; + } + } + } + nsoft=63*nsoft/nsum; + ntotal=nsoft+nhard; + + getpp_(workdat,&pp); + if(pp>pp1) { + pp2=pp1; + pp1=pp; + nsoft_min=nsoft; + nhard_min=nhard; + ntotal_min=ntotal; + memcpy(correct,workdat,63*sizeof(int)); + nera_best=numera; + ntry[0]=k; + } else { + if(pp>pp2 && pp!=pp1) pp2=pp; + } + if(nhard_min <= 41 && ntotal_min <= 71) break; + } + if(k == ntrials) ntry[0]=k; + } + + param[0]=ncandidates; + param[1]=nhard_min; + param[2]=nsoft_min; + param[3]=nera_best; + param[4]=1000.0*pp2/pp1; + param[5]=ntotal_min; + param[6]=ntry[0]; + param[7]=1000.0*pp2; + param[8]=1000.0*pp1; + if(param[0]==0) param[2]=-1; + return; +} diff --git a/wsjtx_lib/lib/ftrsd/init_rs.c b/wsjtx_lib/lib/ftrsd/init_rs.c new file mode 100644 index 0000000..4b1d1ed --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/init_rs.c @@ -0,0 +1,119 @@ +/* Initialize a RS codec + * + * Copyright 2002 Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ +#include + +#ifdef CCSDS +#include "ccsds.h" +#elif defined(BIGSYM) +#include "int.h" +#else +#include "char.h" +#endif + +void FREE_RS(void *p){ + struct rs *rs = (struct rs *)p; + + free(rs->alpha_to); + free(rs->index_of); + free(rs->genpoly); + free(rs); +} + +/* Initialize a Reed-Solomon codec + * symsize = symbol size, bits (1-8) + * gfpoly = Field generator polynomial coefficients + * fcr = first root of RS code generator polynomial, index form + * prim = primitive element to generate polynomial roots + * nroots = RS code generator polynomial degree (number of roots) + */ +void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned fcr,unsigned prim, + unsigned int nroots){ + struct rs *rs; + int i, j, sr,root,iprim; + + if(symsize > 8*sizeof(DTYPE)) + return NULL; /* Need version with ints rather than chars */ + + if(fcr >= (1<= (1<= (1<mm = symsize; + rs->nn = (1<alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1)); + if(rs->alpha_to == NULL){ + free(rs); + return NULL; + } + rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1)); + if(rs->index_of == NULL){ + free(rs->alpha_to); + free(rs); + return NULL; + } + + /* Generate Galois field lookup tables */ + rs->index_of[0] = A0; /* log(zero) = -inf */ + rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */ + sr = 1; + for(i=0;inn;i++){ + rs->index_of[sr] = i; + rs->alpha_to[i] = sr; + sr <<= 1; + if(sr & (1<nn; + } + if(sr != 1){ + /* field generator polynomial is not primitive! */ + free(rs->alpha_to); + free(rs->index_of); + free(rs); + return NULL; + } + + /* Form RS code generator polynomial from its roots */ + rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1)); + if(rs->genpoly == NULL){ + free(rs->alpha_to); + free(rs->index_of); + free(rs); + return NULL; + } + rs->fcr = fcr; + rs->prim = prim; + rs->nroots = nroots; + + /* Find prim-th root of 1, used in decoding */ + for(iprim=1;(iprim % prim) != 0;iprim += rs->nn) + ; + rs->iprim = iprim / prim; + + rs->genpoly[0] = 1; + for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) { + rs->genpoly[i+1] = 1; + + /* Multiply rs->genpoly[] by @**(root + x) */ + for (j = i; j > 0; j--){ + if (rs->genpoly[j] != 0) + rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)]; + else + rs->genpoly[j] = rs->genpoly[j-1]; + } + /* rs->genpoly[0] can never be zero */ + rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)]; + } + /* convert rs->genpoly[] to index form for quicker encoding */ + for (i = 0; i <= nroots; i++) + rs->genpoly[i] = rs->index_of[rs->genpoly[i]]; + + return rs; +} diff --git a/wsjtx_lib/lib/ftrsd/int.h b/wsjtx_lib/lib/ftrsd/int.h new file mode 100644 index 0000000..ada5bfd --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/int.h @@ -0,0 +1,54 @@ +/* Include file to configure the RS codec for integer symbols + * + * Copyright 2002, Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ +#define DTYPE int + +/* Reed-Solomon codec control block */ +struct rs { + unsigned int mm; /* Bits per symbol */ + unsigned int nn; /* Symbols per block (= (1<= rs->nn) { + x -= rs->nn; + x = (x >> rs->mm) + (x & rs->nn); + } + return x; +} +#define MODNN(x) modnn(rs,x) + +#define MM (rs->mm) +#define NN (rs->nn) +#define ALPHA_TO (rs->alpha_to) +#define INDEX_OF (rs->index_of) +#define GENPOLY (rs->genpoly) +#define NROOTS (rs->nroots) +#define FCR (rs->fcr) +#define PRIM (rs->prim) +#define IPRIM (rs->iprim) +#define A0 (NN) + +#define ENCODE_RS encode_rs_int +#define DECODE_RS decode_rs_int +#define INIT_RS init_rs_int +#define FREE_RS free_rs_int + +void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity); +int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras, int calc_syn); +void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned int fcr, + unsigned int prim,unsigned int nroots); +void FREE_RS(void *p); + + + + diff --git a/wsjtx_lib/lib/ftrsd/rs2.h b/wsjtx_lib/lib/ftrsd/rs2.h new file mode 100644 index 0000000..c2b807d --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/rs2.h @@ -0,0 +1,16 @@ +/* User include file for the Reed-Solomon codec + * Copyright 2002, Phil Karn KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ + +/* General purpose RS codec, integer symbols */ +void encode_rs_int(void *rs,int *data,int *parity); +int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras, int calc_syn); +void *init_rs_int(int symsize,int gfpoly,int fcr, + int prim,int nroots,int pad); +void free_rs_int(void *rs); + +/* Tables to map from conventional->dual (Taltab) and + * dual->conventional (Tal1tab) bases + */ +extern unsigned char Taltab[],Tal1tab[]; diff --git a/wsjtx_lib/lib/ftrsd/rsdtest.f90 b/wsjtx_lib/lib/ftrsd/rsdtest.f90 new file mode 100644 index 0000000..2c862e5 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/rsdtest.f90 @@ -0,0 +1,34 @@ +program rsdtest + + real s3(64,63) + character msg*22,arg*12 + integer param(0:7) + + nargs=iargc() + if(nargs.ne.2) then + print*,'Usage: rsdtest ntrials nfiles' + go to 999 + endif + call getarg(1,arg) + read(arg,*) ntrials + call getarg(2,arg) + read(arg,*) nfiles + + open(10,file='s3_1000.bin',access='stream', status='old') + open(22,file='kvasd.dat',access='direct',recl=1024,status='unknown') + + nadd=1 + ifile0=0 + if(nfiles.lt.0) then + ifile0=-nfiles + nfiles=99999 + endif + + do ifile=1,nfiles + read(10,end=999) s3 + if(ifile.lt.ifile0) cycle + call extract2(s3,nadd,ntrials,param,msg) + if(ifile.eq.ifile0) exit + enddo + +999 end program rsdtest diff --git a/wsjtx_lib/lib/ftrsd/sfrsd.c b/wsjtx_lib/lib/ftrsd/sfrsd.c new file mode 100644 index 0000000..e64dfc9 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/sfrsd.c @@ -0,0 +1,137 @@ +/* + sfrsd.c + + A soft-decision decoder for the JT65 (63,12) Reed-Solomon code. + + This decoding scheme is built around Phil Karn's Berlekamp-Massey + errors and erasures decoder. The approach is inspired by a number of + publications, including the stochastic Chase decoder described + in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al., + IEEE Communications Letters, Vol. 14, No. 9, September 2010 and + "Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error- + and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar. + + Steve Franke K9AN, Urbana IL, September 2015 + */ + +#include +#include +#include +#include +#include +#include "sfrsd2.h" + +//*************************************************************************** +void usage(void) +{ + printf("Usage: sfrsd [options...] \n"); + printf(" input file should be in kvasd format\n"); + printf("\n"); + printf("Options:\n"); + printf(" -n number of random erasure vectors to try\n"); + printf(" -v verbose\n"); +} + +int main(int argc, char *argv[]){ + + extern char *optarg; + extern int optind; + + int correct[63], indx[63], param[8]; + int c,i; + char *infile; + + FILE *datfile, *logfile; + int nsec, maxe, nads; + float xlambda; + int mrsym[63],mrprob[63],mr2sym[63],mr2prob[63]; + int nsec2,ncount,dat4[12]; + int ntrials, nverbose, ntry; + int nhard; + double tt; + + ntrials=10000; + nverbose=1; + + while ( (c = getopt(argc, argv, "n:qv")) !=-1 ) { + switch (c) { + case 'n': + ntrials=(int)strtof(optarg,NULL); + printf("ntrials set to %d\n",ntrials); + break; + case 'v': + nverbose=1; + break; + case 'q': //accept (and ignore) -q option for WSJT10 compatibility + break; + case '?': + usage(); + exit(1); + } + } + + if( optind+1 > argc) { + // usage(); + // exit(1); + infile="kvasd.dat"; + } else { + infile=argv[optind]; + } + + logfile=fopen("/tmp/sfrsd.log","a"); + if( !logfile ) { + printf("Unable to open sfrsd.log\n"); + exit(1); + } + + datfile=fopen(infile,"rb"); + if( !datfile ) { + printf("Unable to open kvasd.dat\n"); + exit(1); + } else { + fread(&nsec,sizeof(int),1,datfile); + fread(&xlambda,sizeof(float),1,datfile); + fread(&maxe,sizeof(int),1,datfile); + fread(&nads,sizeof(int),1,datfile); + fread(&mrsym,sizeof(int),63,datfile); + fread(&mrprob,sizeof(int),63,datfile); + fread(&mr2sym,sizeof(int),63,datfile); + fread(&mr2prob,sizeof(int),63,datfile); + fread(&nsec2,sizeof(int),1,datfile); + fread(&ncount,sizeof(int),1,datfile); + fread(&dat4,sizeof(int),12,datfile); + fclose(datfile); + } + + sfrsd2_(mrsym,mrprob,mr2sym,mr2prob,&ntrials,&nverbose,correct,param,indx,&tt,&ntry); + nhard=param[1]; + if( nhard>=0 ) { + for (i=0; i<12; i++) { + dat4[i]=correct[11-i]; + } + } else { + nhard=-1; + memset(dat4,0,12*sizeof(int)); + } + datfile=fopen(infile,"wb"); + if( !datfile ) { + printf("Unable to open kvasd.dat\n"); + return 1; + } else { + fwrite(&nsec,sizeof(int),1,datfile); + fwrite(&xlambda,sizeof(float),1,datfile); + fwrite(&maxe,sizeof(int),1,datfile); + fwrite(&nads,sizeof(int),1,datfile); + fwrite(&mrsym,sizeof(int),63,datfile); + fwrite(&mrprob,sizeof(int),63,datfile); + fwrite(&mr2sym,sizeof(int),63,datfile); + fwrite(&mr2prob,sizeof(int),63,datfile); + fwrite(&nsec2,sizeof(int),1,datfile); + fwrite(&nhard,sizeof(int),1,datfile); + fwrite(&dat4,sizeof(int),12,datfile); + fclose(datfile); + } + exit(0); +} + + diff --git a/wsjtx_lib/lib/ftrsd/sfrsd2.h b/wsjtx_lib/lib/ftrsd/sfrsd2.h new file mode 100644 index 0000000..4ef7ab4 --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/sfrsd2.h @@ -0,0 +1,3 @@ +void ftrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[], + int* ntrials0, int* verbose0, int correct[], int param[], + int indexes[], double tt[], int ntry[]); diff --git a/wsjtx_lib/lib/ftrsd/sfrsd3.c b/wsjtx_lib/lib/ftrsd/sfrsd3.c new file mode 100644 index 0000000..f117dcc --- /dev/null +++ b/wsjtx_lib/lib/ftrsd/sfrsd3.c @@ -0,0 +1,243 @@ +/* + sfrsd2.c + + A soft-decision decoder for the JT65 (63,12) Reed-Solomon code. + + This decoding scheme is built around Phil Karn's Berlekamp-Massey + errors and erasures decoder. The approach is inspired by a number of + publications, including the stochastic Chase decoder described + in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al., + IEEE Communications Letters, Vol. 14, No. 9, September 2010 and + "Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error- + and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar. + + Steve Franke K9AN and Joe Taylor K1JT + */ + +#include +#include +#include +#include +#include +#include "rs2.h" + +static void *rs; + +void sfrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[], + int* ntrials0, int* verbose0, int correct[], int param[], + int indexes[], double tt[], int ntry[]) +{ + int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63]; + int workdat[63],workdat2[63]; + int era_pos[51]; + int c, i, j, numera, nmr2, nerr, nn=63, kk=12; + FILE *datfile, *logfile; + int ntrials = *ntrials0; + int verbose = *verbose0; + int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768, ncandidates; + int ngmd,nera_best; + clock_t t0=0,t1=0; + int perr[8][8] = { + 12, 31, 44, 52, 60, 57, 50, 50, + 28, 38, 49, 58, 65, 69, 64, 80, + 40, 41, 53, 62, 66, 73, 76, 81, + 50, 53, 53, 64, 70, 76, 77, 81, + 50, 50, 52, 60, 71, 72, 77, 84, + 50, 50, 56, 62, 67, 73, 81, 85, + 50, 50, 71, 62, 70, 77, 80, 85, + 50, 50, 62, 64, 71, 75, 82, 87}; + + int pmr2[8][8] = { + 4, 8, 9, 7, 6, 0, 0, 0, + 13, 18, 15, 11, 9, 7, 5, 0, + 0, 23, 21, 15, 12, 10, 7, 4, + 0, 34, 28, 20, 16, 14, 11, 7, + 0, 20, 26, 25, 19, 14, 12, 9, + 0, 0, 28, 27, 22, 19, 14, 11, + 0, 0, 40, 29, 29, 23, 18, 12, + 0, 0, 40, 35, 31, 21, 20, 13}; + + if(verbose) { + logfile=fopen("sfrsd.log","a"); + if( !logfile ) { + printf("Unable to open sfrsd.log\n"); + exit(1); + } + } + +// Initialize the KA9Q Reed-Solomon encoder/decoder + unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51; + rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0); + +// Reverse the received symbol vector for BM decoder + for (i=0; i<63; i++) { + rxdat[i]=mrsym[62-i]; + rxprob[i]=mrprob[62-i]; + rxdat2[i]=mr2sym[62-i]; + rxprob2[i]=mr2prob[62-i]; + } + +// Sort the mrsym probabilities to find the least reliable symbols + int k, pass, tmp, nsym=63; + int probs[63]; + for (i=0; i<63; i++) { + indexes[i]=i; + probs[i]=rxprob[i]; + } + for (pass = 1; pass <= nsym-1; pass++) { + for (k = 0; k < nsym - pass; k++) { + if( probs[k] < probs[k+1] ) { + tmp = probs[k]; + probs[k] = probs[k+1]; + probs[k+1] = tmp; + tmp = indexes[k]; + indexes[k] = indexes[k+1]; + indexes[k+1] = tmp; + } + } + } + +// See if we can decode using BM HDD, and calculate the syndrome vector. + memset(era_pos,0,51*sizeof(int)); + numera=0; + memcpy(workdat,rxdat,sizeof(rxdat)); + nerr=decode_rs_int(rs,workdat,era_pos,numera,1); + if( nerr >= 0 ) { + if(verbose) fprintf(logfile," BM decode nerrors= %3d : ",nerr); + memcpy(correct,workdat,63*sizeof(int)); + ngmd=-1; + param[0]=0; + param[1]=0; + param[2]=0; + param[3]=0; + param[4]=0; + return; + } + +/* +Generate random erasure-locator vectors and see if any of them +decode. This will generate a list of potential codewords. The +"soft" distance between each codeword and the received word is +used to decide which codeword is "best". +*/ + +#ifdef WIN32 + srand(0xdeadbeef); +#else + srandom(0xdeadbeef); +#endif + + float ratio, ratio0[63]; + int threshe, thresh2, nsum; + int thresh0[63],thresh1[63], mr2flag; + ncandidates=0; + nsum=0; + int ii,jj; + for (i=0; i= 0 ) { + ncandidates=ncandidates+1; + nhard=0; + nsoft=0; + for (i=0; i<63; i++) { + if(workdat[i] != rxdat[i]) { + nhard=nhard+1; + if(workdat[i] != rxdat2[i]) { + nsoft=nsoft+rxprob[i]; + } + } + } + nsoft=63*nsoft/nsum; + if((nsoft < 33) && (nhard < 43) && (nhard+nsoft) < 74) { //??? + if( (nsoft < nsoft_min) ) { + nsoft_min=nsoft; + nhard_min=nhard; + memcpy(correct,workdat,63*sizeof(int)); + ngmd=0; + nera_best=numera; + ntry[0]=k; + } + } + if(nsoft_min < 27) break; + if((nsoft_min < 32) && (nhard_min < 43) && + (nhard_min+nsoft_min) < 74) break; + } + if(k == ntrials-1) ntry[0]=k+1; + } + + if(verbose) fprintf(logfile, + "%d trials and %d candidates after stochastic loop\n",k,ncandidates); + + if( (ncandidates >= 0) && (nsoft_min < 36) && (nhard_min < 44) ) { + if(verbose) { + for (i=0; i<63; i++) { + fprintf(logfile,"%3d %3d %3d %3d %3d %3d\n",i,correct[i], + rxdat[i],rxprob[i],rxdat2[i],rxprob2[i]); + } + fprintf(logfile,"**** ncandidates %d nhard %d nsoft %d nsum %d\n", + ncandidates,nhard_min,nsoft_min,nsum); + } + } else { + nhard_min=-1; + } + + if(verbose) { + fprintf(logfile,"exiting sfrsd\n"); + fclose(logfile); + } + param[0]=ncandidates; + param[1]=nhard_min; + param[2]=nsoft_min; + param[3]=nera_best; + param[4]=ngmd; + if(param[0]==0) param[2]=-1; + return; +} diff --git a/wsjtx_lib/lib/g1 b/wsjtx_lib/lib/g1 new file mode 100644 index 0000000..52f7616 --- /dev/null +++ b/wsjtx_lib/lib/g1 @@ -0,0 +1,4 @@ +gcc -c gran.c +gfortran -c four2a.f90 +gfortran -c f77_wisdom.f90 +gfortran -o chkfft chkfft.f90 four2a.o f77_wisdom.o gran.o -lfftw3f diff --git a/wsjtx_lib/lib/g1.bat b/wsjtx_lib/lib/g1.bat new file mode 100644 index 0000000..6242f25 --- /dev/null +++ b/wsjtx_lib/lib/g1.bat @@ -0,0 +1,4 @@ +gcc -c gran.c +gfortran -c four2a.f90 +gfortran -c f77_wisdom.f90 +gfortran -o chkfft chkfft.f90 four2a.o f77_wisdom.o gran.o /JTSDK-QT/appsupport/runtime/libfftw3f-3.dll diff --git a/wsjtx_lib/lib/g2.bat b/wsjtx_lib/lib/g2.bat new file mode 100644 index 0000000..4067107 --- /dev/null +++ b/wsjtx_lib/lib/g2.bat @@ -0,0 +1,4 @@ +gcc -c gran.c +gfortran -c fftw3mod.f90 +gfortran -c f77_wisdom.f90 +gfortran -o chkfft2 chkfft2.f90 f77_wisdom.o gran.o /JTSDK-QT/appsupport/runtime/libfftw3f-3.dll diff --git a/wsjtx_lib/lib/g3.bat b/wsjtx_lib/lib/g3.bat new file mode 100644 index 0000000..904fce9 --- /dev/null +++ b/wsjtx_lib/lib/g3.bat @@ -0,0 +1,4 @@ +gcc -c gran.c +gfortran -c fftw3mod.f90 +gfortran -c f77_wisdom.f90 +gfortran -o chkfft3 chkfft3.f90 f77_wisdom.o gran.o /JTSDK-QT/appsupport/runtime/libfftw3f-3.dll diff --git a/wsjtx_lib/lib/g4.bat b/wsjtx_lib/lib/g4.bat new file mode 100644 index 0000000..6475dad --- /dev/null +++ b/wsjtx_lib/lib/g4.bat @@ -0,0 +1,3 @@ +gcc -c gran.c +gfortran -c -Wall fftw3mod.f90 +gfortran -o timefft -Wall timefft.f90 timefft_opts.f90 gran.o libfftw3f-3.dll diff --git a/wsjtx_lib/lib/gen4.f90 b/wsjtx_lib/lib/gen4.f90 new file mode 100644 index 0000000..b94789d --- /dev/null +++ b/wsjtx_lib/lib/gen4.f90 @@ -0,0 +1,43 @@ +subroutine gen4(msg0,ichk,msgsent,itone,itype) + +! Encode a JT4 message. Returns msgsent, the message as it will be +! decoded, an integer array itone(206) of 4-FSK tons values in the +! range 0-3; and itype, the JT message type. + + use jt4 + use packjt + character*22 msg0 + character*22 message !Message to be generated + character*22 msgsent !Message as it will be received + character*1 c + integer itone(206) + integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words + integer mettab(-128:127,0:1) + save + + if(msg0(1:1).eq.'@') then + read(msg0(2:5),*,end=1,err=1) nfreq + go to 2 +1 nfreq=1000 +2 itone(1)=nfreq + msgsent=msg0 + else + call getmet4(mettab,ndelta) + + message=msg0 + call fmtmsg(message,iz) + call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes + call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent + if(ichk.ne.0) go to 999 + call encode4(message,itone) !Encode the information bits + i1=index(message,'-') + c=message(i1+1:i1+1) + if(i1.ge.9 .and. c.ge.'0' .and. c.le.'3') then + itone=2*itone + (1-npr(2:)) !Inverted '#' sync + else + itone=2*itone + npr(2:) !Data = MSB, sync = LSB + endif + endif + +999 return +end subroutine gen4 diff --git a/wsjtx_lib/lib/gen65.f90 b/wsjtx_lib/lib/gen65.f90 new file mode 100644 index 0000000..f82aac8 --- /dev/null +++ b/wsjtx_lib/lib/gen65.f90 @@ -0,0 +1,93 @@ +subroutine gen65(msg00,ichk,msgsent0,itone,itype) BIND(c) + +! Encodes a JT65 message to yieild itone(1:126) +! Temporarily, does not implement EME shorthands + + use packjt + character*1 msg00(23),msgsent0(23) + character*22 msg0 + character*22 message !Message to be generated + character*22 msgsent !Message as it will be received + integer itone(126) + character*3 cok !' ' or 'OOO' + integer dgen(13) + integer sent(63) + integer nprc(126) + data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & + 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & + 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & + 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & + 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & + 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & + 1,1,1,1,1,1/ + save + + do i=1,22 + msg0(i:i)=msg00(i) + enddo + + if(msg0(1:1).eq.'@') then + read(msg0(2:5),*,end=1,err=1) nfreq + go to 2 +1 nfreq=1000 +2 itone(1)=nfreq + else + message=msg0 + do i=1,22 + if(ichar(message(i:i)).eq.0) then + message(i:)=' ' + exit + endif + enddo + + do i=1,22 !Strip leading blanks + if(message(1:1).ne.' ') exit + message=message(i+1:) + enddo + + call chkmsg(message,cok,nspecial,flip) + ntest=0 + if(flip.lt.0.0) ntest=1 + if(nspecial.eq.0) then + call packmsg(message,dgen,itype) !Pack message into 72 bits + call unpackmsg(dgen,msgsent) !Unpack to get message sent + msgsent(20:22)=cok + call fmtmsg(msgsent,iz) + if(ichk.ne.0) go to 900 !Return if checking only + + call rs_encode(dgen,sent) !Apply Reed-Solomon code + call interleave63(sent,1) !Apply interleaving + call graycode65(sent,63,1) !Apply Gray code + nsym=126 !Symbols per transmission + k=0 + do j=1,nsym + if(nprc(j).eq.ntest) then + k=k+1 + itone(j)=sent(k)+2 + else + itone(j)=0 + endif + enddo + else + nsym=32 + k=0 + do j=1,nsym + do n=1,4 + k=k+1 + if(iand(j,1).eq.1) itone(k)=0 + if(iand(j,1).eq.0) itone(k)=10*nspecial + if(k.eq.126) go to 10 + enddo + enddo +10 msgsent=message + itype=7 + endif + endif + +900 do i=1,22 + msgsent0(i)=msgsent(i:i) + enddo + msgsent0(23)=char(0) + + return +end subroutine gen65 diff --git a/wsjtx_lib/lib/gen9.f90 b/wsjtx_lib/lib/gen9.f90 new file mode 100644 index 0000000..986c1b5 --- /dev/null +++ b/wsjtx_lib/lib/gen9.f90 @@ -0,0 +1,65 @@ +subroutine gen9(msg0,ichk,msgsent,i4tone,itype) + +! Encodes a JT9 message and returns msgsent, the message as it will +! be decoded, and an integer array i4tone(85) of 9-FSK tone values +! in the range 0-8. + + use packjt + character*22 msg0 + character*22 message !Message to be generated + character*22 msgsent !Message as it will be received + integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words + integer*1 i1Msg8BitBytes(13) !72 bits and zero tail as 8-bit bytes + integer*1 i1EncodedBits(207) !Encoded information-carrying bits + integer*1 i1ScrambledBits(207) !Encoded bits after interleaving + integer*4 i4DataSymbols(69) !Data symbols (values 0-7) + integer*4 i4GrayCodedSymbols(69) !Gray-coded symbols (values 0-7) + integer*4 i4tone(85) !Tone #s, data and sync (values 0-8) + include 'jt9sync.f90' + save + + if(msg0(1:1).eq.'@') then + read(msg0(2:5),*,end=1,err=1) nfreq + go to 2 +1 nfreq=1000 +2 i4tone(1)=nfreq + else + message=msg0 + do i=1,22 + if(ichar(message(i:i)).eq.0) then + message(i:)=' ' + exit + endif + enddo + + do i=1,22 !Strip leading blanks + if(message(1:1).ne.' ') exit + message=message(i+1:) + enddo + + call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes + call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent + if(ichk.ne.0) go to 999 + call entail(i4Msg6BitWords,i1Msg8BitBytes) !Add tail, make 8-bit bytes + nsym2=206 + call encode232(i1Msg8BitBytes,nsym2,i1EncodedBits) !Encode K=32, r=1/2 + i1EncodedBits(207)=0 + call interleave9(i1EncodedBits,1,i1ScrambledBits) !Interleave bits + i1ScrambledBits(207)=0 + call packbits(i1ScrambledBits,69,3,i4DataSymbols) !Pk 3-bits into words + call graycode(i4DataSymbols,69,1,i4GrayCodedSymbols) !Apply Gray code + +! Insert sync symbols at ntone=0 and add 1 to the data-tone numbers. + j=0 + do i=1,85 + if(isync(i).eq.1) then + i4tone(i)=0 + else + j=j+1 + i4tone(i)=i4GrayCodedSymbols(j)+1 + endif + enddo + endif + +999 return +end subroutine gen9 diff --git a/wsjtx_lib/lib/genmet.f90 b/wsjtx_lib/lib/genmet.f90 new file mode 100644 index 0000000..81f2e56 --- /dev/null +++ b/wsjtx_lib/lib/genmet.f90 @@ -0,0 +1,90 @@ +program genmet + +! Generate metric table for M-FSK modulation. + + character*12 arg + real*4 r(0:255) + integer hist(2,-128:128) + data hist/514*0/,idum/-1/ + + lim(x)=min(127,max(-128,nint(scale*x))) + + nargs=iargc() + if(nargs.ne.5) then + print*,'Usage: genmet ncoh nadd m0 snr iters' + go to 999 + endif + call getarg(1,arg) + read(arg,*) ncoh + call getarg(2,arg) + read(arg,*) nadd + call getarg(3,arg) + read(arg,*) m0 + call getarg(4,arg) + read(arg,*) snr + call getarg(5,arg) + read(arg,*) iters + + ntones=2**m0 + xm0=m0 + scale=5.0 + fac=sqrt(1.0/nadd) + s=sqrt(10.0**(0.1*snr)) + hist=0 + nerr=0 + + call sgran() + + do iter=1,iters + do i=0,ntones-1 + r(i)=0. + do n=1,nadd + x1=0.707*gran() + y1=0.707*gran() + if(i.eq.0) x1=x1+s + if(ncoh.eq.0) r(i)=r(i) + x1*x1 + y1*y1 + if(ncoh.ne.0) r(i)=r(i) + x1 + enddo + r(i)=fac*r(i) + enddo + do m=0,m0-1 + n=2**m + r1=0. + r2=0. + do i=0,ntones-1 + if(iand(i,n).ne.0) r1=max(r1,r(i)) + if(iand(i,n).eq.0) r2=max(r2,r(i)) + enddo + don=r2-r1 + doff=r1-r2 + if(don.lt.0.0) nerr=nerr+1 + j1=lim(doff) + hist(1,j1)=hist(1,j1)+1 + j2=lim(don) + hist(2,j2)=hist(2,j2)+1 + enddo + enddo + + do i=-128,127 + write(13,1010) i/scale,hist(1,i)/(xm0*iters),hist(2,i)/(xm0*iters) +1010 format(f8.3,2f12.9) + enddo + + ber=nerr/(xm0*iters) + write(*,1020) nadd,m0,snr,ber +1020 format('nadd:',i3,' m0:',i2,' snr: 'f5.1,' BER:',f8.3) + + xln2=log(2.0) + do i=-128,127 + p1=hist(2,i)/(xm0*iters) + p0=hist(1,i)/(xm0*iters) + if(p0+p1.eq.0.0 .and. i.lt.0) p0=1.e-6 + if(p0+p1.eq.0.0 .and. i.gt.0) p1=1.e-6 + xlhd0=log(max(0.001,2.0*p0/(p0+p1)))/xln2 + xlhd1=log(max(0.001,2.0*p1/(p0+p1)))/xln2 + write(14,1012) i/scale,xlhd0,xlhd1,p0/(p0+p1),p1/(p0+p1) +1012 format(f7.1,2f8.3,2f9.6) + enddo + +999 end program genmet + diff --git a/wsjtx_lib/lib/genmsk40.f90 b/wsjtx_lib/lib/genmsk40.f90 new file mode 100644 index 0000000..dcbf934 --- /dev/null +++ b/wsjtx_lib/lib/genmsk40.f90 @@ -0,0 +1,66 @@ +subroutine genmsk40(msg,msgsent,ichk,itone,itype) + + use hashing + character*37 msg,msgsent,hashmsg + character*4 crpt,rpt(0:15) + logical first + integer*4 itone(144) + integer*1 message(16),codeword(32),bitseq(40) + integer*1 s8r(8) + data s8r/1,0,1,1,0,0,0,1/ ! Sync word is reversed wrt msk144 sync word. + data first/.true./ + data rpt/"-03 ","+00 ","+03 ","+06 ","+10 ","+13 ","+16 ", & + "R-03","R+00","R+03","R+06","R+10","R+13","R+16", & + "RRR ","73 "/ + save first,rpt + + itype=-1 + msgsent='*** bad message ***' + itone=0 + i1=index(msg,'>') + if(i1.lt.9) go to 900 + call fmtmsg(msg,iz) + crpt=msg(i1+2:i1+5) + do i=0,15 + if(crpt.eq.rpt(i)) go to 10 + enddo + go to 900 + +10 irpt=i !Report index, 0-15 + if(ichk.lt.10000) then + hashmsg=msg(2:i1-1) + call hash(hashmsg,37,ihash) + ihash=iand(ihash,4095) !12-bit hash + ig=16*ihash + irpt !4-bit report + else + ig=ichk-10000 + endif + + do i=1,16 + message(i)=iand(1,ishft(ig,1-i)) + enddo + + call encode_msk40(message,codeword) +! write(*,'(a6,i6,2x,a6,i6,2x,a6,i6)') ' msg: ',ig,'rprt: ',irpt,'hash: ',ihash +! write(*,'(a6,32i1)') ' cw: ',codeword + + bitseq(1:8)=s8r + bitseq(9:40)=codeword + bitseq=2*bitseq-1 + +! Map I and Q to tones. + itone=0 + do i=1, 20 + itone(2*i-1)=(bitseq(2*i)*bitseq(2*i-1)+1)/2; + itone(2*i)=-(bitseq(2*i)*bitseq(mod(2*i,40)+1)-1)/2; + enddo + +! Flip polarity + itone=-itone+1 + + msgsent=msg + itype=7 + +900 return +end subroutine genmsk40 + diff --git a/wsjtx_lib/lib/genmsk_128_90.f90 b/wsjtx_lib/lib/genmsk_128_90.f90 new file mode 100644 index 0000000..6e35d72 --- /dev/null +++ b/wsjtx_lib/lib/genmsk_128_90.f90 @@ -0,0 +1,120 @@ +subroutine genmsk_128_90(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 = standard message "Call_1 Call_2 Grid/Rpt" +! 2 = type 1 prefix +! 3 = type 1 suffix +! 4 = type 2 prefix +! 5 = type 2 suffix +! 6 = free text (up to 13 characters) +! 7 = short message " 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 s8(8) + real*8 pp(12) + real*8 xi(864),xq(864),pi,twopi + data s8/0,1,1,1,0,0,1,0/ + equivalence (ihash,i1hash) + logical first,unpk77_success + data first/.true./ + save + + if(first) then + first=.false. + nsym=128 + pi=4.0*atan(1.0) + twopi=8.*atan(1.0) + do i=1,12 + pp(i)=sin((i-1)*pi/12) + enddo + endif + + 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: +!8-bit sync word + 48 bits + 8-bit sync word + 80 bits + bitseq=0 + bitseq(1:8)=s8 + bitseq(9:56)=codeword(1:48) + bitseq(57:64)=s8 + bitseq(65:144)=codeword(49:128) + bitseq=2*bitseq-1 + + xq(1:6)=bitseq(1)*pp(7:12) !first bit is mapped to 1st half-symbol on q + do i=1,71 + is=(i-1)*12+7 + xq(is:is+11)=bitseq(2*i+1)*pp + enddo + xq(864-5:864)=bitseq(1)*pp(1:6) !last half symbol + do i=1,72 + is=(i-1)*12+1 + xi(is:is+11)=bitseq(2*i)*pp + enddo +! Map I and Q to tones. + i4tone=0 + do i=1,72 + i4tone(2*i-1)=(bitseq(2*i)*bitseq(2*i-1)+1)/2; + i4tone(2*i)=-(bitseq(2*i)*bitseq(mod(2*i,144)+1)-1)/2; + enddo + endif + +! Flip polarity + i4tone=-i4tone+1 +999 return +end subroutine genmsk_128_90 diff --git a/wsjtx_lib/lib/genqra64.f90 b/wsjtx_lib/lib/genqra64.f90 new file mode 100644 index 0000000..8426b88 --- /dev/null +++ b/wsjtx_lib/lib/genqra64.f90 @@ -0,0 +1,70 @@ +subroutine genqra64(msg0,ichk,msgsent,itone,itype) + +! Encodes a QRA64 message to yield itone(1:84) or a QRA65 msg, itone(1:85) + + use packjt + character*22 msg0 + character*22 message !Message to be generated + character*22 msgsent !Message as it will be received + integer itone(85) !QRA64 uses only 84 + character*3 cok !' ' or 'OOO' + integer dgen(13) + integer sent(63) + integer isync(22) + integer icos7(0:6) + data icos7/2,5,6,0,4,1,3/ !Defines a 7x7 Costas array + data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + save + + if(msg0(1:1).eq.'@') then + read(msg0(2:5),*,end=1,err=1) nfreq + go to 2 +1 nfreq=1000 +2 itone(1)=nfreq + write(msgsent,1000) nfreq +1000 format(i5,' Hz') + else + message=msg0 + do i=1,22 + if(ichar(message(i:i)).eq.0) then + message(i:)=' ' + exit + endif + enddo + + do i=1,22 !Strip leading blanks + if(message(1:1).ne.' ') exit + message=message(i+1:) + enddo + + call chkmsg(message,cok,nspecial,flip) + call packmsg(message,dgen,itype) !Pack message into 72 bits + call unpackmsg(dgen,msgsent) !Unpack to get message sent + if(ichk.eq.1) go to 999 !Return if checking only + call qra64_enc(dgen,sent) !Encode using QRA64 + + if(ichk.eq.65) then +! Experimental QRA65 mode + j=1 + k=0 + do i=1,85 + if(i.eq.isync(j)) then + j=j+1 !Index for next sync symbol + itone(i)=0 !Insert a sync symbol + else + k=k+1 + itone(i)=sent(k) + 1 + endif + enddo + else +! Original QRA64 mode + itone(1:7)=10*icos7 !Insert 7x7 Costas array in 3 places + itone(8:39)=sent(1:32) + itone(40:46)=10*icos7 + itone(47:77)=sent(33:63) + itone(78:84)=10*icos7 + endif + endif + +999 return +end subroutine genqra64 diff --git a/wsjtx_lib/lib/genwave.f90 b/wsjtx_lib/lib/genwave.f90 new file mode 100644 index 0000000..7db4cc7 --- /dev/null +++ b/wsjtx_lib/lib/genwave.f90 @@ -0,0 +1,52 @@ +subroutine genwave(itone,nsym,nsps,nwave,fsample,hmod,f0,icmplx,cwave,wave) + + real wave(nwave) + complex cwave(nwave) + integer hmod + integer itone(nsym) + logical ex + real*8 dt,phi,dphi,twopi,freq,baud + + dt=1.d0/fsample + twopi=8.d0*atan(1.d0) + baud=fsample/nsps + +! Calculate the audio waveform + phi=0.d0 + if(icmplx.le.0) wave=0. + if(icmplx.eq.1) cwave=0. + k=0 + do j=1,nsym + freq=f0 + itone(j)*hmod*baud + dphi=twopi*freq*dt + do i=1,nsps + k=k+1 + if(icmplx.eq.1) then + cwave(k)=cmplx(cos(phi),sin(phi)) + else + wave(k)=sin(phi) + endif + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + enddo + enddo + +!### TEMPORARY code to allow transmitting both A and B submodes + inquire(file='Q65_Tx2',exist=ex) + if(ex) then + k=0 + do j=1,nsym + freq=f0 + itone(j)*2.d0*hmod*baud + 500.d0 + dphi=twopi*freq*dt + do i=1,nsps + k=k+1 + wave(k)=0.5*(wave(k)+sin(phi)) + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + enddo + enddo + endif +!### + + return +end subroutine genwave diff --git a/wsjtx_lib/lib/genwspr.f90 b/wsjtx_lib/lib/genwspr.f90 new file mode 100644 index 0000000..d1d5183 --- /dev/null +++ b/wsjtx_lib/lib/genwspr.f90 @@ -0,0 +1,30 @@ +subroutine genwspr(message,msgsent,itone) +! Encode a WSPR message and generate the array of channel symbols. + + character*22 message,msgsent + parameter (MAXSYM=176) + integer*1 symbol(MAXSYM) + integer*1 data0(11) + integer*4 itone(162) + integer npr3(162) + data npr3/ & + 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/ + + call wqencode(message,ntype,data0) !Source encoding + call encode232(data0,162,symbol) !Convolutional encoding + call inter_wspr(symbol,1) !Interleaving + do i=1,162 + itone(i)=npr3(i) + 2*symbol(i) + enddo + msgsent=message !### To be fixed... ?? ### + + return +end subroutine genwspr diff --git a/wsjtx_lib/lib/geodist.f90 b/wsjtx_lib/lib/geodist.f90 new file mode 100644 index 0000000..cce5545 --- /dev/null +++ b/wsjtx_lib/lib/geodist.f90 @@ -0,0 +1,105 @@ +subroutine geodist(Eplat,Eplon,Stlat,Stlon,Az,Baz,Dist) + implicit none + real eplat, eplon, stlat, stlon, az, baz, dist + +! JHT: In actual fact, I use the first two arguments for "My Location", +! the second two for "His location"; West longitude is positive. + +! Taken directly from: +! Thomas, P.D., 1970, Spheroidal geodesics, reference systems, +! & local geometry, U.S. Naval Oceanographi!Office SP-138, +! 165 pp. +! assumes North Latitude and East Longitude are positive + +! EpLat, EpLon = End point Lat/Long +! Stlat, Stlon = Start point lat/long +! Az, BAz = direct & reverse azimuith +! Dist = Dist (km); Deg = central angle, discarded + + real BOA, F, P1R, P2R, L1R, L2R, DLR, T1R, T2R, TM, & + DTM, STM, CTM, SDTM,CDTM, KL, KK, SDLMR, L, & + CD, DL, SD, T, U, V, D, X, E, Y, A, FF64, TDLPM, & + HAPBR, HAMBR, A1M2, A2M1 + + real AL,BL,D2R,Pi2 + + data AL/6378206.4/ ! Clarke 1866 ellipsoid + data BL/6356583.8/ +! real pi /3.14159265359/ + data D2R/0.01745329251994/ ! degrees to radians conversion factor + data Pi2/6.28318530718/ + + if(abs(Eplat-Stlat).lt.0.02 .and. abs(Eplon-Stlon).lt.0.02) then + Az=0. + Baz=180.0 + Dist=0 + go to 999 + endif + + BOA = BL/AL + F = 1.0 - BOA +! Convert st/end pts to radians + P1R = Eplat * D2R + P2R = Stlat * D2R + L1R = Eplon * D2R + L2R = StLon * D2R + DLR = L2R - L1R ! DLR = Delta Long in Rads + T1R = ATan(BOA * Tan(P1R)) + T2R = ATan(BOA * Tan(P2R)) + TM = (T1R + T2R) / 2.0 + DTM = (T2R - T1R) / 2.0 + STM = Sin(TM) + CTM = Cos(TM) + SDTM = Sin(DTM) + CDTM = Cos(DTM) + KL = STM * CDTM + KK = SDTM * CTM + SDLMR = Sin(DLR/2.0) + L = SDTM * SDTM + SDLMR * SDLMR * (CDTM * CDTM - STM * STM) + CD = 1.0 - 2.0 * L + DL = ACos(CD) + SD = Sin(DL) + T = DL/SD + U = 2.0 * KL * KL / (1.0 - L) + V = 2.0 * KK * KK / L + D = 4.0 * T * T + X = U + V + E = -2.0 * CD + Y = U - V + A = -D * E + FF64 = F * F / 64.0 + Dist = AL*SD*(T -(F/4.0)*(T*X-Y)+FF64*(X*(A+(T-(A+E) & + /2.0)*X)+Y*(-2.0*D+E*Y)+D*X*Y))/1000.0 + TDLPM = Tan((DLR+(-((E*(4.0-X)+2.0*Y)*((F/2.0)*T+FF64* & + (32.0*T+(A-20.0*T)*X-2.0*(D+2.0)*Y))/4.0)*Tan(DLR)))/2.0) + HAPBR = ATan2(SDTM,(CTM*TDLPM)) + HAMBR = Atan2(CDTM,(STM*TDLPM)) + A1M2 = Pi2 + HAMBR - HAPBR + A2M1 = Pi2 - HAMBR - HAPBR + +1 If ((A1M2 .ge. 0.0) .AND. (A1M2 .lt. Pi2)) GOTO 5 + If (A1M2 .lt. Pi2) GOTO 4 + A1M2 = A1M2 - Pi2 + GOTO 1 +4 A1M2 = A1M2 + Pi2 + GOTO 1 + +! All of this gens the proper az, baz (forward and back azimuth) + +5 If ((A2M1 .ge. 0.0) .AND. (A2M1 .lt. Pi2)) GOTO 9 + If (A2M1 .lt. Pi2) GOTO 8 + A2M1 = A2M1 - Pi2 + GOTO 5 +8 A2M1 = A2M1 + Pi2 + GOTO 5 + +9 Az = A1M2 / D2R + BAZ = A2M1 / D2R + +!Fix the mirrored coords here. + + az = 360.0 - az + baz = 360.0 - baz + +999 return +end subroutine geodist diff --git a/wsjtx_lib/lib/get_q3list.f90 b/wsjtx_lib/lib/get_q3list.f90 new file mode 100644 index 0000000..a6b6de8 --- /dev/null +++ b/wsjtx_lib/lib/get_q3list.f90 @@ -0,0 +1,132 @@ +subroutine get_q3list(fname,bDiskData,nlist,list) + + type q3list + character*6 call + character*4 grid + integer nsec + integer nfreq + integer moonel + end type q3list + + parameter (MAX_CALLERS=40) + character*(*) fname + character*36 list(40) + character*8 grid6 + logical*1 bDiskData + integer time + integer nt(8) + integer indx(MAX_CALLERS) + type(q3list) ctmp(MAX_CALLERS),callers(MAX_CALLERS) + character*256 jpleph_file_name,file24name + common/jplcom/jpleph_file_name + common/lu24com/file24name + + nhist2=0 + open(24,file=fname,status='unknown',form='unformatted') + read(24,end=1) nhist2 + if(nhist2.ge.1 .and. nhist2.le.40) then + read(24,end=1) ctmp(1:nhist2) + else + nhist2=0 + endif +1 rewind 24 + if(nhist2.eq.0) go to 900 + + now=time() + call date_and_time(values=nt) + uth=nt(5) + (nt(6)-nt(4))/60.0 + nt(7)/3600.0 + j=0 + + do i=1,nhist2 + age=(now - ctmp(i)%nsec)/3600.0 + if(age.gt.24.0) cycle + grid6=ctmp(i)%grid//'mm' + call grid2deg(grid6,xlon,xlat) + call sun(nt(1),nt(2),nt(3),uth,-xlon,xlat,RASun,DecSun,xLST, & + AzSun,ElSun,mjd,day) + call moondopjpl(nt(1),nt(2),nt(3),uth,-xlon,xlat,RAMoon,DecMoon, & + xLST,HA,AzMoon,ElMoon,vr,techo) + if(ElMoon.lt.-5.0 .and. (.not.bDiskData)) cycle + j=j+1 !Keep this one... + callers(j)=ctmp(i) + callers(j)%moonel=nint(ElMoon) !... and save its current moonel + enddo + + nhist2=j + write(24) nhist2 + write(24) callers(1:nhist2) + + call indexx(callers(1:nhist2)%nfreq,nhist2,indx) + do i=1,nhist2 + j=indx(i) + moon_el=nint(ElMoon) + age=(now - callers(j)%nsec)/3600.0 + write(list(i),1000) i,callers(j)%nfreq,callers(j)%call, & + callers(j)%grid,callers(j)%moonel,age,char(0) +1000 format(i2,'.',i6,2x,a6,2x,a4,i5,f7.1,a1) + +! h1=mod(now,86400)/3600.0 +! h2=mod(callers(i)%nsec,86400)/3600.0 +! hd=h1-h2 +! if(hd.lt.0.0) hd=hd+24.0 +! write(*,3301) i,callers(i)%call,now,callers(i)%nsec,h1,h2,hd +!3301 format(i3,2x,a6,2i12,3f10.6) + + enddo + +900 close(24) + nlist=nhist2 + file24name=fname + + return +end subroutine get_q3list + +subroutine rm_q3list(dxcall0) + + parameter (MAX_CALLERS=40) + type q3list + character*6 call + character*4 grid + integer nsec + integer nfreq + integer moonel + end type q3list + character*(*) dxcall0 + character*6 dxcall + character*256 file24name + type(q3list) callers(MAX_CALLERS) + common/lu24com/file24name + + dxcall=dxcall0 + open(24,file=trim(file24name),status='unknown',form='unformatted') + read(24) nhist2 + read(24) callers(1:nhist2) + + if(nhist2.eq.MAX_CALLERS .and. dxcall.eq.callers(nhist2)%call) then + nhist2=MAX_CALLERS - 1 + go to 10 + endif + + iz=nhist2 + do i=1,iz + if(callers(i)%call .eq. dxcall) then + nhist2=nhist2-1 + callers(i:nhist2)=callers(i+1:nhist2+1) !Remove dxcall from q3list + exit + endif + enddo + +10 rewind 24 + write(24) nhist2 + write(24) callers(1:nhist2) + close(24) + + return +end subroutine rm_q3list + +subroutine jpl_setup(fname) + character*256 fname,jpleph_file_name + common/jplcom/jpleph_file_name + jpleph_file_name=fname + return +end subroutine jpl_setup diff --git a/wsjtx_lib/lib/getlags.f90 b/wsjtx_lib/lib/getlags.f90 new file mode 100644 index 0000000..0797f62 --- /dev/null +++ b/wsjtx_lib/lib/getlags.f90 @@ -0,0 +1,27 @@ +subroutine getlags(nsps8,lag0,lag1,lag2) + if(nsps8.eq.864) then + lag1=39 + lag2=291 + lag0=123 + else if(nsps8.eq.1920) then + lag1=70 + lag2=184 + lag0=108 + else if(nsps8.eq.5120) then + lag1=84 + lag2=129 + lag0=99 + else if(nsps8.eq.10368) then + lag1=91 + lag2=112 + lag0=98 + else if(nsps8.eq.31500) then + lag1=93 + lag2=102 + lag0=96 + else + stop 'Error in getlags' + endif + + return +end subroutine getlags diff --git a/wsjtx_lib/lib/getmet4.f90 b/wsjtx_lib/lib/getmet4.f90 new file mode 100644 index 0000000..7378935 --- /dev/null +++ b/wsjtx_lib/lib/getmet4.f90 @@ -0,0 +1,56 @@ +subroutine getmet4(mettab,ndelta) + +! Return appropriate metric table for soft-decision convolutional decoder. + +! Metric table (RxSymbol,TxSymbol) +! integer mettab(0:255,0:1) + integer mettab(-128:127,0:1) + real*4 xx0(0:255) + data xx0/ & + 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/ + save + + bias=0.5 + scale=50 + ndelta=nint(3.4*scale) + do i=0,255 + xx=xx0(i) + if(i.ge.160) xx=xx0(160) - (i-160)*6.822/65.3 + mettab(i-128,0)=nint(scale*(xx-bias)) + if(i.ge.1) mettab(128-i,1)=mettab(i-128,0) + enddo + mettab(-128,1)=mettab(-127,1) + + return +end subroutine getmet4 diff --git a/wsjtx_lib/lib/go_chkfft.cmd b/wsjtx_lib/lib/go_chkfft.cmd new file mode 100644 index 0000000..fb5de53 --- /dev/null +++ b/wsjtx_lib/lib/go_chkfft.cmd @@ -0,0 +1 @@ +gfortran -o chkfft3 chkfft3.f90 four2a.f90 gran.c libfftw3f-3.dll diff --git a/wsjtx_lib/lib/golay24_table.c b/wsjtx_lib/lib/golay24_table.c new file mode 100644 index 0000000..a015c75 --- /dev/null +++ b/wsjtx_lib/lib/golay24_table.c @@ -0,0 +1,28 @@ +void golay24_table_(int cw[]) +{ + // Compute arnd return the table of 4096 codewords for the Golay (24,12) code. + + // Array y contains the twelve rows (columns) of the parity-check matrix + int y[12] = { 0x7ff, 0xee2, 0xdc5, 0xb8b, 0xf16, 0xe2d, + 0xc5b, 0x8b7, 0x96e, 0xadc, 0xdb8, 0xb71 }; + + int c[2]; /* Codeword composed of 12-bit info and 12-bit parity */ + + + int i,j,k; + int aux; + int weight(int vector); + + for(k=0; k<4096; k++) { + c[0] = k; + c[1] = 0; + for (i=0; i<12; i++) { + aux = 0; + for (j=0; j<12; j++) { + aux = aux ^ ((c[0] & y[i]) >> j & 1); + } + c[1] = (c[1] << 1) ^ aux; + } + cw[k]=4096*c[0] + c[1]; + } +} diff --git a/wsjtx_lib/lib/gran.c b/wsjtx_lib/lib/gran.c new file mode 100644 index 0000000..ac41c7f --- /dev/null +++ b/wsjtx_lib/lib/gran.c @@ -0,0 +1,34 @@ +#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; +} + +/* Generates evenly distributed numbers between 0 and 1. */ +float rran_() +{ + return (float)rand()/(float)RAND_MAX; +} diff --git a/wsjtx_lib/lib/graycode.f90 b/wsjtx_lib/lib/graycode.f90 new file mode 100644 index 0000000..21c1f90 --- /dev/null +++ b/wsjtx_lib/lib/graycode.f90 @@ -0,0 +1,9 @@ +subroutine graycode(ia,n,idir,ib) + + integer ia(n),ib(n) + do i=1,n + ib(i)=igray(ia(i),idir) + enddo + + return +end subroutine graycode diff --git a/wsjtx_lib/lib/graycode65.f90 b/wsjtx_lib/lib/graycode65.f90 new file mode 100644 index 0000000..bb2c669 --- /dev/null +++ b/wsjtx_lib/lib/graycode65.f90 @@ -0,0 +1,9 @@ +subroutine graycode65(dat,n,idir) + + integer dat(n) + do i=1,n + dat(i)=igray(dat(i),idir) + enddo + + return +end subroutine graycode65 diff --git a/wsjtx_lib/lib/grayline.f90 b/wsjtx_lib/lib/grayline.f90 new file mode 100644 index 0000000..cc1aeee --- /dev/null +++ b/wsjtx_lib/lib/grayline.f90 @@ -0,0 +1,32 @@ +subroutine grayline(nyear,month,nday,uth,mygrid,nduration,isun) + + character*6 mygrid + real LST + real lat,lon + + call grid2deg(MyGrid,elon,lat) + lon=-elon + + uth0=uth-0.5*nduration/60.0 + uth1=uth+0.5*nduration/60.0 + + call sun(nyear,month,nday,uth0,lon,lat,RASun,DecSun,LST, & + AzSun,ElSun0,mjd,day) + call sun(nyear,month,nday,uth1,lon,lat,RASun,DecSun,LST, & + AzSun,ElSun1,mjd,day) + + elchk=-0.8333 + isun=-1 + if(elsun0.lt.elchk .and. elsun1.ge.elchk) then + isun=0 + else if(elsun0.gt.elchk .and. elsun1.le.elchk) then + isun=2 + else if(elsun1.gt.elchk) then + isun=1 + else + isun=3 + endif + + return +end subroutine grayline + diff --git a/wsjtx_lib/lib/grid2deg.f90 b/wsjtx_lib/lib/grid2deg.f90 new file mode 100644 index 0000000..a7ec1c8 --- /dev/null +++ b/wsjtx_lib/lib/grid2deg.f90 @@ -0,0 +1,39 @@ +subroutine grid2deg(grid0,dlong,dlat) + +! Converts Maidenhead grid locator to degrees of West longitude +! and North latitude. + + character*(*) grid0 + character*6 grid + character*1 g1,g2,g3,g4,g5,g6 + + grid=grid0 + i=ichar(grid(5:5)) + if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm' + + if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)= & + char(ichar(grid(1:1))+ichar('A')-ichar('a')) + if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)= & + char(ichar(grid(2:2))+ichar('A')-ichar('a')) + if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)= & + char(ichar(grid(5:5))-ichar('A')+ichar('a')) + if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)= & + char(ichar(grid(6:6))-ichar('A')+ichar('a')) + + g1=grid(1:1) + g2=grid(2:2) + g3=grid(3:3) + g4=grid(4:4) + g5=grid(5:5) + g6=grid(6:6) + + nlong = 180 - 20*(ichar(g1)-ichar('A')) + n20d = 2*(ichar(g3)-ichar('0')) + xminlong = 5*(ichar(g5)-ichar('a')+0.5) + dlong = nlong - n20d - xminlong/60.0 + nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0') + xminlat = 2.5*(ichar(g6)-ichar('a')+0.5) + dlat = nlat + xminlat/60.0 + + return +end subroutine grid2deg diff --git a/wsjtx_lib/lib/hash.f90 b/wsjtx_lib/lib/hash.f90 new file mode 100644 index 0000000..3759839 --- /dev/null +++ b/wsjtx_lib/lib/hash.f90 @@ -0,0 +1,10 @@ +subroutine hash(string,len,ihash) + use iso_c_binding, only: c_loc,c_size_t + use hashing + parameter (MASK15=32767) +! character*(*), target :: string + character*1, target :: string + i=nhash(c_loc(string),int(len,c_size_t),146) + ihash=iand(i,MASK15) + return +end subroutine hash diff --git a/wsjtx_lib/lib/hashing.f90 b/wsjtx_lib/lib/hashing.f90 new file mode 100644 index 0000000..5534fa9 --- /dev/null +++ b/wsjtx_lib/lib/hashing.f90 @@ -0,0 +1,10 @@ +module hashing + interface + integer(c_int32_t) function nhash (key, length, initval) bind(C, name="nhash") + use iso_c_binding, only: c_ptr, c_size_t, c_int32_t + type(c_ptr), intent(in), value :: key + integer(c_size_t), intent(in), value :: length + integer(c_int32_t), intent(in), value :: initval + end function nhash + end interface +end module hashing diff --git a/wsjtx_lib/lib/hint65.f90 b/wsjtx_lib/lib/hint65.f90 new file mode 100644 index 0000000..00eaf40 --- /dev/null +++ b/wsjtx_lib/lib/hint65.f90 @@ -0,0 +1,154 @@ +subroutine hint65(s3,mrs,mrs2,nadd,nflip,mycall,hiscall,hisgrid,qual,decoded) + + use packjt + use prog_args + parameter (MAXCALLS=10000,MAXRPT=63) + parameter (MAXMSG=2*MAXCALLS + 2 + MAXRPT) + real s3(64,63) + integer*1 sym1(0:62,MAXMSG) + integer*1 sym2(0:62,MAXMSG) + integer mrs(63),mrs2(63) + integer dgen(12),sym(0:62),sym_rev(0:62) + character*6 mycall,hiscall,hisgrid,call2(MAXCALLS) + character*4 grid2(MAXCALLS),rpt(MAXRPT) + character callsign*12,grid*4 + character*180 line + character ceme*3,msg*22,msg00*22 + character*22 msg0(MAXMSG),decoded + logical*1 eme(MAXCALLS) + logical first + data first/.true./ + data rpt/'-01','-02','-03','-04','-05', & + '-06','-07','-08','-09','-10', & + '-11','-12','-13','-14','-15', & + '-16','-17','-18','-19','-20', & + '-21','-22','-23','-24','-25', & + '-26','-27','-28','-29','-30', & + 'R-01','R-02','R-03','R-04','R-05', & + 'R-06','R-07','R-08','R-09','R-10', & + 'R-11','R-12','R-13','R-14','R-15', & + 'R-16','R-17','R-18','R-19','R-20', & + 'R-21','R-22','R-23','R-24','R-25', & + 'R-26','R-27','R-28','R-29','R-30', & + 'RO','RRR','73'/ + save first,sym1,nused,msg0,sym2 + + first=.true. !### For now, at least: always recompute hypothetical messages + if(first) then + neme=0 + open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown') + icall=0 + j=0 + do i=1,MAXCALLS + read(23,1002,end=10) line +1002 format(a80) + if(line(1:4).eq.'ZZZZ') cycle + if(line(1:2).eq.'//') cycle + i1=index(line,',') + if(i1.lt.4) cycle + i2=index(line(i1+1:),',') + if(i2.lt.5) cycle + i2=i2+i1 + i3=index(line(i2+1:),',') + if(i3.lt.1) i3=index(line(i2+1:),' ') + i3=i2+i3 + callsign=line(1:i1-1) + grid=line(i1+1:i1+4) + ceme=line(i2+1:i3-1) + eme(i)=ceme.eq.'EME' + if(neme.eq.1 .and. (.not.eme(i))) cycle + j=j+1 + call2(j)=callsign(1:6) !### Fix for compound callsigns! + grid2(j)=grid + enddo +10 ncalls=j + close(23) + +! NB: generation of test messages is not yet complete! + j=0 + do i=-1,ncalls + if(i.eq.0 .and. hiscall.eq.' ' .and. hisgrid(1:4).eq.' ') cycle + mz=2 + if(i.eq.-1) mz=1 + if(i.eq.0) mz=65 + do m=1,mz + j=j+1 + if(i.eq.-1) then + msg='0123456789ABC' + else if(i.eq.0) then + if(m.eq.1) msg=mycall//' '//hiscall//' '//hisgrid(1:4) + if(m.eq.2) msg='CQ '//hiscall//' '//hisgrid(1:4) + if(m.ge.3) msg=mycall//' '//hiscall//' '//rpt(m-2) + else + if(m.eq.1) msg=mycall//' '//call2(i)//' '//grid2(i) + if(m.eq.2) msg='CQ '//call2(i)//' '//grid2(i) + endif + call fmtmsg(msg,iz) + call packmsg(msg,dgen,itype) !Pack message into 72 bits + call rs_encode(dgen,sym_rev) !RS encode + sym(0:62)=sym_rev(62:0:-1) + sym1(0:62,j)=sym + + call interleave63(sym_rev,1) !Interleave channel symbols + call graycode(sym_rev,63,1,sym_rev) !Apply Gray code + sym2(0:62,j)=sym_rev(0:62) + msg0(j)=msg + enddo + enddo + nused=j + first=.false. + endif + + ref0=0. + do j=1,63 + ref0=ref0 + s3(mrs(j)+1,j) + enddo + + u1=0. + u1=-99.0 + u2=u1 + +! Find u1 and u2 (best and second-best) codeword from a list, using +! a bank of matched filters on the symbol spectra s3(i,j). + ipk=1 + ipk2=0 + msg00=' ' + do k=1,nused + if(k.ge.2 .and. k.le.64 .and. nflip.lt.0) cycle +! Test all messages if nflip=+1; skip the CQ messages if nflip=-1. + if(nflip.gt.0 .or. msg0(k)(1:3).ne.'CQ ') then + psum=0. + ref=ref0 + do j=1,63 + i=sym2(j-1,k)+1 + psum=psum + s3(i,j) + if(i.eq.mrs(j)+1) ref=ref - s3(i,j) + s3(mrs2(j)+1,j) + enddo + p=psum/ref + + if(p.gt.u1) then + if(msg0(k).ne.msg00) then + ipk2=ipk + u2=u1 + endif + u1=p + ipk=k + msg00=msg0(k) + endif + if(msg0(k).ne.msg00 .and. p.gt.u2) then + u2=p + ipk2=k + endif + endif + enddo + + decoded=' ' + bias=max(1.12*u2,0.35) + if(nadd.ge.4) bias=max(1.08*u2,0.45) + if(nadd.ge.8) bias=max(1.04*u2,0.60) + qual=100.0*(u1-bias) + qmin=1.0 + if(qual.ge.qmin) decoded=msg0(ipk) + + return +end subroutine hint65 diff --git a/wsjtx_lib/lib/hspec.f90 b/wsjtx_lib/lib/hspec.f90 new file mode 100644 index 0000000..b30f4a0 --- /dev/null +++ b/wsjtx_lib/lib/hspec.f90 @@ -0,0 +1,105 @@ +subroutine hspec(id2,k,nutc0,ntrpdepth,nrxfreq,ntol,bmsk144, & + btrain,pcoeffs,ingain,mycall,hiscall,bshmsg,bswl,datadir,green,s, & + jh,pxmax,dbNoGain,line1) + +! Input: +! k pointer to the most recent new data +! nutc0 UTC for display of decode(s) +! ntrpdepth TR period and 1000*ndepth +! nrxfreq Rx audio center frequency +! ntol Decoding range is +/- ntol +! ncontest Contest type (0=NONE 1=NA_VHF 2=EU_VHF 3=FIELD_DAY 4=RTTY 5=WW_DIGI) +! bmsk144 Boolean, true if in MSK144 mode +! btrain Boolean, turns on training in MSK144 mode +! ingain Relative gain for spectra + +! Output: +! green() power +! s() spectrum for horizontal spectrogram +! jh index of most recent data in green(), s() + + parameter (JZ=703) + character*80 line1 + character*(*) datadir + character*12 mycall,hiscall + integer*2 id2(0:120*12000-1) + logical*1 bmsk144,bshmsg,btrain,bswl + real green(0:JZ-1) + real s(0:63,0:JZ-1) + real x(512) + real*8 pcoeffs(5) + complex cx(0:256) + data rms/999.0/,k0/99999999/ + equivalence (x,cx) + save ja,rms0 + + ndepth=ntrpdepth/1000 + ntrperiod=ntrpdepth - 1000*ndepth + gain=10.0**(0.1*ingain) + nfft=512 + nstep=nfft + nblks=7 + if(ntrperiod.lt.30) then + nstep=256 + nblks=14 + endif + + if(k.gt.30*12000) go to 900 + if(k.lt.nfft) then + jh=0 + go to 900 !Wait for enough samples to start + endif + + if(k.lt.k0) then !Start a new data block + ja=-nstep + jh=-1 + rms0=0.0 + endif + + pxmax = 0; + do iblk=1,nblks + if(jh.lt.JZ-1) jh=jh+1 + ja=ja+nstep + jb=ja+nfft-1 + x=id2(ja:jb) + sq=dot_product(x,x) + xmax = maxval(x); + xmin = abs(minval(x)); + if (xmin > xmax) xmax = xmin; + if (xmax.gt.0.0) pxmax=20.0*log10(xmax); + rms=sqrt(gain*sq/nfft) + rms2=sqrt(sq/nfft); + green(jh)=0. + if(rms.gt.0.0) then + green(jh)=20.0*log10(rms) + dbNoGain=20.0*log10(rms2); + endif + call four2a(x,nfft,1,-1,0) !Real-to-complex FFT + df=12000.0/nfft + fac=(1.0/nfft)**2 + do i=1,64 + j=2*i + sx=real(cx(j))**2 + aimag(cx(j))**2 + real(cx(j-1))**2 + & + aimag(cx(j-1))**2 + s(i-1,jh)=fac*gain*sx + enddo + if(ja+2*nfft.gt.k) exit + enddo + k0=k + + if(bmsk144) then + if(k.ge.7168) then + tsec=(k-7168)/12000.0 + k0=k-7168 + tt1=sum(float(abs(id2(k0:k0+3583)))) + k0=k-3584 + tt2=sum(float(abs(id2(k0:k0+3583)))) + if(tt1.ne.0.0 .and. tt2.ne.0) then + call mskrtd(id2(k-7168+1:k),nutc0,tsec,ntol,nrxfreq,ndepth, & + mycall,hiscall,bshmsg,btrain,pcoeffs,bswl,datadir,line1) + endif + endif + endif + +900 return +end subroutine hspec diff --git a/wsjtx_lib/lib/igray.c b/wsjtx_lib/lib/igray.c new file mode 100644 index 0000000..4646898 --- /dev/null +++ b/wsjtx_lib/lib/igray.c @@ -0,0 +1,18 @@ +int igray_(int *n0, int *idir) +{ + int n; + unsigned long sh; + unsigned long nn; + n=*n0; + + if(*idir>0) return (n ^ (n >> 1)); + + sh = 1; + nn = (n >> sh); + while (nn > 0) { + n ^= nn; + sh <<= 1; + nn = (n >> sh); + } + return (n); +} diff --git a/wsjtx_lib/lib/image.f90 b/wsjtx_lib/lib/image.f90 new file mode 100644 index 0000000..db1d7e1 --- /dev/null +++ b/wsjtx_lib/lib/image.f90 @@ -0,0 +1,336 @@ +subroutine imopen(plotfile) + character*(*) plotfile + common/imcom/ lu,npage + + lu=80 + open(lu,file=plotfile,status='unknown') + write(lu,1000) +1000 format('%!PS-Adobe-2.0'/ & + '/rightshow { dup stringwidth pop neg 0 rmoveto show } def'/ & + '/centershow { dup stringwidth pop neg 2 div ', & + '0 rmoveto show } def'/ & + '/lt { lineto } def'/'%%Page: 1 1') + npage=1 + + return +end subroutine imopen + +subroutine impalette(palette) + character*(*) palette + integer r(0:8),g(0:8),b(0:8) + integer rr,gg,bb + common/imcom/ lu,npage + common/imcom2/rr(0:255),gg(0:255),bb(0:255) + + if(palette.eq.'afmhot') then + do i=0,255 + j=255-i + rr(i)=min(255,2*j) + gg(i)=max(0,min(255,2*j-128)) + bb(i)=max(0,min(255,2*j-256)) + enddo + else if(palette.eq.'hot') then + do i=0,255 + j=255-i + rr(i)=min(255,3*j) + gg(i)=max(0,min(255,3*j-256)) + bb(i)=max(0,min(255,3*j-512)) + enddo + else + open(11,file="Palettes/"//palette,status="old") + do j=0,8 + read(11,*) r(j),g(j),b(j) + enddo + close(11) + do i=0,255 + j0=i/32 + j1=j0+1 + k=i-32*j0 + rr(i)=r(j0) + int((k*(r(j1)-r(j0)))/31 + 0.5) + gg(i)=g(j0) + int((k*(g(j1)-g(j0)))/31 + 0.5) + bb(i)=b(j0) + int((k*(b(j1)-b(j0)))/31 + 0.5) + enddo + + endif + + return +end subroutine impalette + +subroutine imclose + common/imcom/ lu,npage + write(lu,1000) +1000 format('showpage'/'%%Trailer') + close(lu) + return +end subroutine imclose + +subroutine imnewpage + common/imcom/ lu,npage + npage=npage+1 + write(lu,1000) npage,npage +1000 format('showpage'/'%%Page:',2i4) + return +end subroutine imnewpage + +subroutine imxline(x,y,dx) +! Draw a line from (x,y) to (x+dx,y) integer r,g,b + common/imcom/ lu,npage + write(lu,1000) 72.0*x,72.0*y,72.0*dx +1000 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto stroke') + return +end subroutine imxline + +subroutine imyline(x,y,dy) +! Draw a line from (x,y) to (x,y+dy) + common/imcom/ lu,npage + write(lu,1000) 72.0*x,72.0*y,72.0*dy +1000 format('newpath',2f7.1,' moveto 0',f7.1,' rlineto stroke') + return +end subroutine imyline + +subroutine imwidth(width) + common/imcom/ lu,npage + write(lu,1000) width +1000 format(f7.1,' setlinewidth') + return +end subroutine imwidth + +subroutine imfont(fontname,npoints) + character*(*) fontname + common/imcom/ lu,npage + write(lu,1000) fontname,npoints +1000 format('/',a,' findfont',i4,' scalefont setfont') + return +end subroutine imfont + +subroutine imstring(string,x,y,just,ndeg) + character*(*) string + common/imcom/ lu,npage + write(lu,1000) 72.0*x,72.0*y,ndeg,string +1000 format(2f7.1,' moveto',i4,' rotate'/'(',a,')') + if(just.eq.1) write(lu,*) 'rightshow' + if(just.eq.2) write(lu,*) 'centershow' + if(just.eq.3) write(lu,*) 'show' + write(lu,1010) -ndeg +1010 format(i4,' rotate'/) + return +end subroutine imstring + +subroutine imr4mat(z,IP,JP,imax,jmax,zz1,zz2,x,y,dx,dy,nbox) + real z(IP,JP) + integer idat(2048) + common/imcom/ lu,npage + + z1=zz1 + z2=zz2 + if(z1.eq.0.0 .and. z2.eq.0.0) then + z1=z(1,1) + z2=z1 + do i=1,imax + do j=1,jmax + z1=min(z(i,j),z1) + z2=max(z(i,j),z2) + enddo + enddo + endif + scale=255.99/(z2-z1) + + write(lu,1002) 72.0*x,72.0*y,72.0*dx,72.0*dy +1002 format(2f7.1,' translate',2f7.1,' scale') + write(lu,*) imax,jmax,8,' [',imax,0,0,jmax,0,0,']' + write(lu,*) '{<' + + do j=1,jmax + do i=1,imax + idat(i)=scale*(z(i,j)-z1) + idat(i)=max(idat(i),0) + idat(i)=min(idat(i),255) + idat(i)=255-idat(i) + enddo + write(lu,1004) (idat(i),i=1,imax) +1004 format(30z2.2) + enddo + write(lu,*) '>} image' + write(lu,1006) 1.0/(72.0*dx),1.0/(72.0*dy),-72.0*x,-72.0*y +1006 format(2f9.6,' scale',2f7.1,' translate') + + if(nbox.ne.0) then + write(lu,1010) 72.0*x,72.0*y,72.0*dx,72.0*dy,-72*dx +1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', & + f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke') + endif + + return +end subroutine imr4mat + +subroutine imr4mat_color(z,IP,JP,imax,jmax,zz1,zz2,x,y,dx,dy,nbox) + real z(IP,JP) + integer idat(2048,3) + integer rr,gg,bb + common/imcom/ lu,npage + common/imcom2/rr(0:255),gg(0:255),bb(0:255) + + z1=zz1 + z2=zz2 + if(z1.eq.0.0 .and. z2.eq.0.0) then + z1=z(1,1) + z2=z1 + do i=1,imax + do j=1,jmax + z1=min(z(i,j),z1) + z2=max(z(i,j),z2) + enddo + enddo + endif + scale=255.99/(z2-z1) + + write(lu,1002) 72.0*x,72.0*y,72.0*dx,72.0*dy +1002 format(2f7.1,' translate',2f7.1,' scale') + write(lu,1003) imax,jmax,8,imax,0,0,jmax,0,0 +1003 format(3i5,' [',6i4,']') + write(lu,1004) imax +1004 format('{currentfile 3',i4,' mul string readhexstring pop} bind'/ & + 'false 3 colorimage') + + do j=1,jmax + do i=1,imax + n=scale*(z(i,j)-z1) + n=max(n,0) + n=min(n,255) + idat(i,1)=rr(n) + idat(i,2)=gg(n) + idat(i,3)=bb(n) + enddo + write(lu,1005) (idat(i,1),idat(i,2),idat(i,3),i=1,imax) +1005 format(30z2.2) + enddo + + write(lu,1006) 1.0/(72.0*dx),1.0/(72.0*dy),-72.0*x,-72.0*y +1006 format(2f9.6,' scale',2f7.1,' translate') + + if(nbox.ne.0) then + write(lu,1010) 72.0*x,72.0*y,72.0*dx,72.0*dy,-72*dx +1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', & + f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke') + endif + + return +end subroutine imr4mat_color + +subroutine imr4pro(p,imax,yy1,yy2,x,y,dx,dy,nbox) + real p(imax) + common/imcom/ lu,npage + + y1=yy1 + y2=yy2 + if(y1.eq.0.0 .and. y2.eq.0.0) then + y1=p(1) + y2=y1 + do i=1,imax + y1=min(p(i),y1) + y2=max(p(i),y2) + enddo + endif + + xscale=72.0*dx/imax + xoff=72.0*x + yscale=72.0*dy + if(y1.ne.y2) yscale=yscale/(y2-y1) + yoff=72.0*y + + write(lu,*) '1.416 setmiterlimit' + write(lu,1002) xoff+0.5*xscale,yoff+yscale*(p(1)-y1) +1002 format('newpath',2f7.1,' moveto') + + do i=2,imax + write(lu,1004) xoff+(i-0.5)*xscale,yoff+yscale*(p(i)-y1) +1004 format(2f6.1,' lt') + enddo + write(lu,*) 'stroke' + + if(nbox.ne.0) then + write(lu,1010) xoff,yoff,72.0*dx,72.0*dy,-72*dx +1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', & + f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke') + endif + + return +end subroutine imr4pro + +subroutine imline(x1,y1,x2,y2) + common/imcom/ lu,npage + write(lu,1000) 72*x1,72*y1,72*x2,72*y2 +1000 format('newpath',2f7.1,' moveto',2f7.1,' lineto stroke') + return +end subroutine imline + +subroutine imcircle(x,y,radius,shade) + common/imcom/ lu,npage + write(lu,1000) shade +1000 format(f7.1,' setgray') + write(lu,1002) 72*x,72*y,72*radius +1002 format('newpath',3f7.1,' 0 360 arc fill') + write(lu,1000) 0.0 + write(lu,1004) 72*x,72*y,72*radius +1004 format('newpath',3f7.1,' 0 360 arc stroke') + return +end subroutine imcircle + +subroutine imtriangle(x,y,rr,shade) + common/imcom/ lu,npage + write(lu,1000) shade +1000 format(f7.1,' setgray') + write(lu,1002) 72*x,72*(y+rr) +1002 format('newpath',2f7.1,' moveto ') + write(lu,1004) 72*(x-rr),72*(y-rr) +1004 format(2f7.1,' lineto ') + write(lu,1004) 72*(x+rr),72*(y-rr) + write(lu,*) 'closepath fill 0 setgray' + write(lu,1002) 72*x,72*(y+rr) + write(lu,1004) 72*(x-rr),72*(y-rr) + write(lu,1004) 72*(x+rr),72*(y-rr) + write(lu,*) 'closepath stroke' + + return +end subroutine imtriangle + +subroutine imr4prov(p,jmax,xx1,xx2,x,y,dx,dy,nbox) + real p(jmax) + common/imcom/ lu,npage + + x1=xx1 + x2=xx2 + if(x1.eq.0.0 .and. x2.eq.0.0) then + x1=p(1) + x2=x1 + do j=1,jmax + x1=min(p(j),x1) + x2=max(p(j),x2) + enddo + endif + + xscale=72.0*dx + xoff=72.0*x + if(x1.ne.x2) xscale=xscale/(x2-x1) + + yscale=72.0*dy/jmax + yoff=72.0*y + + write(lu,*) '1.416 setmiterlimit' + write(lu,1002) xoff+xscale*(x2-p(1)),yoff+0.5*yscale +1002 format('newpath',2f7.1,' moveto') + + do j=2,jmax + write(lu,1004) xoff+xscale*(x2-p(j)),yoff+(j-0.5)*yscale +1004 format(2f6.1,' lt') + enddo + write(lu,*) 'stroke' + + if(nbox.ne.0) then + write(lu,1010) xoff,yoff,72.0*dx,72.0*dy,-72*dx +1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', & + f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke') + endif + + return +end subroutine imr4prov diff --git a/wsjtx_lib/lib/indexx.f90 b/wsjtx_lib/lib/indexx.f90 new file mode 100644 index 0000000..7a35f53 --- /dev/null +++ b/wsjtx_lib/lib/indexx.f90 @@ -0,0 +1,91 @@ +subroutine indexx(arr,n,indx) + + parameter (M=7,NSTACK=50) + integer n,indx(n) + real arr(n) + integer i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK) + real a + + do j=1,n + indx(j)=j + enddo + + jstack=0 + l=1 + ir=n +1 if(ir-l.lt.M) then + do j=l+1,ir + indxt=indx(j) + a=arr(indxt) + do i=j-1,1,-1 + if(arr(indx(i)).le.a) goto 2 + indx(i+1)=indx(i) + enddo + i=0 +2 indx(i+1)=indxt + enddo + if(jstack.eq.0) return + + ir=istack(jstack) + l=istack(jstack-1) + jstack=jstack-2 + + else + k=(l+ir)/2 + itemp=indx(k) + indx(k)=indx(l+1) + indx(l+1)=itemp + + if(arr(indx(l+1)).gt.arr(indx(ir))) then + itemp=indx(l+1) + indx(l+1)=indx(ir) + indx(ir)=itemp + endif + + if(arr(indx(l)).gt.arr(indx(ir))) then + itemp=indx(l) + indx(l)=indx(ir) + indx(ir)=itemp + endif + + if(arr(indx(l+1)).gt.arr(indx(l))) then + itemp=indx(l+1) + indx(l+1)=indx(l) + indx(l)=itemp + endif + + i=l+1 + j=ir + indxt=indx(l) + a=arr(indxt) +3 continue + i=i+1 + if(arr(indx(i)).lt.a) goto 3 + +4 continue + j=j-1 + if(arr(indx(j)).gt.a) goto 4 + if(j.lt.i) goto 5 + itemp=indx(i) + indx(i)=indx(j) + indx(j)=itemp + goto 3 + +5 indx(l)=indx(j) + indx(j)=indxt + jstack=jstack+2 + if(jstack.gt.NSTACK) stop 'NSTACK too small in indexx' + if(ir-i+1.ge.j-l)then + istack(jstack)=ir + istack(jstack-1)=i + ir=j-1 + else + istack(jstack)=j-1 + istack(jstack-1)=l + l=i + endif + endif + goto 1 + +end subroutine indexx + diff --git a/wsjtx_lib/lib/init_random_seed.c b/wsjtx_lib/lib/init_random_seed.c new file mode 100644 index 0000000..7e6ed88 --- /dev/null +++ b/wsjtx_lib/lib/init_random_seed.c @@ -0,0 +1,82 @@ +#include "init_random_seed.h" + +#include +#include +#include +#include +#include +#include + +/* basic PRNG to use for improving the basic seed selection */ +static unsigned lcg (uint64_t seed) +{ + if (0 ==seed) + { + seed = UINT64_C(104729); + } + else + { + seed %= UINT64_C(4294967296); + } + seed = (seed * UINT64_C(279470273)) % UINT64_C(4294967291); + return seed % UINT64_MAX; +} + +/* Generate a good PRNG seed value */ +void init_random_seed(void) +{ + unsigned seed = 0u; + int have_seed = 0; + + // try /dev/urandom for an initial seed + int random_source; + if ((random_source = open ("/dev/urandom", O_RDONLY)) >= 0) + { + size_t random_data_length = 0; + have_seed = -1; + while (random_data_length < sizeof seed) + { + ssize_t result = read (random_source, &seed + random_data_length, (sizeof seed) - random_data_length); + if (result < 0) + { + // error, unable to read /dev/random + have_seed = 0; + } + random_data_length += result; + } + close (random_source); + } + if (!have_seed) + { + // fallback to combining the time and PID in a fairly random way + pid_t pid = getpid (); + struct timeval tv; + gettimeofday (&tv, NULL); + seed = (unsigned)(((unsigned)pid << 16) + ^ (unsigned)pid + ^ (unsigned)tv.tv_sec + ^ (unsigned)tv.tv_usec); + seed = lcg (seed); + } + srand (seed); +} + +#ifdef TEST +#include + +int main (int argc, char * argv[]) +{ + init_random_seed (); + int i, j; + int r[10][4]; + for (i = 0; i < 10; ++i) + { + for (j = 0; j < 4; ++j) + { + printf ("%10d ", rand ()); + } + printf ("\n"); + } + return 0; +} +#endif diff --git a/wsjtx_lib/lib/init_random_seed.f90 b/wsjtx_lib/lib/init_random_seed.f90 new file mode 100644 index 0000000..7d85f9d --- /dev/null +++ b/wsjtx_lib/lib/init_random_seed.f90 @@ -0,0 +1,55 @@ +! +! Generate a seed for the RANDOM_NUMBER PRNG that is guaranteed to be +! unique even if many processes are started simultaneously +! +subroutine init_random_seed() + use iso_fortran_env, only: int64 + implicit none + integer, allocatable :: seed(:) + integer :: i, n, un, istat, dt(8), pid + integer(int64) :: t + + call random_seed(size = n) + allocate(seed(n)) + ! First try if the OS provides a random number generator + open(newunit=un, file="/dev/urandom", access="stream", & + form="unformatted", action="read", status="old", iostat=istat) + if (istat == 0) then + read(un) seed + close(un) + else + ! Fallback to XOR:ing the current time and pid. The PID is + ! useful in case one launches multiple instances of the same + ! program in parallel. + call system_clock(t) + if (t == 0) then + call date_and_time(values=dt) + t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 & + + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 & + + dt(3) * 24_int64 * 60 * 60 * 1000 & + + dt(5) * 60 * 60 * 1000 & + + dt(6) * 60 * 1000 + dt(7) * 1000 & + + dt(8) + end if + pid = getpid() + t = ieor(t, int(pid, kind(t))) + do i = 1, n + seed(i) = lcg(t) + end do + end if + call random_seed(put=seed) +contains + ! This simple PRNG might not be good enough for real work, but is + ! sufficient for seeding a better PRNG. + function lcg(s) + integer :: lcg + integer(int64) :: s + if (s == 0) then + s = 104729 + else + s = mod(s, 4294967296_int64) + end if + s = mod(s * 279470273_int64, 4294967291_int64) + lcg = int(mod(s, int(huge(0), int64)), kind(0)) + end function lcg +end subroutine init_random_seed diff --git a/wsjtx_lib/lib/init_random_seed.h b/wsjtx_lib/lib/init_random_seed.h new file mode 100644 index 0000000..0148033 --- /dev/null +++ b/wsjtx_lib/lib/init_random_seed.h @@ -0,0 +1,20 @@ +#ifndef INIT_RANDOM_SEED_H__ +#define INIT_RANDOM_SEED_H__ + +#ifdef __cplusplus +extern "C" { +#endif + + /* + * Generate a seed for the RANDOM_NUMBER PRNG that is guaranteed to + * be unique even if many processes are started simultaneously + * + * Not suitable for multi-threaded requirements + */ + void init_random_seed (void); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/wsjtx_lib/lib/init_rs.c b/wsjtx_lib/lib/init_rs.c new file mode 100644 index 0000000..11b01a5 --- /dev/null +++ b/wsjtx_lib/lib/init_rs.c @@ -0,0 +1,120 @@ +/* Initialize a RS codec + * + * Copyright 2002 Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ +#include + +#ifdef CCSDS +#include "ccsds.h" +#elif defined(BIGSYM) +#include "int.h" +#else +#include "char.h" +#endif + +void FREE_RS(void *p){ + struct rs *rs = (struct rs *)p; + + free(rs->alpha_to); + free(rs->index_of); + free(rs->genpoly); + free(rs); +} + +/* Initialize a Reed-Solomon codec + * symsize = symbol size, bits (1-8) + * gfpoly = Field generator polynomial coefficients + * fcr = first root of RS code generator polynomial, index form + * prim = primitive element to generate polynomial roots + * nroots = RS code generator polynomial degree (number of roots) + */ +void *init_rs_int(unsigned int symsize,unsigned int gfpoly,unsigned fcr,unsigned prim, + unsigned int nroots){ + struct rs *rs; + int i, j, sr,root,iprim; + + /* Check parameter ranges */ + if(symsize < 0 || symsize > (int)(8*sizeof(DTYPE))) + return NULL; /* Need version with ints rather than chars */ + + if(fcr >= (1<= (1<= (1<mm = symsize; + rs->nn = (1<alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1)); + if(rs->alpha_to == NULL){ + free(rs); + return NULL; + } + rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1)); + if(rs->index_of == NULL){ + free(rs->alpha_to); + free(rs); + return NULL; + } + + /* Generate Galois field lookup tables */ + rs->index_of[0] = A0; /* log(zero) = -inf */ + rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */ + sr = 1; + for(i=0;inn;i++){ + rs->index_of[sr] = i; + rs->alpha_to[i] = sr; + sr <<= 1; + if(sr & (1<nn; + } + if(sr != 1){ + /* field generator polynomial is not primitive! */ + free(rs->alpha_to); + free(rs->index_of); + free(rs); + return NULL; + } + + /* Form RS code generator polynomial from its roots */ + rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1)); + if(rs->genpoly == NULL){ + free(rs->alpha_to); + free(rs->index_of); + free(rs); + return NULL; + } + rs->fcr = fcr; + rs->prim = prim; + rs->nroots = nroots; + + /* Find prim-th root of 1, used in decoding */ + for(iprim=1;(iprim % prim) != 0;iprim += rs->nn) + ; + rs->iprim = iprim / prim; + + rs->genpoly[0] = 1; + for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) { + rs->genpoly[i+1] = 1; + + /* Multiply rs->genpoly[] by @**(root + x) */ + for (j = i; j > 0; j--){ + if (rs->genpoly[j] != 0) + rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)]; + else + rs->genpoly[j] = rs->genpoly[j-1]; + } + /* rs->genpoly[0] can never be zero */ + rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)]; + } + /* convert rs->genpoly[] to index form for quicker encoding */ + for (i = 0; i <= nroots; i++) + rs->genpoly[i] = rs->index_of[rs->genpoly[i]]; + + return rs; +} diff --git a/wsjtx_lib/lib/int.h b/wsjtx_lib/lib/int.h new file mode 100644 index 0000000..7137710 --- /dev/null +++ b/wsjtx_lib/lib/int.h @@ -0,0 +1,57 @@ +/* Include file to configure the RS codec for integer symbols + * + * Copyright 2002, Phil Karn, KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ +#define DTYPE int + +/* Reed-Solomon codec control block */ +struct rs { + int mm; /* Bits per symbol */ + int nn; /* Symbols per block (= (1<= rs->nn) { + x -= rs->nn; + x = (x >> rs->mm) + (x & rs->nn); + } + return x; +} +#define MODNN(x) modnn(rs,x) + +#define MM (rs->mm) +#define NN (rs->nn) +#define ALPHA_TO (rs->alpha_to) +#define INDEX_OF (rs->index_of) +#define GENPOLY (rs->genpoly) +//#define NROOTS (rs->nroots) +#define NROOTS (51) +#define FCR (rs->fcr) +#define PRIM (rs->prim) +#define IPRIM (rs->iprim) +#define PAD (rs->pad) +#define A0 (NN) + +#define ENCODE_RS encode_rs_int +#define DECODE_RS decode_rs_int +//#define INIT_RS init_rs_int +#define FREE_RS free_rs_int + +void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity); +int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras); +void *INIT_RS(int symsize,int gfpoly,int fcr, + int prim,int nroots,int pad); +void FREE_RS(void *p); + + + + diff --git a/wsjtx_lib/lib/inter_wspr.f90 b/wsjtx_lib/lib/inter_wspr.f90 new file mode 100644 index 0000000..9f98045 --- /dev/null +++ b/wsjtx_lib/lib/inter_wspr.f90 @@ -0,0 +1,45 @@ +subroutine inter_wspr(id,ndir) + +! Interleave (ndir=1) or de-interleave (ndir=-1) the array id. + + integer*1 id(0:161),itmp(0:161) + integer j0(0:161) + logical first + data first/.true./ + save + + if(first) then +! Compute the interleave table using bit reversal. + k=-1 + do i=0,255 + n=0 + ii=i + do j=0,7 + n=n+n + if(iand(ii,1).ne.0) n=n+1 + ii=ii/2 + enddo + if(n.le.161) then + k=k+1 + j0(k)=n + endif + enddo + first=.false. + endif + + if(ndir.eq.1) then + do i=0,161 + itmp(j0(i))=id(i) + enddo + else + do i=0,161 + itmp(i)=id(j0(i)) + enddo + endif + + do i=0,161 + id(i)=itmp(i) + enddo + + return +end subroutine inter_wspr diff --git a/wsjtx_lib/lib/interleave4.f90 b/wsjtx_lib/lib/interleave4.f90 new file mode 100644 index 0000000..db57ec3 --- /dev/null +++ b/wsjtx_lib/lib/interleave4.f90 @@ -0,0 +1,43 @@ +subroutine interleave4(id,ndir) + integer*1 id(0:205),itmp(0:205) + integer j0(0:205) + logical first + data first/.true./ + save first,j0 + + if(first) then + k=-1 + do i=0,255 + m=i + n=iand(m,1) + n=2*n + iand(m/2,1) + n=2*n + iand(m/4,1) + n=2*n + iand(m/8,1) + n=2*n + iand(m/16,1) + n=2*n + iand(m/32,1) + n=2*n + iand(m/64,1) + n=2*n + iand(m/128,1) + if(n.le.205) then + k=k+1 + j0(k)=n + endif + enddo + first=.false. + endif + + if(ndir.eq.1) then + do i=0,205 + itmp(j0(i))=id(i) + enddo + else + do i=0,205 + itmp(i)=id(j0(i)) + enddo + endif + + do i=0,205 + id(i)=itmp(i) + enddo + + return +end subroutine interleave4 diff --git a/wsjtx_lib/lib/interleave63.f90 b/wsjtx_lib/lib/interleave63.f90 new file mode 100644 index 0000000..a32ef34 --- /dev/null +++ b/wsjtx_lib/lib/interleave63.f90 @@ -0,0 +1,25 @@ +subroutine interleave63(d1,idir) + +! Interleave (idir=1) or de-interleave (idir=-1) the array d1. + + integer d1(0:6,0:8) + integer d2(0:8,0:6) + + if(idir.ge.0) then + do i=0,6 + do j=0,8 + d2(j,i)=d1(i,j) + enddo + enddo + call move(d2,d1,63) + else + call move(d1,d2,63) + do i=0,6 + do j=0,8 + d1(i,j)=d2(j,i) + enddo + enddo + endif + + return +end subroutine interleave63 diff --git a/wsjtx_lib/lib/interleave8.f90 b/wsjtx_lib/lib/interleave8.f90 new file mode 100644 index 0000000..c4da61e --- /dev/null +++ b/wsjtx_lib/lib/interleave8.f90 @@ -0,0 +1,17 @@ +subroutine interleave8(idat,jdat) + + integer idat(66),jdat(66) + integer ii(66),jj(66) + data ii/ & + 64,32,16,48, 8,40,24,56, 4,36,20,52,12,44,28,60, 2,66,34,18, & + 50,10,42,26,58, 6,38,22,54,14,46,30,62, 1,65,33,17,49, 9,41, & + 25,57, 5,37,21,53,13,45,29,61, 3,35,19,51,11,43,27,59, 7,39, & + 23,55,15,47,31,63/ + data jj/ & + 34,17,51, 9,43,26,59, 5,39,22,55,13,47,30,63, 3,37,20,53,11, & + 45,28,61, 7,41,24,57,15,49,32,65, 2,36,19,52,10,44,27,60, 6, & + 40,23,56,14,48,31,64, 4,38,21,54,12,46,29,62, 8,42,25,58,16, & + 50,33,66, 1,35,18/ + + return +end subroutine interleave8 diff --git a/wsjtx_lib/lib/interleave9.f90 b/wsjtx_lib/lib/interleave9.f90 new file mode 100644 index 0000000..06cfd2a --- /dev/null +++ b/wsjtx_lib/lib/interleave9.f90 @@ -0,0 +1,39 @@ +subroutine interleave9(ia,ndir,ib) + integer*1 ia(0:205),ib(0:205) + integer j0(0:205) + logical first + data first/.true./ + save first,j0 !Save not working, or j0 overwritten ??? + + if(first) then + k=-1 + do i=0,255 + m=i + n=iand(m,1) + n=2*n + iand(m/2,1) + n=2*n + iand(m/4,1) + n=2*n + iand(m/8,1) + n=2*n + iand(m/16,1) + n=2*n + iand(m/32,1) + n=2*n + iand(m/64,1) + n=2*n + iand(m/128,1) + if(n.le.205) then + k=k+1 + j0(k)=n + endif + enddo +! first=.false. + endif + + if(ndir.gt.0) then + do i=0,205 + ib(j0(i))=ia(i) + enddo + else + do i=0,205 + ib(i)=ia(j0(i)) + enddo + endif + + return +end subroutine interleave9 diff --git a/wsjtx_lib/lib/iso_c_utilities.f90 b/wsjtx_lib/lib/iso_c_utilities.f90 new file mode 100644 index 0000000..cdcc1a7 --- /dev/null +++ b/wsjtx_lib/lib/iso_c_utilities.f90 @@ -0,0 +1,87 @@ +module iso_c_utilities + + use, intrinsic :: iso_c_binding, only: c_ptr, c_char, c_f_pointer, c_associated + implicit none + + public :: c_to_f_string, c_f_dyn_string + + private + + character(c_char), dimension(1), save, target :: dummy_string = "?" + + interface ! strlen is a standard C function from + ! int strlen(char *string) + function strlen (string) result (len) bind (c, name="strlen") + use, intrinsic :: iso_c_binding, only: c_ptr, c_size_t + implicit none + type(c_ptr), value :: string + integer(kind=c_size_t) :: len + end function strlen + + ! void free(void * p) + subroutine c_free (p) bind (c, name="free") + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none + type(c_ptr), value :: p + end subroutine c_free + end interface + +contains + + ! + ! Cast C string pointer to Fortran string pointer + ! + ! Warning! - C data must outlive result scope + ! + function c_to_f_string (c_str) result (f_str) + use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer, c_char + implicit none + type(c_ptr), intent(in) :: c_str + character(kind=c_char, len=:), pointer :: f_str + character(kind=c_char), pointer :: arr(:) + interface ! strlen is a standard C function from + ! int strlen(char *string) + function strlen (string) result (len) bind (c, name="strlen") + use, intrinsic :: iso_c_binding, only: c_ptr, c_size_t + implicit none + type(c_ptr), value :: string + integer(kind=c_size_t) :: len + end function strlen + end interface + call c_f_pointer (c_str, arr, [strlen (c_str)]) + call get_scalar_pointer (size (arr), arr, f_str) + end function c_to_f_string + + subroutine get_scalar_pointer (scalar_len, scalar, fptr) + ! Convert a null-terminated C string into a Fortran character pointer + use, intrinsic :: iso_c_binding, only: c_char + integer, intent(in) :: scalar_len + character(kind=c_char, len=scalar_len), intent(in), target :: scalar(1) + character(kind=c_char, len=:), pointer :: fptr + fptr => scalar(1) + end subroutine get_scalar_pointer + + function c_f_dyn_string (cptr) result (fstr) + ! Convert a null-terminated malloc'ed C string into a Fortran character array + type(c_ptr), intent(in) :: cptr ! The C address + character(kind=c_char), allocatable :: fstr(:) + character(kind=c_char), pointer :: fptr(:) + interface ! strlen is a standard C function from + ! void free(void * p) + subroutine c_free (p) bind (c, name="free") + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none + type(c_ptr), value :: p + end subroutine c_free + end interface + if (c_associated (cptr)) then + call c_f_pointer (fptr=fptr, cptr=cptr, shape=[strlen(cptr)]) + else + ! To avoid segfaults, associate FPTR with a dummy target: + fptr => dummy_string + end if + fstr = fptr + call c_free (cptr) + end function c_f_dyn_string + +end module diff --git a/wsjtx_lib/lib/jplsubs.f b/wsjtx_lib/lib/jplsubs.f new file mode 100644 index 0000000..542a2a7 --- /dev/null +++ b/wsjtx_lib/lib/jplsubs.f @@ -0,0 +1,900 @@ +C++++++++++++++++++++++++ +C + SUBROUTINE FSIZER1(NRECL,KSIZE,NRFILE,NAMFIL) +C +C++++++++++++++++++++++++ +C +C Version 1.0 uses the INQUIRE statement to find out the the record length +C of the direct access file before opening it. This procedure is non-standard, +C but seems to work for VAX machines. +C +C THE SUBROUTINE ALSO SETS THE VALUES OF NRECL, NRFILE, AND NAMFIL. + +C ***************************************************************** +C ***************************************************************** +C +C THE PARAMETERS NAMFIL, NRECL, AND NRFILE ARE TO BE SET BY THE USER +C +C ***************************************************************** + +C NAMFIL IS THE EXTERNAL NAME OF THE BINARY EPHEMERIS FILE + + CHARACTER*256 NAMFIL + +c NAMFIL='JPLEPH' + +C ***************************************************************** + +C NRECL=1 IF "RECL" IN THE OPEN STATEMENT IS THE RECORD LENGTH IN S.P. WORDS +C NRECL=4 IF "RECL" IN THE OPEN STATEMENT IS THE RECORD LENGTH IN BYTES +C (for a VAX, it is probably 1) +C + NRECL=4 + +C ***************************************************************** + +C NRFILE IS THE INTERNAL UNIT NUMBER USED FOR THE EPHEMERIS FILE + +c NRFILE=12 + +C ***************************************************************** + +C FIND THE RECORD SIZE USING THE INQUIRE STATEMENT + + +c IRECSZ=0 + + INQUIRE(FILE=NAMFIL,RECL=IRECSZ) + +C IF 'INQUIRE' DOES NOT WORK, USUALLY IRECSZ WILL BE LEFT AT 0 + + IF(IRECSZ .LE. 0) write(*,*) + . ' INQUIRE STATEMENT PROBABLY DID NOT WORK' + + KSIZE=IRECSZ/NRECL + if(nrfile.eq.-99) stop !silence compiler warning + + RETURN + + END +C++++++++++++++++++++++++ +C + SUBROUTINE FSIZER2(NRECL,KSIZE,NRFILE,NAMFIL) +C +C++++++++++++++++++++++++ +C THIS SUBROUTINE OPENS THE FILE, 'NAMFIL', WITH A PHONY RECORD LENGTH, READS +C THE FIRST RECORD, AND USES THE INFO TO COMPUTE KSIZE, THE NUMBER OF SINGLE +C PRECISION WORDS IN A RECORD. +C +C THE SUBROUTINE ALSO SETS THE VALUES OF NRECL, NRFILE, AND NAMFIL. + + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + + SAVE + + INTEGER OLDMAX + PARAMETER (OLDMAX = 400) + INTEGER NMAX + PARAMETER (NMAX = 1000) + CHARACTER*6 TTL(14,3),CNAM(NMAX) + CHARACTER*256 NAMFIL,jpleph_file_name + DIMENSION SS(3) + INTEGER IPT(3,13) + common/jplcom/jpleph_file_name + +C ***************************************************************** +C ***************************************************************** +C +C THE PARAMETERS NRECL, NRFILE, AND NAMFIL ARE TO BE SET BY THE USER +C +C ***************************************************************** + +C NRECL=1 IF "RECL" IN THE OPEN STATEMENT IS THE RECORD LENGTH IN S.P. WORDS +C NRECL=4 IF "RECL" IN THE OPEN STATEMENT IS THE RECORD LENGTH IN BYTES +C (for UNIX, it is probably 4) +C + NRECL=4 + +C NRFILE IS THE INTERNAL UNIT NUMBER USED FOR THE EPHEMERIS FILE + + NRFILE=12 + +C NAMFIL IS THE EXTERNAL NAME OF THE BINARY EPHEMERIS FILE + +! NAMFIL='JPLEPH' + NAMFIL=jpleph_file_name + +C ***************************************************************** +C ***************************************************************** + +C ** OPEN THE DIRECT-ACCESS FILE AND GET THE POINTERS IN ORDER TO +C ** DETERMINE THE SIZE OF THE EPHEMERIS RECORD + + MRECL=NRECL*1000 + + OPEN(NRFILE, + * FILE=NAMFIL, + * ACCESS='DIRECT', + * FORM='UNFORMATTED', + * RECL=MRECL, + * STATUS='OLD') + + READ(NRFILE,REC=1)TTL,(CNAM(K),K=1,OLDMAX),SS,NCON,AU,EMRAT, + & ((IPT(I,J),I=1,3),J=1,12),NUMDE,(IPT(I,13),I=1,3) + + CLOSE(NRFILE) + +C FIND THE NUMBER OF EPHEMERIS COEFFICIENTS FROM THE POINTERS + + KMX = 0 + KHI = 0 + + DO I = 1,13 + IF (IPT(1,I) .GT. KMX) THEN + KMX = IPT(1,I) + KHI = I + ENDIF + ENDDO + + ND = 3 + IF (KHI .EQ. 12) ND=2 + + KSIZE = 2*(IPT(1,KHI)+ND*IPT(2,KHI)*IPT(3,KHI)-1) + + RETURN + + END +C++++++++++++++++++++++++ +C + SUBROUTINE FSIZER3(NRECL,KSIZE,NRFILE,NAMFIL) +C +C++++++++++++++++++++++++ +C +C THE SUBROUTINE SETS THE VALUES OF NRECL, KSIZE, NRFILE, AND NAMFIL. + + SAVE + CHARACTER*256 NAMFIL,jpleph_file_name + common/jplcom/jpleph_file_name + +C ***************************************************************** +C ***************************************************************** +C +C THE PARAMETERS NRECL, NRFILE, AND NAMFIL ARE TO BE SET BY THE USER + +C ***************************************************************** + +C NRECL=1 IF "RECL" IN THE OPEN STATEMENT IS THE RECORD LENGTH IN S.P. WORDS +C NRECL=4 IF "RECL" IN THE OPEN STATEMENT IS THE RECORD LENGTH IN BYTES + + NRECL=4 + +C ***************************************************************** + +C NRFILE IS THE INTERNAL UNIT NUMBER USED FOR THE EPHEMERIS FILE (DEFAULT: 12) + + NRFILE=12 + +C ***************************************************************** + +C NAMFIL IS THE EXTERNAL NAME OF THE BINARY EPHEMERIS FILE + +! NAMFIL='JPLEPH' + NAMFIL=jpleph_file_name + +C ***************************************************************** + +C KSIZE must be set by the user according to the ephemeris to be read + +C For de200, set KSIZE to 1652 +C For de405, set KSIZE to 2036 +C For de406, set KSIZE to 1456 +C For de414, set KSIZE to 2036 +C For de418, set KSIZE to 2036 +C For de421, set KSIZE to 2036 +C For de422, set KSIZE to 2036 +C For de423, set KSIZE to 2036 +C For de424, set KSIZE to 2036 +C For de430, set KSIZE to 2036 + + KSIZE = 2036 + +C ******************************************************************* + + RETURN + + END +C++++++++++++++++++++++++++ +C + SUBROUTINE PLEPH ( ET, NTARG, NCENT, RRD ) +C +C++++++++++++++++++++++++++ +C NOTE : Over the years, different versions of PLEPH have had a fifth argument: +C sometimes, an error return statement number; sometimes, a logical denoting +C whether or not the requested date is covered by the ephemeris. We apologize +C for this inconsistency; in this present version, we use only the four necessary +C arguments and do the testing outside of the subroutine. +C +C THIS SUBROUTINE READS THE JPL PLANETARY EPHEMERIS +C AND GIVES THE POSITION AND VELOCITY OF THE POINT 'NTARG' +C WITH RESPECT TO 'NCENT'. +C +C CALLING SEQUENCE PARAMETERS: +C +C ET = D.P. JULIAN EPHEMERIS DATE AT WHICH INTERPOLATION +C IS WANTED. +C +C ** NOTE THE ENTRY DPLEPH FOR A DOUBLY-DIMENSIONED TIME ** +C THE REASON FOR THIS OPTION IS DISCUSSED IN THE +C SUBROUTINE STATE +C +C NTARG = INTEGER NUMBER OF 'TARGET' POINT. +C +C NCENT = INTEGER NUMBER OF CENTER POINT. +C +C THE NUMBERING CONVENTION FOR 'NTARG' AND 'NCENT' IS: +C +C 1 = MERCURY 8 = NEPTUNE +C 2 = VENUS 9 = PLUTO +C 3 = EARTH 10 = MOON +C 4 = MARS 11 = SUN +C 5 = JUPITER 12 = SOLAR-SYSTEM BARYCENTER +C 6 = SATURN 13 = EARTH-MOON BARYCENTER +C 7 = URANUS 14 = NUTATIONS (LONGITUDE AND OBLIQ) +C 15 = LIBRATIONS, IF ON EPH FILE +C +C (IF NUTATIONS ARE WANTED, SET NTARG = 14. FOR LIBRATIONS, +C SET NTARG = 15. SET NCENT=0.) +C +C RRD = OUTPUT 6-WORD D.P. ARRAY CONTAINING POSITION AND VELOCITY +C OF POINT 'NTARG' RELATIVE TO 'NCENT'. THE UNITS ARE AU AND +C AU/DAY. FOR LIBRATIONS THE UNITS ARE RADIANS AND RADIANS +C PER DAY. IN THE CASE OF NUTATIONS THE FIRST FOUR WORDS OF +C RRD WILL BE SET TO NUTATIONS AND RATES, HAVING UNITS OF +C RADIANS AND RADIANS/DAY. +C +C The option is available to have the units in km and km/sec. +C For this, set km=.true. in the STCOMX common block. +C + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + INTEGER NMAX + PARAMETER (NMAX = 1000) + + DIMENSION RRD(6),ET2Z(2),ET2(2),PV(6,13) + DIMENSION PVST(6,11),PNUT(4) + DIMENSION SS(3),CVAL(NMAX),PVSUN(6),ZIPS(2) + DATA ZIPS/2*0.d0/ + + LOGICAL BSAVE,KM,BARY + LOGICAL FIRST + DATA FIRST/.TRUE./ + + INTEGER LIST(12),IPT(39),DENUM + COMMON/EPHHDR/CVAL,SS,AU,EMRAT,DENUM,NCON,IPT + COMMON/STCOMX/KM,BARY,PVSUN + +C INITIALIZE ET2 FOR 'STATE' AND SET UP COMPONENT COUNT +C + ET2(1)=ET + ET2(2)=0.D0 + GO TO 11 + +C ENTRY POINT 'DPLEPH' FOR DOUBLY-DIMENSIONED TIME ARGUMENT +C (SEE THE DISCUSSION IN THE SUBROUTINE STATE) + + ENTRY DPLEPH(ET2Z,NTARG,NCENT,RRD) + + ET2(1)=ET2Z(1) + ET2(2)=ET2Z(2) + + 11 IF(FIRST) CALL STATE(ZIPS,LIST,PVST,PNUT) + FIRST=.FALSE. + + IF(NTARG .EQ. NCENT) RETURN + + DO I=1,12 + LIST(I)=0 + ENDDO + +C CHECK FOR NUTATION CALL + + IF(NTARG.NE.14) GO TO 97 + IF(IPT(35).GT.0) THEN + LIST(11)=2 + CALL STATE(ET2,LIST,PVST,PNUT) + DO I=1,4 + RRD(I)=PNUT(I) + ENDDO + RRD(5) = 0.d0 + RRD(6) = 0.d0 + RETURN + ELSE + DO I=1,4 + RRD(I)=0.d0 + ENDDO + WRITE(6,297) + 297 FORMAT(' ***** NO NUTATIONS ON THE EPHEMERIS FILE *****') + STOP + ENDIF + +C CHECK FOR LIBRATIONS + + 97 CONTINUE + DO I=1,6 + RRD(I)=0.d0 + ENDDO + + IF(NTARG.NE.15) GO TO 98 + IF(IPT(38).GT.0) THEN + LIST(12)=2 + CALL STATE(ET2,LIST,PVST,PNUT) + DO I=1,6 + RRD(I)=PVST(I,11) + ENDDO + RETURN + ELSE + WRITE(6,298) + 298 FORMAT(' ***** NO LIBRATIONS ON THE EPHEMERIS FILE *****') + STOP + ENDIF + +C FORCE BARYCENTRIC OUTPUT BY 'STATE' + + 98 BSAVE=BARY + BARY=.TRUE. + +C SET UP PROPER ENTRIES IN 'LIST' ARRAY FOR STATE CALL + + DO I=1,2 + K=NTARG + IF(I .EQ. 2) K=NCENT + IF(K .LE. 10) LIST(K)=2 + IF(K .EQ. 10) LIST(3)=2 + IF(K .EQ. 3) LIST(10)=2 + IF(K .EQ. 13) LIST(3)=2 + ENDDO + +C MAKE CALL TO STATE + + CALL STATE(ET2,LIST,PVST,PNUT) + + DO I=1,10 + DO J = 1,6 + PV(J,I) = PVST(J,I) + ENDDO + ENDDO + + IF(NTARG .EQ. 11 .OR. NCENT .EQ. 11) THEN + DO I=1,6 + PV(I,11)=PVSUN(I) + ENDDO + ENDIF + + IF(NTARG .EQ. 12 .OR. NCENT .EQ. 12) THEN + DO I=1,6 + PV(I,12)=0.D0 + ENDDO + ENDIF + + IF(NTARG .EQ. 13 .OR. NCENT .EQ. 13) THEN + DO I=1,6 + PV(I,13) = PVST(I,3) + ENDDO + ENDIF + + IF(NTARG*NCENT .EQ. 30 .AND. NTARG+NCENT .EQ. 13) THEN + DO I=1,6 + PV(I,3)=0.D0 + ENDDO + GO TO 99 + ENDIF + + IF(LIST(3) .EQ. 2) THEN + DO I=1,6 + PV(I,3)=PVST(I,3)-PVST(I,10)/(1.D0+EMRAT) + ENDDO + ENDIF + + IF(LIST(10) .EQ. 2) THEN + DO I=1,6 + PV(I,10) = PV(I,3)+PVST(I,10) + ENDDO + ENDIF + + 99 DO I=1,6 + RRD(I)=PV(I,NTARG)-PV(I,NCENT) + ENDDO + + BARY=BSAVE + + RETURN + END +C+++++++++++++++++++++++++++++++++ +C + SUBROUTINE INTERP(BUF,T,NCF,NCM,NA,IFL,PV) +C +C+++++++++++++++++++++++++++++++++ +C +C THIS SUBROUTINE DIFFERENTIATES AND INTERPOLATES A +C SET OF CHEBYSHEV COEFFICIENTS TO GIVE POSITION AND VELOCITY +C +C CALLING SEQUENCE PARAMETERS: +C +C INPUT: +C +C BUF 1ST LOCATION OF ARRAY OF D.P. CHEBYSHEV COEFFICIENTS OF POSITION +C +C T T(1) IS DP FRACTIONAL TIME IN INTERVAL COVERED BY +C COEFFICIENTS AT WHICH INTERPOLATION IS WANTED +C (0 .LE. T(1) .LE. 1). T(2) IS DP LENGTH OF WHOLE +C INTERVAL IN INPUT TIME UNITS. +C +C NCF # OF COEFFICIENTS PER COMPONENT +C +C NCM # OF COMPONENTS PER SET OF COEFFICIENTS +C +C NA # OF SETS OF COEFFICIENTS IN FULL ARRAY +C (I.E., # OF SUB-INTERVALS IN FULL INTERVAL) +C +C IFL INTEGER FLAG: =1 FOR POSITIONS ONLY +C =2 FOR POS AND VEL +C +C +C OUTPUT: +C +C PV INTERPOLATED QUANTITIES REQUESTED. DIMENSION +C EXPECTED IS PV(NCM,IFL), DP. +C +C + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +C + SAVE +C + DOUBLE PRECISION BUF(NCF,NCM,*),T(2),PV(NCM,*),PC(18),VC(18) + +C + DATA NP/2/ + DATA NV/3/ + DATA TWOT/0.D0/ + DATA PC(1),PC(2)/1.D0,0.D0/ + DATA VC(2)/1.D0/ +C +C ENTRY POINT. GET CORRECT SUB-INTERVAL NUMBER FOR THIS SET +C OF COEFFICIENTS AND THEN GET NORMALIZED CHEBYSHEV TIME +C WITHIN THAT SUBINTERVAL. +C + DNA=DBLE(NA) + DT1=DINT(T(1)) + TEMP=DNA*T(1) + L=IDINT(TEMP-DT1)+1 + +C TC IS THE NORMALIZED CHEBYSHEV TIME (-1 .LE. TC .LE. 1) + + TC=2.D0*(DMOD(TEMP,1.D0)+DT1)-1.D0 + +C CHECK TO SEE WHETHER CHEBYSHEV TIME HAS CHANGED, +C AND COMPUTE NEW POLYNOMIAL VALUES IF IT HAS. +C (THE ELEMENT PC(2) IS THE VALUE OF T1(TC) AND HENCE +C CONTAINS THE VALUE OF TC ON THE PREVIOUS CALL.) + + IF(TC.NE.PC(2)) THEN + NP=2 + NV=3 + PC(2)=TC + TWOT=TC+TC + ENDIF +C +C BE SURE THAT AT LEAST 'NCF' POLYNOMIALS HAVE BEEN EVALUATED +C AND ARE STORED IN THE ARRAY 'PC'. +C + IF(NP.LT.NCF) THEN + DO 1 I=NP+1,NCF + PC(I)=TWOT*PC(I-1)-PC(I-2) + 1 CONTINUE + NP=NCF + ENDIF +C +C INTERPOLATE TO GET POSITION FOR EACH COMPONENT +C + DO 2 I=1,NCM + PV(I,1)=0.D0 + DO 3 J=NCF,1,-1 + PV(I,1)=PV(I,1)+PC(J)*BUF(J,I,L) + 3 CONTINUE + 2 CONTINUE + IF(IFL.LE.1) RETURN +C +C IF VELOCITY INTERPOLATION IS WANTED, BE SURE ENOUGH +C DERIVATIVE POLYNOMIALS HAVE BEEN GENERATED AND STORED. +C + VFAC=(DNA+DNA)/T(2) + VC(3)=TWOT+TWOT + IF(NV.LT.NCF) THEN + DO 4 I=NV+1,NCF + VC(I)=TWOT*VC(I-1)+PC(I-1)+PC(I-1)-VC(I-2) + 4 CONTINUE + NV=NCF + ENDIF +C +C INTERPOLATE TO GET VELOCITY FOR EACH COMPONENT +C + DO 5 I=1,NCM + PV(I,2)=0.D0 + DO 6 J=NCF,2,-1 + PV(I,2)=PV(I,2)+VC(J)*BUF(J,I,L) + 6 CONTINUE + PV(I,2)=PV(I,2)*VFAC + 5 CONTINUE +C + RETURN +C + END + +C+++++++++++++++++++++++++ +C + SUBROUTINE SPLIT(TT,FR) +C +C+++++++++++++++++++++++++ +C +C THIS SUBROUTINE BREAKS A D.P. NUMBER INTO A D.P. INTEGER +C AND A D.P. FRACTIONAL PART. +C +C CALLING SEQUENCE PARAMETERS: +C +C TT = D.P. INPUT NUMBER +C +C FR = D.P. 2-WORD OUTPUT ARRAY. +C FR(1) CONTAINS INTEGER PART +C FR(2) CONTAINS FRACTIONAL PART +C +C FOR NEGATIVE INPUT NUMBERS, FR(1) CONTAINS THE NEXT +C MORE NEGATIVE INTEGER; FR(2) CONTAINS A POSITIVE FRACTION. +C +C CALLING SEQUENCE DECLARATIONS +C + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + DIMENSION FR(2) + +C MAIN ENTRY -- GET INTEGER AND FRACTIONAL PARTS + + FR(1)=DINT(TT) + FR(2)=TT-FR(1) + + IF(TT.GE.0.D0 .OR. FR(2).EQ.0.D0) RETURN + +C MAKE ADJUSTMENTS FOR NEGATIVE INPUT NUMBER + + FR(1)=FR(1)-1.D0 + FR(2)=FR(2)+1.D0 + + RETURN + + END + + +C++++++++++++++++++++++++++++++++ +C + SUBROUTINE STATE(ET2,LIST,PV,PNUT) +C +C++++++++++++++++++++++++++++++++ +C +C THIS SUBROUTINE READS AND INTERPOLATES THE JPL PLANETARY EPHEMERIS FILE +C +C CALLING SEQUENCE PARAMETERS: +C +C INPUT: +C +C ET2 DP 2-WORD JULIAN EPHEMERIS EPOCH AT WHICH INTERPOLATION +C IS WANTED. ANY COMBINATION OF ET2(1)+ET2(2) WHICH FALLS +C WITHIN THE TIME SPAN ON THE FILE IS A PERMISSIBLE EPOCH. +C +C A. FOR EASE IN PROGRAMMING, THE USER MAY PUT THE +C ENTIRE EPOCH IN ET2(1) AND SET ET2(2)=0. +C +C B. FOR MAXIMUM INTERPOLATION ACCURACY, SET ET2(1) = +C THE MOST RECENT MIDNIGHT AT OR BEFORE INTERPOLATION +C EPOCH AND SET ET2(2) = FRACTIONAL PART OF A DAY +C ELAPSED BETWEEN ET2(1) AND EPOCH. +C +C C. AS AN ALTERNATIVE, IT MAY PROVE CONVENIENT TO SET +C ET2(1) = SOME FIXED EPOCH, SUCH AS START OF INTEGRATION, +C AND ET2(2) = ELAPSED INTERVAL BETWEEN THEN AND EPOCH. +C +C LIST 12-WORD INTEGER ARRAY SPECIFYING WHAT INTERPOLATION +C IS WANTED FOR EACH OF THE BODIES ON THE FILE. +C +C LIST(I)=0, NO INTERPOLATION FOR BODY I +C =1, POSITION ONLY +C =2, POSITION AND VELOCITY +C +C THE DESIGNATION OF THE ASTRONOMICAL BODIES BY I IS: +C +C I = 1: MERCURY +C = 2: VENUS +C = 3: EARTH-MOON BARYCENTER +C = 4: MARS +C = 5: JUPITER +C = 6: SATURN +C = 7: URANUS +C = 8: NEPTUNE +C = 9: PLUTO +C =10: GEOCENTRIC MOON +C =11: NUTATIONS IN LONGITUDE AND OBLIQUITY +C =12: LUNAR LIBRATIONS (IF ON FILE) +C +C OUTPUT: +C +C PV DP 6 X 11 ARRAY THAT WILL CONTAIN REQUESTED INTERPOLATED +C QUANTITIES (OTHER THAN NUTATION, STOERD IN PNUT). +C THE BODY SPECIFIED BY LIST(I) WILL HAVE ITS +C STATE IN THE ARRAY STARTING AT PV(1,I). +C (ON ANY GIVEN CALL, ONLY THOSE WORDS IN 'PV' WHICH ARE +C AFFECTED BY THE FIRST 10 'LIST' ENTRIES, AND BY LIST(12) +C IF LIBRATIONS ARE ON THE FILE, ARE SET. +C THE REST OF THE 'PV' ARRAYIS UNTOUCHED.) +C THE ORDER OF COMPONENTS STARTING IN PV(1,I) IS: X,Y,Z,DX,DY,DZ. +C +C ALL OUTPUT VECTORS ARE REFERENCED TO THE EARTH MEAN +C EQUATOR AND EQUINOX OF J2000 IF THE DE NUMBER IS 200 OR +C GREATER; OF B1950 IF THE DE NUMBER IS LESS THAN 200. +C +C THE MOON STATE IS ALWAYS GEOCENTRIC; THE OTHER NINE STATES +C ARE EITHER HELIOCENTRIC OR SOLAR-SYSTEM BARYCENTRIC, +C DEPENDING ON THE SETTING OF COMMON FLAGS (SEE BELOW). +C +C LUNAR LIBRATIONS, IF ON FILE, ARE PUT INTO PV(K,11) IF +C LIST(12) IS 1 OR 2. +C +C NUT DP 4-WORD ARRAY THAT WILL CONTAIN NUTATIONS AND RATES, +C DEPENDING ON THE SETTING OF LIST(11). THE ORDER OF +C QUANTITIES IN NUT IS: +C +C D PSI (NUTATION IN LONGITUDE) +C D EPSILON (NUTATION IN OBLIQUITY) +C D PSI DOT +C D EPSILON DOT +C +C * STATEMENT # FOR ERROR RETURN, IN CASE OF EPOCH OUT OF +C RANGE OR I/O ERRORS. +C +C COMMON AREA STCOMX: +C +C KM LOGICAL FLAG DEFINING PHYSICAL UNITS OF THE OUTPUT +C STATES. KM = .TRUE., KM AND KM/SEC +C = .FALSE., AU AND AU/DAY +C DEFAULT VALUE = .FALSE. (KM DETERMINES TIME UNIT +C FOR NUTATIONS AND LIBRATIONS. ANGLE UNIT IS ALWAYS RADIANS.) +C +C BARY LOGICAL FLAG DEFINING OUTPUT CENTER. +C ONLY THE 9 PLANETS ARE AFFECTED. +C BARY = .TRUE. =\ CENTER IS SOLAR-SYSTEM BARYCENTER +C = .FALSE. =\ CENTER IS SUN +C DEFAULT VALUE = .FALSE. +C +C PVSUN DP 6-WORD ARRAY CONTAINING THE BARYCENTRIC POSITION AND +C VELOCITY OF THE SUN. +C +C + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + SAVE + + INTEGER OLDMAX + PARAMETER ( OLDMAX = 400) + INTEGER NMAX + PARAMETER ( NMAX = 1000) + + DIMENSION ET2(2),PV(6,11),PNUT(4),T(2),PJD(4),BUF(1500), + . SS(3),CVAL(NMAX),PVSUN(6) + + INTEGER LIST(12),IPT(3,13) + + LOGICAL FIRST + DATA FIRST/.TRUE./ + + CHARACTER*6 TTL(14,3),CNAM(NMAX) + CHARACTER*256 NAMFIL + EXTERNAL SPLIT + + LOGICAL KM,BARY + + COMMON/EPHHDR/CVAL,SS,AU,EMRAT,NUMDE,NCON,IPT + COMMON/CHRHDR/CNAM,TTL + COMMON/STCOMX/KM,BARY,PVSUN + +C +C ENTRY POINT - 1ST TIME IN, GET POINTER DATA, ETC., FROM EPH FILE +C + IF(FIRST) THEN + FIRST=.FALSE. + +C ************************************************************************ +C ************************************************************************ + +C THE USER MUST SELECT ONE OF THE FOLLOWING BY DELETING THE 'C' IN COLUMN 1 + +C ************************************************************************ + +C CALL FSIZER1(NRECL,KSIZE,NRFILE,NAMFIL) +C CALL FSIZER2(NRECL,KSIZE,NRFILE,NAMFIL) + CALL FSIZER3(NRECL,KSIZE,NRFILE,NAMFIL) + + IF(NRECL .EQ. 0) WRITE(*,*)' ***** FSIZER IS NOT WORKING *****' + +C ************************************************************************ +C ************************************************************************ + + IRECSZ=NRECL*KSIZE + NCOEFFS=KSIZE/2 + + OPEN(NRFILE, + * FILE=NAMFIL, + * ACCESS='DIRECT', + * FORM='UNFORMATTED', + * RECL=IRECSZ, + * STATUS='OLD') + + READ(NRFILE,REC=1)TTL,(CNAM(K),K=1,OLDMAX),SS,NCON,AU,EMRAT, + & ((IPT(I,J),I=1,3),J=1,12),NUMDE,(IPT(I,13),I=1,3) + & ,(CNAM(L),L=OLDMAX+1,NCON) + + IF(NCON .LE. OLDMAX)THEN + READ(NRFILE,REC=2)(CVAL(I),I=1,OLDMAX) + ELSE + READ(NRFILE,REC=2)(CVAL(I),I=1,NCON) + ENDIF + + NRL=0 + + ENDIF + +C ********** MAIN ENTRY POINT ********** + + IF(ET2(1) .EQ. 0.D0) RETURN + + S=ET2(1)-.5D0 + CALL SPLIT(S,PJD(1)) + CALL SPLIT(ET2(2),PJD(3)) + PJD(1)=PJD(1)+PJD(3)+.5D0 + PJD(2)=PJD(2)+PJD(4) + CALL SPLIT(PJD(2),PJD(3)) + PJD(1)=PJD(1)+PJD(3) + +C ERROR RETURN FOR EPOCH OUT OF RANGE + + IF(PJD(1)+PJD(4).LT.SS(1) .OR. PJD(1)+PJD(4).GT.SS(2)) GO TO 98 + +C CALCULATE RECORD # AND RELATIVE TIME IN INTERVAL + + NR=IDINT((PJD(1)-SS(1))/SS(3))+3 + IF(PJD(1).EQ.SS(2)) NR=NR-1 + + tmp1 = DBLE(NR-3)*SS(3) + SS(1) + tmp2 = PJD(1) - tmp1 + T(1) = (tmp2 + PJD(4))/SS(3) + +C READ CORRECT RECORD IF NOT IN CORE + + IF(NR.NE.NRL) THEN + NRL=NR + READ(NRFILE,REC=NR,ERR=99)(BUF(K),K=1,NCOEFFS) + ENDIF + + IF(KM) THEN + T(2)=SS(3)*86400.D0 + AUFAC=1.D0 + ELSE + T(2)=SS(3) + AUFAC=1.D0/AU + ENDIF + +C INTERPOLATE SSBARY SUN + + CALL INTERP(BUF(IPT(1,11)),T,IPT(2,11),3,IPT(3,11),2,PVSUN) + + DO I=1,6 + PVSUN(I)=PVSUN(I)*AUFAC + ENDDO + +C CHECK AND INTERPOLATE WHICHEVER BODIES ARE REQUESTED + + DO 4 I=1,10 + IF(LIST(I).EQ.0) GO TO 4 + + CALL INTERP(BUF(IPT(1,I)),T,IPT(2,I),3,IPT(3,I), + & LIST(I),PV(1,I)) + + DO J=1,6 + IF(I.LE.9 .AND. .NOT.BARY) THEN + PV(J,I)=PV(J,I)*AUFAC-PVSUN(J) + ELSE + PV(J,I)=PV(J,I)*AUFAC + ENDIF + ENDDO + + 4 CONTINUE + +C DO NUTATIONS IF REQUESTED (AND IF ON FILE) + + IF(LIST(11).GT.0 .AND. IPT(2,12).GT.0) + * CALL INTERP(BUF(IPT(1,12)),T,IPT(2,12),2,IPT(3,12), + * LIST(11),PNUT) + +C GET LIBRATIONS IF REQUESTED (AND IF ON FILE) + + IF(LIST(12).GT.0 .AND. IPT(2,13).GT.0) + * CALL INTERP(BUF(IPT(1,13)),T,IPT(2,13),3,IPT(3,13), + * LIST(12),PV(1,11)) + + RETURN + + 98 WRITE(*,198)ET2(1)+ET2(2),SS(1),SS(2) + 198 FORMAT(' *** Requested JED,',f12.2, + * ' not within ephemeris limits,',2f12.2,' ***') + + STOP + + 99 WRITE(*,'(2F12.2,A80)')ET2,'ERROR RETURN IN STATE' + + STOP + + END +C+++++++++++++++++++++++++++++ +C + SUBROUTINE CONST(NAM,VAL,SSS,N) +C +C+++++++++++++++++++++++++++++ +C +C THIS ENTRY OBTAINS THE CONSTANTS FROM THE EPHEMERIS FILE +C +C CALLING SEQEUNCE PARAMETERS (ALL OUTPUT): +C +C NAM = CHARACTER*6 ARRAY OF CONSTANT NAMES +C +C VAL = D.P. ARRAY OF VALUES OF CONSTANTS +C +C SSS = D.P. JD START, JD STOP, STEP OF EPHEMERIS +C +C N = INTEGER NUMBER OF ENTRIES IN 'NAM' AND 'VAL' ARRAYS +C + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + SAVE + + INTEGER NMAX + PARAMETER (NMAX = 1000) + + CHARACTER*6 NAM(*),TTL(14,3),CNAM(NMAX) + + DOUBLE PRECISION VAL(*),SSS(3),SS(3),CVAL(NMAX),ZIPS(2) + DOUBLE PRECISION PVST(6,11),PNUT(4) + DATA ZIPS/2*0.d0/ + + INTEGER IPT(3,13),DENUM,LIST(12) + logical first + data first/.true./ + + COMMON/EPHHDR/CVAL,SS,AU,EMRAT,DENUM,NCON,IPT + COMMON/CHRHDR/CNAM,TTL + +C CALL STATE TO INITIALIZE THE EPHEMERIS AND READ IN THE CONSTANTS + + IF(FIRST) CALL STATE(ZIPS,LIST,PVST,PNUT) + first=.false. + + N=NCON + + DO I=1,3 + SSS(I)=SS(I) + ENDDO + + DO I=1,N + NAM(I)=CNAM(I) + VAL(I)=CVAL(I) + ENDDO + + RETURN + + END diff --git a/wsjtx_lib/lib/jt4.f90 b/wsjtx_lib/lib/jt4.f90 new file mode 100644 index 0000000..2140725 --- /dev/null +++ b/wsjtx_lib/lib/jt4.f90 @@ -0,0 +1,26 @@ +module jt4 + parameter (MAXAVE=64) + integer iutc(MAXAVE) + integer nfsave(MAXAVE) + integer listutc(10) + real ppsave(207,7,MAXAVE) !Accumulated data for message averaging + real rsymbol(207,7) + real dtsave(MAXAVE) + real syncsave(MAXAVE) + real flipsave(MAXAVE) + real zz(1260,65,7) + + integer nsave,nlist,ich1,ich2 + integer nch(7) + integer npr(207) + data rsymbol/1449*0.0/ + data nch/1,2,4,9,18,36,72/ + data npr/ & + 0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, & + 0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, & + 1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, & + 0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, & + 0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, & + 0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, & + 1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/ +end module jt4 diff --git a/wsjtx_lib/lib/jt49sim.f90 b/wsjtx_lib/lib/jt49sim.f90 new file mode 100644 index 0000000..7da5b51 --- /dev/null +++ b/wsjtx_lib/lib/jt49sim.f90 @@ -0,0 +1,150 @@ +program jt49sim + +! Generate simulated data for testing JT4 and JT9 +! April 26, 2020: changed to Watterson channel simulator (K9AN) +! + use wavhdr + use packjt + use jt4 + parameter (NMAX=60*12000) ! = 648,000 + parameter (NFFT=10*65536,NH=NFFT/2) + type(hdr) h !Header for .wav file + integer*2 iwave(NMAX) !Generated waveform + integer*4 itone(206) !Channel symbols (values 0-8) + real*4 xnoise(NMAX) !Generated random noise + real*4 dat(NMAX) !Generated real data + complex cdat(NMAX) !Generated complex waveform + complex c0(NMAX) !Waveform multipled by fading realization + complex z + real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq,dnsps + character message*22,fname*11,csubmode*2,arg*12 + character msgsent*22 + + nargs=iargc() + if(nargs.ne. 8) then + print *, 'Usage: jt49sim "msg" nA-nE Nsigs fDop delay DT Nfiles SNR' + print *, 'Example: jt49sim "K1ABC W9XYZ EN37" 4G 10 0.2 1.0 0.0 1 0' + print *, 'Example: jt49sim "K1ABC W9XYZ EN37" 9A 1 0.0 0.0 0.0 1 -20' + print *, 'Use msg=@nnnn to generate a tone at nnnn Hz:' + print *, 'Example: jt49sim "@1500" 9A 1 10.0 0.0 0.0 1 -20' + print *, 'If Nsigs > 100, generate one signal with f0=Nsigs' + print *, 'Example: jt49sim "K1ABC W9XYZ EN37" 4F 1800 0.2 0.0 0.0 1 -20' + go to 999 + endif + call getarg(1,message) + call fmtmsg(message, iz) + call getarg(2,csubmode) + imode=ichar(csubmode(1:1)) - ichar('0') + nsubmode=ichar(csubmode(2:2)) - ichar('A') + if(imode.ne.4 .and. imode.ne.9) go to 999 + if(nsubmode.lt.0 .or. nsubmode.gt.7) go to 999 + call getarg(3,arg) + read(arg,*) nsigs + call getarg(4,arg) + read(arg,*) fspread + call getarg(5,arg) + read(arg,*) delay + call getarg(6,arg) + read(arg,*) xdt + call getarg(7,arg) + read(arg,*) nfiles + call getarg(8,arg) + read(arg,*) snrdb + + rms=100. + fsample=12000.d0 !Sample rate (Hz) + dt=1.d0/fsample !Sample interval (s) + twopi=8.d0*atan(1.d0) + h=default_header(12000,NMAX) + dfsig=2000.0/nsigs !Freq spacing between sigs in file (Hz) + ichk=0 + nsym=0 + dnsps=0. + baud=0. + sig=0. + + if(imode.eq.4) then + nsym=206 !Number of channel symbols (JT4) + dnsps=12000.d0/4.375d0 + baud=12000.d0/dnsps !Keying rate = 1.7361111111 + else if(imode.eq.9) then + nsym=85 !Number of channel symbols (JT9) + dnsps=6912.d0 !Samples per symbol + baud=12000.d0/dnsps !Keying rate = 1.736... + endif + NZ=nsym*dnsps + + write(*,1000) +1000 format('File Sig Freq Mode S/N DT fDop delay Message'/60('-')) + + do ifile=1,nfiles !Loop over requested number of files + write(fname,1002) ifile !Output filename +1002 format('000000_',i4.4) + open(10,file=fname//'.wav',access='stream',status='unknown') + xnoise=0. + cdat=0. + if(snrdb.lt.90) then + do i=1,NMAX + xnoise(i)=gran() !Generate gaussian noise + enddo + endif + + do isig=1,nsigs !Generate requested number of sigs + if(mod(nsigs,2).eq.0) f0=1500.0 + dfsig*(isig-0.5-nsigs/2) + if(mod(nsigs,2).eq.1) f0=1500.0 + dfsig*(isig-(nsigs+1)/2) + if(nsigs.eq.1) f0=1500.0 + if(nsigs.gt.100) f0=nsigs + xsnr=snrdb + if(snrdb.eq.0.0) xsnr=-20 - isig + + if(imode.eq.4) call gen4(message,ichk,msgsent,itone,itype) + if(imode.eq.9) call gen9(message,ichk,msgsent,itone,itype) + + bandwidth_ratio=2500.0/6000.0 + sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*xsnr) + if(xsnr.gt.90.0) sig=1.0 + write(*,1020) ifile,isig,f0,csubmode,xsnr,xdt,fspread,delay,message +1020 format(i4,i4,f10.3,2x,a2,2x,f5.1,f6.2,f6.1,1x,f6.1,2x,a22) + + phi=0.d0 + dphi=0.d0 + k=(xdt+1.0)*12000 !Start audio at t = xdt + 1.0 s + isym0=-99 + do i=1,NMAX !Add this signal into cdat() + isym=i/dnsps + 1 + if(isym.gt.nsym) exit + if(isym.ne.isym0) then + if(message(1:1).eq.'@') then + read(message(2:),*) freq + else + if(imode.eq.4) freq=f0 + itone(isym)*baud*nch(1+nsubmode) !JT4 + if(imode.eq.9) freq=f0 + itone(isym)*baud*(2**nsubmode) !JT9 + endif + dphi=twopi*freq*dt + isym0=isym + endif + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + z=cmplx(cos(xphi),sin(xphi)) + k=k+1 + if(k.ge.1) cdat(k)=cdat(k) + z + enddo + if(nsigs.gt.100) exit + enddo + + c0=cdat + if(fspread.ne.0 .or. delay.ne.0) then !Apply specified Doppler spread + fs=12000.0 + call watterson(c0,NMAX,NZ,fs,delay,fspread) + endif + + dat=sig*aimag(c0) + xnoise !Add the generated noise + fac=32767.0/nsigs + if(snrdb.ge.90.0) iwave(1:NMAX)=nint(fac*dat(1:NMAX)) + if(snrdb.lt.90.0) iwave(1:NMAX)=nint(rms*dat(1:NMAX)) + write(10) h,iwave(1:NMAX) !Save the .wav file + close(10) + enddo + +999 end program jt49sim diff --git a/wsjtx_lib/lib/jt4_decode.f90 b/wsjtx_lib/lib/jt4_decode.f90 new file mode 100644 index 0000000..0b82599 --- /dev/null +++ b/wsjtx_lib/lib/jt4_decode.f90 @@ -0,0 +1,412 @@ +module jt4_decode + type :: jt4_decoder + procedure(jt4_decode_callback), pointer :: decode_callback => null () + procedure(jt4_average_callback), pointer :: average_callback => null () + contains + procedure :: decode + procedure, private :: wsjt4, avg4 + end type jt4_decoder + +! Callback function to be called with each decode + abstract interface + subroutine jt4_decode_callback (this, snr, dt, freq, have_sync, & + sync, is_deep, decoded, qual, ich, is_average, ave) + import jt4_decoder + implicit none + class(jt4_decoder), intent(inout) :: this + integer, intent(in) :: snr + real, intent(in) :: dt + integer, intent(in) :: freq + logical, intent(in) :: have_sync + logical, intent(in) :: is_deep + character(len=1), intent(in) :: sync + character(len=22), intent(in) :: decoded + real, intent(in) :: qual + integer, intent(in) :: ich + logical, intent(in) :: is_average + integer, intent(in) :: ave + end subroutine jt4_decode_callback + end interface + +! Callback function to be called with each average result + abstract interface + subroutine jt4_average_callback (this, used, utc, sync, dt, freq, flip) + import jt4_decoder + implicit none + class(jt4_decoder), intent(inout) :: this + logical, intent(in) :: used + integer, intent(in) :: utc + real, intent(in) :: sync + real, intent(in) :: dt + integer, intent(in) :: freq + logical, intent(in) :: flip + end subroutine jt4_average_callback + end interface + +contains + + subroutine decode(this,decode_callback,dd,jz,nutc,nfqso,ntol0,emedelay, & + dttol,nagain,ndepth,nclearave,minsync,minw,nsubmode,mycall,hiscall, & + hisgrid,nlist0,listutc0,average_callback) + + use jt4 + use timer_module, only: timer + + class(jt4_decoder), intent(inout) :: this + procedure(jt4_decode_callback) :: decode_callback + integer, intent(in) :: jz,nutc,nfqso,ntol0,ndepth,minsync,minw,nsubmode, & + nlist0,listutc0(10) + real, intent(in) :: dd(jz),emedelay,dttol + logical, intent(in) :: nagain, nclearave + character(len=12), intent(in) :: mycall,hiscall + character(len=6), intent(in) :: hisgrid + procedure(jt4_average_callback), optional :: average_callback + + real*4 dat(30*11025) + character*6 cfile6 + + this%decode_callback => decode_callback + if (present (average_callback)) then + this%average_callback => average_callback + end if + mode4=nch(nsubmode+1) + ntol=ntol0 + neme=0 + lumsg=6 !### temp ? ### + ndiag=1 + nlist=nlist0 + listutc=listutc0 + + ! Lowpass filter and decimate by 2 + call timer('lpf1 ',0) + call lpf1(dd,jz,dat,jz2) + call timer('lpf1 ',1) + + write(cfile6(1:4),1000) nutc +1000 format(i4.4) + cfile6(5:6)=' ' + + call timer('wsjt4 ',0) + call this%wsjt4(dat,jz2,nutc,NClearAve,minsync,ntol,emedelay,dttol,mode4, & + minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme) + call timer('wsjt4 ',1) + + return + end subroutine decode + + subroutine wsjt4(this,dat,npts,nutc,NClearAve,minsync,ntol,emedelay,dttol, & + mode4,minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme) + +! Orchestrates the process of decoding JT4 messages. Note that JT4 +! always operates as if in "Single Decode" mode; it looks for only one +! decodable signal in the FTol range. + + use jt4 + use timer_module, only: timer + + class(jt4_decoder), intent(inout) :: this + integer, intent(in) :: npts,nutc,minsync,ntol,mode4,minw, & + nfqso,ndepth,neme + logical, intent(in) :: NAgain,NClearAve + character(len=12), intent(in) :: mycall,hiscall + character(len=6), intent(in) :: hisgrid + real, intent(in) :: dat(npts) !Raw data + logical first,prtavg + character decoded*22,special*5 + character*22 avemsg,deepmsg,deepave,blank,deepmsg0,deepave1 + character csync*1 + data first/.true./,nutc0/-999/,nfreq0/-999999/ + save + + if(first) then + nsave=0 + first=.false. + blank=' ' +! Silence compiler warnings + if(dttol.eq.-99.0 .and. emedelay.eq.-99.0 .and. nagain) stop + endif + + zz=0. +! syncmin=3.0 + minsync + syncmin=1.0+minsync + naggressive=0 + if(ndepth.ge.2) naggressive=1 + nq1=3 + nq2=6 + if(naggressive.eq.1) nq1=1 + if(NClearAve) then + nsave=0 + iutc=-1 + nfsave=0. + listutc=0 + ppsave=0. + rsymbol=0. + dtsave=0. + syncsave=0. + nfanoave=0 + ndeepave=0 + endif + +! Attempt to synchronize: look for sync pattern, get DF and DT. + call timer('sync4 ',0) + call sync4(dat,npts,ntol,nfqso,4,mode4,minw+1,dtx,dfx, & + snrx,snrsync,flip,width) + sync=snrsync + dtxz=dtx-0.8 + nfreqz=nint(dfx) + call timer('sync4 ',1) + + nsnr=-26 + if(sync.lt.syncmin) then + if (associated (this%decode_callback)) then + call this%decode_callback(nsnr,dtxz,nfreqz,.false.,csync, & + .false.,decoded,0.,ich,.false.,0) + end if + go to 990 + endif + +! We have achieved sync + nsnr=nint(snrsync - 22.9) + decoded=blank + deepmsg=blank + special=' ' + nsync=sync + nsnrlim=-33 + csync='*' + if(flip.lt.0.0) csync='#' + qbest=0. + qabest=0. + prtavg=.false. + + do idt=-2,2 + dtx=dtxz + 0.03*idt + nfreq=nfreqz + 2*idf + +! Attempt a single-sequence decode, including deep4 if Fano fails. + call timer('decode4 ',0) + call decode4(dat,npts,dtx,nfreq,flip,mode4,ndepth,neme,minw, & + mycall,hiscall,hisgrid,decoded,nfano,deepmsg,qual,ich) + call timer('decode4 ',1) + + if(nfano.gt.0) then +! Fano succeeded: report the message and return !Fano OK + if (associated (this%decode_callback)) then + call this%decode_callback(nsnr,dtx,nfreq,.true.,csync, & + .false.,decoded,99.,ich,.false.,0) + end if +!### nsave=0 + go to 990 + + else !Fano failed + if(qual.gt.qbest) then + dtx0=dtx + nfreq0=nfreq + deepmsg0=deepmsg + ich0=ich + qbest=qual + endif + endif + + if(idt.ne.0) cycle +! Single-sequence Fano decode failed, so try for an average Fano decode: + qave=0. +! If we're doing averaging, call avg4 + if(iand(ndepth,16).eq.16 .and. (.not.prtavg)) then + if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then +! This is a new minute or a new frequency, so call avg4. + nutc0=nutc !Try decoding average + nfreq0=nfreq + nsave=nsave+1 + nsave=mod(nsave-1,64)+1 + call timer('avg4 ',0) + call this%avg4(nutc,sync,dtx,flip,nfreq,mode4,ntol,ndepth,neme, & + mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ich, & + ndeepave) + call timer('avg4 ',1) + endif + + if(nfanoave.gt.0) then +! Fano succeeded: report the message AVG FANO OK + if (associated (this%decode_callback)) then + call this%decode_callback(nsnr,dtx,nfreq,.true.,csync, & + .false.,avemsg,99.,ich,.true.,nfanoave) + end if + prtavg=.true. + cycle + else + if(qave.gt.qabest) then + dtx1=dtx + nfreq1=nfreq + deepave1=deepave + ich1=ich + qabest=qave + endif + endif + endif + enddo + + dtx=dtx0 + nfreq=nfreq0 + deepmsg=deepmsg0 + ich=ich0 + qual=qbest + + if (associated (this%decode_callback)) then + if(int(qual).ge.nq1) then + call this%decode_callback(nsnr,dtx,nfreqz,.true.,csync,.true., & + deepmsg,qual,ich,.false.,0) + else + call this%decode_callback(nsnr,dtxz,nfreqz,.true.,csync, & + .false.,blank,0.,ich,.false.,0) + endif + end if + + dtx=dtx1 + nfreq=nfreq1 + deepave=deepave1 + ich=ich1 + qave=qabest + + if (associated (this%decode_callback) .and. ndeepave.ge.2) then + if(int(qave).ge.nq1) then + call this%decode_callback(nsnr,dtx,nfreq,.true.,csync,.true., & + deepave,qave,ich,.true.,ndeepave) + endif + end if + +990 return + end subroutine wsjt4 + + subroutine avg4(this,nutc,snrsync,dtxx,flip,nfreq,mode4,ntol,ndepth,neme, & + mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ichbest,ndeepave) + +! Decodes averaged JT4 data + + use jt4 + class(jt4_decoder), intent(inout) :: this + + character*22 avemsg,deepave,deepbest + character mycall*12,hiscall*12,hisgrid*6 + character*1 csync,cused(64) + real sym(207,7) + integer iused(64) + logical first + data first/.true./ + save + + if(first) then + iutc=-1 + nfsave=0 + dtdiff=0.2 + first=.false. + nsave=1 ! ### Should this be here? ### + endif + + do i=1,64 + if(nutc.eq.iutc(i) .and. abs(nfreq-nfsave(i)).le.ntol) go to 10 + enddo + +! Save data for message averaging + iutc(nsave)=nutc + syncsave(nsave)=snrsync + dtsave(nsave)=dtxx + nfsave(nsave)=nfreq + flipsave(nsave)=flip + ppsave(1:207,1:7,nsave)=rsymbol(1:207,1:7) + +10 sym=0. + syncsum=0. + dtsum=0. + nfsum=0 + nsum=0 + + do i=1,64 + cused(i)='.' + if(iutc(i).lt.0) cycle + if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same sequence + if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match + if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match + if(flip.ne.flipsave(i)) cycle !Sync (*/#) must match + sym(1:207,1:7)=sym(1:207,1:7) + ppsave(1:207,1:7,i) + syncsum=syncsum + syncsave(i) + dtsum=dtsum + dtsave(i) + nfsum=nfsum + nfsave(i) + cused(i)='$' + nsum=nsum+1 + iused(nsum)=i + enddo + if(nsum.lt.64) iused(nsum+1)=0 + + syncave=0. + dtave=0. + fave=0. + if(nsum.gt.0) then + sym=sym/nsum + syncave=syncsum/nsum + dtave=dtsum/nsum + fave=float(nfsum)/nsum + endif + + do i=1,nsave + csync='*' + if(flipsave(i).lt.0.0) csync='#' + if (associated (this%average_callback)) then + call this%average_callback(cused(i) .eq. '$',iutc(i), & + syncsave(i),dtsave(i),nfsave(i),flipsave(i).lt.0.) + end if + enddo + + sqt=0. + sqf=0. + do j=1,64 + i=iused(j) + if(i.eq.0) exit + csync='*' + if(flipsave(i).lt.0.0) csync='#' + sqt=sqt + (dtsave(i)-dtave)**2 + sqf=sqf + (nfsave(i)-fave)**2 + enddo + rmst=0. + rmsf=0. + if(nsum.ge.2) then + rmst=sqrt(sqt/(nsum-1)) + rmsf=sqrt(sqf/(nsum-1)) + endif + kbest=ich1 + do k=ich1,ich2 + call extract4(sym(1,k),ncount,avemsg) !Do the Fano decode + nfanoave=0 + if(ncount.ge.0) then + ichbest=k + nfanoave=nsum + go to 900 + endif + if(nch(k).ge.mode4) exit + enddo + + deepave=' ' + qave=0. + +! Possibly should pass nadd=nused, also ? + if(iand(ndepth,32).eq.32) then + flipx=1.0 !Normal flip not relevant for ave msg + qbest=0. + do k=ich1,ich2 + call deep4(sym(2,k),neme,flipx,mycall,hiscall,hisgrid,deepave,qave) + if(qave.gt.qbest) then + qbest=qave + deepbest=deepave + kbest=k + ndeepave=nsum + endif + if(nch(k).ge.mode4) exit + enddo + + deepave=deepbest + qave=qbest + ichbest=kbest + endif + +900 return + end subroutine avg4 +end module jt4_decode diff --git a/wsjtx_lib/lib/jt4a.f90 b/wsjtx_lib/lib/jt4a.f90 new file mode 100644 index 0000000..fc37ec0 --- /dev/null +++ b/wsjtx_lib/lib/jt4a.f90 @@ -0,0 +1,2 @@ + ! The contents of this file have been migrated to lib/jt4_decode.f90 + diff --git a/wsjtx_lib/lib/jt4code.f90 b/wsjtx_lib/lib/jt4code.f90 new file mode 100644 index 0000000..e11f614 --- /dev/null +++ b/wsjtx_lib/lib/jt4code.f90 @@ -0,0 +1,50 @@ +program jt4code + +! Provides examples of message packing, bit and symbol ordering, +! convolutional encoding, and other necessary details of the JT4 +! protocol. + + use jt4 + use packjt + character*22 msg,decoded,bad*1,msgtype*13 + integer i4tone(206) + include 'testmsg.f90' + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: jt4code "message"' + print*,' jt4code -t' + go to 999 + endif + + call getarg(1,msg) + nmsg=1 + if(msg(1:2).eq."-t") nmsg=NTEST + + write(*,1010) +1010 format(" Message Decoded Err? Type"/ & + 74("-")) + do imsg=1,nmsg + if(nmsg.gt.1) msg=testmsg(imsg) + call fmtmsg(msg,iz) !To upper case, collapse multiple blanks + ichk=0 + call gen4(msg,ichk,decoded,i4tone,itype) + + msgtype="" + if(itype.eq.1) msgtype="Std Msg" + if(itype.eq.2) msgtype="Type 1 prefix" + if(itype.eq.3) msgtype="Type 1 suffix" + if(itype.eq.4) msgtype="Type 2 prefix" + if(itype.eq.5) msgtype="Type 2 suffix" + if(itype.eq.6) msgtype="Free text" + + bad=" " + if(decoded.ne.msg) bad="*" + write(*,1020) imsg,msg,decoded,bad,itype,msgtype +1020 format(i2,'.',2x,a22,2x,a22,3x,a1,i3,": ",a13) + enddo + + if(nmsg.eq.1) write(*,1030) i4tone +1030 format(/'Channel symbols'/(30i2)) + +999 end program jt4code diff --git a/wsjtx_lib/lib/jt4sim.f90 b/wsjtx_lib/lib/jt4sim.f90 new file mode 100644 index 0000000..73edabf --- /dev/null +++ b/wsjtx_lib/lib/jt4sim.f90 @@ -0,0 +1,181 @@ +program jt4sim + +! Generate simulated jt4 data for testing the decoder using new fading models +! Based on qra64sim with appropriate changes for JT4 +! Includes option to generate 1000Hz single tone with "ST" as the message + + use wavhdr + use packjt + use jt4 + parameter (NMAX=60*12000) ! = 648,000 + parameter (NFFT=10*65536,NH=NFFT/2) + type(hdr) h !Header for .wav file + integer*2 iwave(NMAX) !Generated waveform + integer*4 itone(206) !Channel symbols (values 0-8) + real*4 xnoise(NMAX) !Generated random noise + real*4 dat(NMAX) !Generated real data + complex cdat(NMAX) !Generated complex waveform + complex cspread(0:NFFT-1) !Complex amplitude for Rayleigh fading + complex z + real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq + character message*22,fname*11,csubmode*1,arg*12 + character msgsent*22 + + nargs=iargc() + if(nargs.ne. 7) then + print *, 'Usage: jt4sim "msg" A-E Nsigs fDop DT Nfiles SNR' + print *, 'Example jt4sim "K1ABC W9XYZ EN37" A 10 0.2 0.0 1 0' + print *, 'Example jt4sim "ST" A 10 0.2 0.0 1 0' + go to 999 + endif + call getarg(1,message) + call fmtmsg(message, iz) + call getarg(2,csubmode) + mode4=ichar(csubmode) - ichar('A') + 1 + call getarg(3,arg) + read(arg,*) nsigs + call getarg(4,arg) + read(arg,*) fspread + call getarg(5,arg) + read(arg,*) xdt + call getarg(6,arg) + read(arg,*) nfiles + call getarg(7,arg) + read(arg,*) snrdb + + if(mode4.ge.8) nsigs=1 ! temporary - will need sorting out + rms=100. + fsample=12000.d0 !Sample rate (Hz) + dt=1.d0/fsample !Sample interval (s) + twopi=8.d0*atan(1.d0) + npts=60*12000 !Total samples in .wav file + nsps=12000.d0/4.375d0 + baud=12000.d0/nsps !Keying rate = 1.7361111111 + nsym=206 !Number of channel symbols + h=default_header(12000,npts) + dfsig=2000.0/nsigs !Freq spacing between sigs in file (Hz) + ichk=0 + + write(*,1000) +1000 format('File Sig Freq A-E S/N DT Dop Message'/60('-')) + + do ifile=1,nfiles !Loop over requested number of files + write(fname,1002) ifile !Output filename +1002 format('000000_',i4.4) + open(10,file=fname//'.wav',access='stream',status='unknown') + xnoise=0. + cdat=0. + if(snrdb.lt.90) then + do i=1,npts + xnoise(i)=gran() !Generate gaussian noise + enddo + endif + + do isig=1,nsigs !Generate requested number of sigs + if(mod(nsigs,2).eq.0) f0=1500.0 + dfsig*(isig-0.5-nsigs/2) + if(mod(nsigs,2).eq.1) f0=1500.0 + dfsig*(isig-(nsigs+1)/2) + if(nsigs.eq.1) f0=1000.0 + xsnr=snrdb + if(snrdb.eq.0.0) xsnr=-20 - isig + + call gen4(message,ichk,msgsent,itone,itype) + + bandwidth_ratio=2500.0/6000.0 + sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*xsnr) + if(xsnr.gt.90.0) sig=1.0 + write(*,1020) ifile,isig,f0,csubmode,xsnr,xdt,fspread,message +1020 format(i4,i4,f10.3,2x,a1,2x,f5.1,f6.2,f6.1,1x,a22) + + phi=0.d0 + dphi=0.d0 + k=(xdt+1.0)*12000 !Start audio at t = xdt + 1.0 s + isym0=-99 + + do i=1,npts !Add this signal into cdat() + isym=i/nsps + 1 + if(isym.gt.nsym) exit + if(isym.ne.isym0) then + if(message(1:2).eq.'ST') then !Finds ST in message string for single tone + freq=1000 !1000Hz for single tone + else + freq=f0 + itone(isym)*baud*nch(mode4) + endif + dphi=twopi*freq*dt + isym0=isym + + endif + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + z=cmplx(cos(xphi),sin(xphi)) + k=k+1 + if(k.ge.1) cdat(k)=cdat(k) + sig*z + enddo + enddo + + if(fspread.ne.0) then !Apply specified Doppler spread + 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 + + do i=0,NFFT-1 + f=i*df + if(i.gt.NH) f=(i-nfft)*df + s=real(cspread(i))**2 + aimag(cspread(i))**2 +! write(13,3000) i,f,s,cspread(i) +!3000 format(i5,f10.3,3f12.6) + enddo +! s=real(cspread(0))**2 + aimag(cspread(0))**2 +! write(13,3000) 1024,0.0,s,cspread(0) + + 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 + cdat(1:NFFT)=cspread*cdat(1:NFFT) !Apply Rayleigh fading + +! do i=0,NFFT-1 +! p=real(cspread(i))**2 + aimag(cspread(i))**2 +! write(14,3010) i,p,cspread(i) +!3010 format(i8,3f12.6) +! enddo + + endif + + dat=aimag(cdat) + xnoise !Add the generated noise + fac=32767.0/nsigs + if(snrdb.ge.90.0) iwave(1:npts)=nint(fac*dat(1:npts)) + if(snrdb.lt.90.0) iwave(1:npts)=nint(rms*dat(1:npts)) + write(10) h,iwave(1:npts) !Save the .wav file + close(10) + enddo + +999 end program jt4sim diff --git a/wsjtx_lib/lib/jt65.f90 b/wsjtx_lib/lib/jt65.f90 new file mode 100644 index 0000000..bce3a4f --- /dev/null +++ b/wsjtx_lib/lib/jt65.f90 @@ -0,0 +1,143 @@ +program jt65 + + ! Test the JT65 decoder for WSJT-X + + use options + use timer_module, only: timer + use timer_impl, only: init_timer + use jt65_test + use readwav + + character c,mode + logical :: display_help=.false.,nrobust=.false.,single_decode=.false., ljt65apon=.false. + type(wav_header) :: wav + integer*2 id2(NZMAX) + real*4 dd(NZMAX) + character*80 infile + character(len=500) optarg + character*12 mycall,hiscall + character*6 hisgrid + + type (option) :: long_options(12) = [ & + option ('aggressive',.true.,'a','aggressiveness [0-10], default AGGR=0','AGGR'), & + option ('depth',.true.,'d','depth=5 hinted decoding, default DEPTH=0','DEPTH'), & + option ('freq',.true.,'f','signal frequency, default FREQ=1270','FREQ'), & + option ('help',.false.,'h','Display this help message',''), & + option ('mode',.true.,'m','Mode A, B, C. Default is A.','MODE'), & + option ('ntrials',.true.,'n','number of trials, default TRIALS=10000','TRIALS'), & + option ('robust-sync',.false.,'r','robust sync',''), & + option ('my-call',.true.,'c','my callsign',''), & + option ('his-call',.true.,'x','his callsign',''), & + option ('his-grid',.true.,'g','his grid locator',''), & + option ('experience-decoding',.true.,'X' & + ,'experience decoding options (1..n), default FLAGS=0','FLAGS'), & + option ('single-signal-mode',.false.,'s','decode at signal frequency only','') ] + + naggressive=10 + nfqso=1500 + ntrials=100000 + nexp_decode=0 + ntol=20 + nsubmode=0 + nlow=200 + nhigh=4000 + n2pass=1 + ndepth=1 + nQSOProgress=6 + + do + call getopt('a:d:f:hm:n:rc:x:g:X:s',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.) + if( nstat .ne. 0 ) then + exit + end if + select case (c) + case ('a') + read (optarg(:narglen), *) naggressive + case ('d') + read (optarg(:narglen), *) ndepth + case ('f') + read (optarg(:narglen), *) nfqso + case ('h') + display_help = .true. + case ('m') + read (optarg(:narglen), *) mode + if( mode .eq. 'b' .or. mode .eq. 'B' ) then + nsubmode=1 + endif + if( mode .eq. 'c' .or. mode .eq. 'C' ) then + nsubmode=2 + endif + case ('n') + read (optarg(:narglen), *) ntrials + case ('r') + nrobust=.true. + case ('c') + read (optarg(:narglen), *) mycall + case ('x') + read (optarg(:narglen), *) hiscall + case ('g') + read (optarg(:narglen), *) hisgrid + case ('X') + read (optarg(:narglen), *) nexp_decode + case ('s') + single_decode=.true. + ntol=100 + nlow=nfqso-ntol + nhigh=nfqso+ntol + n2pass=1 + end select + end do + + if(single_decode) nexp_decode=ior(nexp_decode,32) + if(display_help .or. nstat.lt.0 .or. nremain.lt.1) then + print *, '' + print *, 'Usage: jt65 [OPTIONS] file1 [file2 ...]' + print *, '' + print *, ' JT65 decode pre-recorded .WAV file(s)' + print *, '' + print *, 'OPTIONS:' + print *, '' + do i = 1, size (long_options) + call long_options(i) % print (6) + end do + go to 999 + endif + + call init_timer ('timer.out') + call timer('jt65 ',0) + + ndecoded=0 + do ifile=noffset+1,noffset+nremain + nfa=nlow + nfb=nhigh + minsync=0 + call get_command_argument(ifile,optarg,narglen) + infile=optarg(:narglen) + call timer('read ',0) + call wav%read (infile) + i1=index(infile,'.wav') + if( i1 .eq. 0 ) i1=index(infile,'.WAV') + read(infile(i1-4:i1-1),*,err=998) nutc + npts=52*12000 + read(unit=wav%lun) id2(1:npts) + close(unit=wav%lun) + call timer('read ',1) + dd(1:npts)=id2(1:npts) + dd(npts+1:)=0. + call test(dd,nutc,nfa,nfb,nfqso,ntol,nsubmode, & + n2pass,nrobust,ntrials,naggressive,ndepth, & + mycall,hiscall,hisgrid,nexp_decode,nQSOProgress,ljt65apon) +! if(nft.gt.0) exit + enddo + + call timer('jt65 ',1) + call timer('jt65 ',101) + ! call four2a(a,-1,1,1,1) !Free the memory used for plans + ! call filbig(a,-1,1,0.0,0,0,0,0,0) ! (ditto) + go to 999 + +998 print*,'Cannot read from file:' + print*,infile + +999 continue +end program jt65 diff --git a/wsjtx_lib/lib/jt65_decode.f90 b/wsjtx_lib/lib/jt65_decode.f90 new file mode 100644 index 0000000..4e73ee7 --- /dev/null +++ b/wsjtx_lib/lib/jt65_decode.f90 @@ -0,0 +1,522 @@ +module jt65_decode + + integer, parameter :: NSZ=3413, NZMAX=60*12000 + + type :: jt65_decoder + procedure(jt65_decode_callback), pointer :: callback => null() + contains + procedure :: decode + end type jt65_decoder + +! Callback function to be called with each decode + abstract interface + subroutine jt65_decode_callback(this,sync,snr,dt,freq,drift, & + nflip,width,decoded,ft,qual,nsmo,nsum,minsync) + + import jt65_decoder + implicit none + class(jt65_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + integer, intent(in) :: freq + integer, intent(in) :: drift + integer, intent(in) :: nflip + real, intent(in) :: width + character(len=22), intent(in) :: decoded + integer, intent(in) :: ft + integer, intent(in) :: qual + integer, intent(in) :: nsmo + integer, intent(in) :: nsum + integer, intent(in) :: minsync + + end subroutine jt65_decode_callback + end interface + +contains + + subroutine decode(this,callback,dd0,npts,newdat,nutc,nf1,nf2,nfqso, & + ntol,nsubmode,minsync,nagain,n2pass,nrobust,ntrials,naggressive, & + ndepth,emedelay,clearave,mycall,hiscall,hisgrid,nexp_decode, & + nQSOProgress,ljt65apon) + +! Process dd0() data to find and decode JT65 signals. + + use jt65_mod + use timer_module, only: timer + + include 'constants.f90' + + class(jt65_decoder), intent(inout) :: this + procedure(jt65_decode_callback) :: callback + real, intent(in) :: dd0(NZMAX),emedelay + integer, intent(in) :: npts, nutc, nf1, nf2, nfqso, ntol & + , nsubmode, minsync, n2pass, ntrials, naggressive, ndepth & + , nexp_decode, nQSOProgress + logical, intent(in) :: newdat, nagain, nrobust, clearave, ljt65apon + character(len=12), intent(in) :: mycall, hiscall + character(len=6), intent(in) :: hisgrid + + real dd(NZMAX) + real ss(552,NSZ) + real savg(NSZ) + real a(5) + character*22 decoded,decoded0,avemsg,deepave + type candidate + real freq + real dt + real sync + real flip + end type candidate + type(candidate) ca(300) + type accepted_decode + real freq + real dt + real sync + character*22 decoded + end type accepted_decode + type(accepted_decode) dec(50) + logical :: first_time,prtavg,single_decode,bVHF,clear_avg65 + + integer h0(0:11),d0(0:11) + real r0(0:11) + common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano + common/steve/thresh0 + common/sync/ss + +! 0 1 2 3 4 5 6 7 8 9 10 11 + data h0/41,42,43,43,44,45,46,47,48,48,49,49/ + data d0/71,72,73,74,76,77,78,80,81,82,83,83/ + +! 0 1 2 3 4 5 6 7 8 9 10 11 + data r0/0.70,0.72,0.74,0.76,0.78,0.80,0.82,0.84,0.86,0.88,0.90,0.90/ + data nutc0/-999/,nfreq0/-999/,nsave/0/,clear_avg65/.true./ + save + + this%callback => callback + first_time=nrobust .and. (emedelay.eq.-999.9) !Silence compiler warning + first_time=newdat + dd=dd0 + ndecoded=0 + ndecoded0=0 + single_decode=iand(nexp_decode,32).ne.0 .or. nagain + bVHF=iand(nexp_decode,64).ne.0 + + if(bVHF) then + nvec=ntrials + npass=1 + if(n2pass.gt.1) npass=2 + else + nvec=1000 + if(ndepth.eq.1) then + npass=2 + nvec=100 + elseif(ndepth.eq.2) then + npass=2 + nvec=1000 + else + npass=4 + nvec=1000 + endif + endif + do ipass=1,npass + first_time=.true. + if(ipass.eq.1) then !First-pass parameters + thresh0=2.5 + nsubtract=1 + nrob=0 + elseif( ipass.eq.2 ) then !Second-pass parameters + thresh0=2.0 + nsubtract=1 + nrob=0 + elseif( ipass.eq.3 ) then + thresh0=2.0 + nsubtract=1 + nrob=0 + elseif( ipass.eq.4 ) then + thresh0=2.0 + nsubtract=0 + nrob=1 + endif + if(npass.eq.1) then + nsubtract=0 + thresh0=2.0 + endif + + call timer('symsp65 ',0) + ss=0. + call symspec65(dd,npts,nqsym,savg) !Get normalized symbol spectra + call timer('symsp65 ',1) + nfa=nf1 + nfb=nf2 + +!### Q: should either of the next two uses of "single_decode" be "bVHF" instead? + if(single_decode .or. (bVHF .and. ntol.lt.1000)) then + nfa=max(200,nfqso-ntol) + nfb=min(4000,nfqso+ntol) + thresh0=1.0 + endif + df=12000.0/8192.0 !df = 1.465 Hz + if(bVHF) then + ia=max(1,nint((nfa-100)/df)) + ib=min(NSZ,nint((nfb+100)/df)) + nz=ib-ia+1 + if(nz.lt.50) go to 900 + if(isnan(sum(savg(ia:ia+nz-1)))) go to 900 + call lorentzian(savg(ia),nz,a) + baseline=a(1) + amp=a(2) + f0=(a(3)+ia-1)*df + width=a(4)*df + endif + + ncand=0 + call timer('sync65 ',0) + call sync65(nfa,nfb,ntol,nqsym,ca,ncand,nrob,bVHF) + ncand=min(ncand,50/ipass) + call timer('sync65 ',1) + + mode65=2**nsubmode + nflip=1 + nqd=0 + decoded=' ' + decoded0="" + freq0=0. + prtavg=.false. + if(.not.nagain) nsum=0 + if(clearave) then + nsum=0 + nsave=0 + clear_avg65=.true. + endif + + if(bVHF) then +! Be sure to search for shorthand message at nfqso +/- ntol + if(ncand.lt.300) ncand=ncand+1 + ca(ncand)%sync=5.0 + ca(ncand)%dt=2.5 + ca(ncand)%freq=nfqso + ca(ncand)%flip=0 + endif + do icand=1,ncand + sync1=ca(icand)%sync + dtx=ca(icand)%dt + freq=ca(icand)%freq + if(bVHF) then + flip=ca(icand)%flip + nflip=int(flip) + endif + if(sync1.lt.float(minsync)) nflip=0 + if(ipass.eq.1) ntry65a=ntry65a + 1 + if(ipass.eq.2) ntry65b=ntry65b + 1 + call timer('decod65a',0) + nft=0 + nspecial=0 + call decode65a(dd,npts,first_time,nqd,freq,nflip,mode65,nvec, & + naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, & + ljt65apon,bVHF,sync2,a,dtx,nft,nspecial,qual, & + nhist,nsmo,decoded) + call timer('decod65a',1) + + if(.not.bVHF) then + if(abs(a(1)).gt.10.0/ipass) cycle + ibad=0 + if(abs(a(1)).gt.5.0) ibad=1 + if(abs(a(2)).gt.2.0) ibad=ibad+1 + if(abs(dtx-1.0).gt.2.5) ibad=ibad+1 + if(ibad.ge.2) cycle + endif + + if(nspecial.eq.0 .and. sync1.eq.5.0 .and. dtx.eq.2.5) cycle + if(nspecial.eq.2) decoded='RO' + if(nspecial.eq.3) decoded='RRR' + if(nspecial.eq.4) decoded='73' + if(sync1.lt.float(minsync) .and. & + decoded.eq.' ') nflip=0 + if(nft.ne.0) nsum=1 + + nhard_min=param(1) + nrtt1000=param(4) + ntotal_min=param(5) + nsmo=param(9) + + nfreq=nint(freq+a(1)) + ndrift=nint(2.0*a(2)) + if(bVHF) then + xtmp=10**((sync1+16.0)/10.0) ! sync comes to us in dB + s2db=1.1*db(xtmp)+1.4*(dB(width)-4.3)-52.0 +! s2db=sync1 - 30.0 + db(width/3.3) !### VHF/UHF/microwave + if(nspecial.gt.0) s2db=sync2 + else + s2db=10.0*log10(sync2) - 35 !### Empirical (HF) + endif + nsnr=nint(s2db) + if(nsnr.lt.-30) nsnr=-30 + if(nsnr.gt.-1) nsnr=-1 + nftt=0 +!********* DOES THIS STILL WORK WHEN NFT INCLUDES # OF AP SYMBOLS USED?? + if(nft.ne.1 .and. iand(ndepth,16).eq.16 .and. & + sync1.ge.float(minsync) .and. (.not.prtavg)) then +! Single-sequence FT decode failed, so try for an average FT decode. + if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then +! This is a new minute or a new frequency, so call avg65. + nutc0=nutc + nfreq0=nfreq + nsave=nsave+1 + nsave=mod(nsave-1,64)+1 + call avg65(nutc,nsave,sync1,dtx,nflip,nfreq,mode65,ntol, & + ndepth,nagain,ntrials,naggressive,clear_avg65,neme, & + mycall,hiscall,hisgrid,nftt,avemsg,qave,deepave,nsum, & + ndeepave,nQSOProgress,ljt65apon) + nsmo=param(9) + nqave=int(qave) + + if (associated(this%callback) .and.nftt.ge.1 .and. nsum.ge.2) then +! Display a decoded message obtained by averaging 2 or more transmissions + call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, & + nflip,width,avemsg,nftt,nqave,nsmo,nsum,minsync) + prtavg=.true. + end if + + endif + endif + + if(nftt.eq.0) go to 5 +! if(nftt.eq.1) then +!! nft=1 +! decoded=avemsg +! go to 5 +! endif + n=naggressive + rtt=0.001*nrtt1000 + if(nft.lt.2 .and. minsync.ge.0 .and. nspecial.eq.0 .and. .not.bVHF) then + if(nhard_min.gt.50) cycle + if(nhard_min.gt.h0(n)) cycle + if(ntotal_min.gt.d0(n)) cycle + if(rtt.gt.r0(n)) cycle + endif + +5 continue + if(decoded.eq.decoded0 .and. abs(freq-freq0).lt. 3.0 .and. & + minsync.ge.0) cycle !Don't display dupes +! if(decoded.ne.' ' .or. minsync.lt.0) then + if(decoded.ne.' ' .or. bVHF) then + if(nsubtract.eq.1) then + call timer('subtr65 ',0) + call subtract65(dd,npts,freq,dtx) + call timer('subtr65 ',1) + endif + + ndupe=0 ! de-dedupe + do i=1, ndecoded + if(decoded==dec(i)%decoded) then + ndupe=1 + exit + endif + enddo + if(ndupe.ne.1 .and. ((sync1.ge.float(minsync)) .or. bVHF)) then + if(ipass.eq.1) n65a=n65a + 1 + if(ipass.eq.2) n65b=n65b + 1 + if(ndecoded.lt.50) ndecoded=ndecoded+1 + dec(ndecoded)%freq=freq+a(1) + dec(ndecoded)%dt=dtx + dec(ndecoded)%sync=sync2 + dec(ndecoded)%decoded=decoded + nqual=min(int(qual),9999) + + if(associated(this%callback)) then + call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, & + nflip,width,decoded,nft,nqual,nsmo,1,minsync) + end if + endif + decoded0=decoded + freq0=freq + if(decoded0.eq.' ') decoded0='*' + if(single_decode .and. ndecoded.gt.0) go to 900 + endif + enddo ! icand + if(ipass.gt.1 .and. ndecoded.eq.ndecoded0) exit + ndecoded0=ndecoded + enddo ! ipass +900 return + end subroutine decode + + subroutine avg65(nutc,nsave,snrsync,dtxx,nflip,nfreq,mode65,ntol,ndepth, & + nagain, ntrials,naggressive,clear_avg65,neme,mycall,hiscall,hisgrid, & + nftt,avemsg,qave,deepave,nsum,ndeepave,nQSOProgress,ljt65apon) + +! Decodes averaged JT65 data + + use jt65_mod + parameter (MAXAVE=64) + character*22 avemsg,deepave,deepbest + character mycall*12,hiscall*12,hisgrid*6 + character*1 csync,cused(64) + logical nagain + integer iused(64) +! Accumulated data for message averaging + integer iutc(MAXAVE) + integer nfsave(MAXAVE) + integer nflipsave(MAXAVE) + real s1b(-255:256,126) + real s1save(-255:256,126,MAXAVE) + real s2(66,126) + real s3save(64,63,MAXAVE) + real s3b(64,63) + real s3c(64,63) + real dtsave(MAXAVE) + real syncsave(MAXAVE) + logical first,clear_avg65,ljt65apon + data first/.true./ + save + + if(first .or. clear_avg65) then + iutc=-1 + nfsave=0 + dtdiff=0.2 + s3save=0. + s1save=0. + nsave=1 !### ??? +! Silence compiler warnings + if(nagain .and. ndeepave.eq.-99 .and. neme.eq.-99) stop + first=.false. + clear_avg65=.false. + endif + + do i=1,64 + if(iutc(i).lt.0) exit + if(nutc.eq.iutc(i) .and. abs(nfreq-nfsave(i)).le.ntol) go to 10 + enddo + +! Save data for message averaging + iutc(nsave)=nutc + syncsave(nsave)=snrsync + dtsave(nsave)=dtxx + nfsave(nsave)=nfreq + nflipsave(nsave)=nflip + s1save(-255:256,1:126,nsave)=s1 + s3save(1:64,1:63,nsave)=s3a + avemsg=' ' + deepbest=' ' + nfttbest=0 + +10 syncsum=0. + dtsum=0. + nfsum=0 + nsum=0 + s1b=0. + s3b=0. + s3c=0. + + do i=1,MAXAVE !Consider all saved spectra + cused(i)='.' + if(iutc(i).lt.0) exit + if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same (odd/even) seq + if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match + if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match + if(nflipsave(i).eq.0) cycle !No sync + if(nflip.ne.nflipsave(i)) cycle !Sync type (*/#) must match + + s3b=s3b + s3save(1:64,1:63,i) + s1b=s1b + s1save(-255:256,1:126,i) + syncsum=syncsum + syncsave(i) + dtsum=dtsum + dtsave(i) + nfsum=nfsum + nfsave(i) + cused(i)='$' + nsum=nsum+1 + iused(nsum)=i + enddo + if(nsum.lt.64) iused(nsum+1)=0 + + syncave=0. + dtave=0. + fave=0. + if(nsum.gt.0) then + syncave=syncsum/nsum + dtave=dtsum/nsum + fave=float(nfsum)/nsum + endif + + do i=1,nsave + csync=' ' + if(nflipsave(i).lt.0.0) csync='#' + if(nflipsave(i).gt.0.0) csync='*' + write(14,1000) cused(i),iutc(i),syncsave(i),dtsave(i)-1.0,nfsave(i),csync +1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1) + enddo + if(nsum.lt.2) go to 900 + + df=1378.125/512.0 + +! Do the smoothing loop + qualbest=0. + minsmo=0 + maxsmo=0 + if(mode65.ge.2) then + minsmo=nint(width/df) + maxsmo=2*minsmo + endif + nn=0 + do ismo=minsmo,maxsmo + nftt=0 + if(ismo.gt.0) then + do j=1,126 + call smo121(s1b(-255,j),512) + if(j.eq.1) nn=nn+1 + if(nn.ge.4) then + call smo121(s1b(-255,j),512) + if(j.eq.1) nn=nn+1 + endif + enddo + endif + + do i=1,66 + jj=i + if(mode65.eq.2) jj=2*i-1 + if(mode65.eq.4) then + ff=4*(i-1)*df - 355.297852 + jj=nint(ff/df)+1 + endif + s2(i,1:126)=s1b(jj,1:126) + enddo + + do j=1,63 + k=mdat(j) !Points to data symbol + if(nflip.lt.0) k=mdat2(j) + do i=1,64 + s3c(i,j)=4.e-5*s2(i+2,k) + enddo + enddo + + nadd=nsum*ismo + call extract(s3c,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, & + hiscall,hisgrid,nQSOProgress,ljt65apon,ncount,nhist, & + avemsg,ltext,nftt,qual) + if(nftt.eq.1) then + nsmo=ismo + param(9)=nsmo + go to 900 + else if(nftt.ge.2) then + if(qual.gt.qualbest) then + deepbest=avemsg + qualbest=qual + nnbest=nn + nsmobest=ismo + nfttbest=nftt + endif + endif + enddo + if(nfttbest.eq.2) then + avemsg=deepbest !### ??? + deepave=deepbest + qave=qualbest + nsmo=nsmobest + param(9)=nsmo + nftt=nfttbest + endif +900 continue + + return + end subroutine avg65 + +end module jt65_decode diff --git a/wsjtx_lib/lib/jt65_mod.f90 b/wsjtx_lib/lib/jt65_mod.f90 new file mode 100644 index 0000000..23c2953 --- /dev/null +++ b/wsjtx_lib/lib/jt65_mod.f90 @@ -0,0 +1,13 @@ +module jt65_mod + + integer param(0:9) + integer mrs(63) + integer mrs2(63) + integer mdat(126),mref(126,2),mdat2(126),mref2(126,2) !From prcom + + real s1(-255:256,126) + real s3a(64,63) + real pr(126) + real width + +end module jt65_mod diff --git a/wsjtx_lib/lib/jt65_test.f90 b/wsjtx_lib/lib/jt65_test.f90 new file mode 100644 index 0000000..d6a80a2 --- /dev/null +++ b/wsjtx_lib/lib/jt65_test.f90 @@ -0,0 +1,78 @@ +module jt65_test + + ! Test the JT65 decoder for WSJT-X + + implicit none + + public :: test + integer, parameter, public :: NZMAX=60*12000 + integer, public :: nft + +contains + + subroutine test (dd,nutc,nflow,nfhigh,nfqso,ntol,nsubmode,n2pass,nrobust & + ,ntrials,naggressive,ndepth,mycall,hiscall,hisgrid,nexp_decode, & + nQSOProgress,ljt65apon) + use timer_module, only: timer + use jt65_decode + implicit none + + include 'constants.f90' + real, intent(in) :: dd(NZMAX) + integer, intent(in) :: nutc, nflow, nfhigh, nfqso, ntol, nsubmode, n2pass & + , ntrials, naggressive, ndepth, nexp_decode, nQSOProgress + logical, intent(in) :: nrobust,ljt65apon + character(len=12), intent(in) :: mycall, hiscall + character(len=6), intent(in) :: hisgrid + type(jt65_decoder) :: my_decoder + logical nclearave !### Should be a dummy arg? + nclearave=.false. + + call timer('jt65a ',0) + call my_decoder%decode(my_callback,dd,npts=52*12000,newdat=.true., & + nutc=nutc,nf1=nflow,nf2=nfhigh,nfqso=nfqso,ntol=ntol, & + nsubmode=nsubmode, minsync=-1,nagain=.false.,n2pass=n2pass, & + nrobust=nrobust,ntrials=ntrials,naggressive=naggressive, & + ndepth=ndepth,emedelay=0.0,clearave=nclearave,mycall=mycall, & + hiscall=hiscall,hisgrid=hisgrid,nexp_decode=nexp_decode, & + nQSOProgress=nQSOProgress,ljt65apon=ljt65apon) + call timer('jt65a ',1) + end subroutine test + + subroutine my_callback (this,sync,snr,dt,freq,drift,nflip,width, & + decoded,ft,qual,smo,sum,minsync) + use jt65_decode + implicit none + + class(jt65_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + integer, intent(in) :: freq + integer, intent(in) :: drift + integer, intent(in) :: nflip + real, intent(in) :: width + character(len=22), intent(in) :: decoded + integer, intent(in) :: ft + integer, intent(in) :: qual + integer, intent(in) :: smo + integer, intent(in) :: sum + integer, intent(in) :: minsync + + integer nwidth + real t + + if(minsync+nflip+qual.eq.-9999) stop !Silence compiler warning + t=max(0.0,width*width-7.2) + nwidth=max(nint(sqrt(t)),2) +!### deal with nflip here! ### +!### also single_decode, csync, etc... ### + write(*,1012) nint(sync),snr,dt,freq,drift,nwidth, & + decoded,ft,sum,smo +1012 format(i4,i5,f6.2,i5,i4,i3,1x,a22,' JT65',3i3) + nft=ft + call flush(6) + + end subroutine my_callback + +end module jt65_test diff --git a/wsjtx_lib/lib/jt65code.f90 b/wsjtx_lib/lib/jt65code.f90 new file mode 100644 index 0000000..d3dac07 --- /dev/null +++ b/wsjtx_lib/lib/jt65code.f90 @@ -0,0 +1,103 @@ +program JT65code + +! Provides examples of message packing, bit and symbol ordering, +! Reed Solomon encoding, and other necessary details of the JT65 +! protocol. + + use packjt + character*22 msg,msgchk,msg0,msg1,decoded,cok*3,bad*1,msgtype*10,expected + integer dgen(12),sent(63),tmp(63),recd(12),era(51) + include 'testmsg.f90' + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: jt65code "message"' + print*,' jt65code -t' + go to 999 + endif + + call getarg(1,msg) !Get message from command line + msgchk=msg + call fmtmsg(msgchk,iz) + nmsg=1 + if(msg(1:2).eq."-t") then + if (NTEST+5 > MAXTEST) then + write(*,*) "NTEST exceed MAXTEST" + endif + testmsg(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" + testmsg(NTEST+2)="KA1ABC WB9XYZ OOO" + testmsg(NTEST+3)="RO" + testmsg(NTEST+4)="RRR" + testmsg(NTEST+5)="73" + testmsgchk(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" + testmsgchk(NTEST+2)="KA1ABC WB9XYZ OOO" + testmsgchk(NTEST+3)="RO" + testmsgchk(NTEST+4)="RRR" + testmsgchk(NTEST+5)="73" + nmsg=NTEST+5 + endif + + write(*,1010) +1010 format(" Message Decoded Err? Type Expected"/ & + 76("-")) + + do imsg=1,nmsg + if(nmsg.gt.1) then + msg=testmsg(imsg) + msgchk=testmsgchk(imsg) + endif + + call fmtmsg(msg,iz) !To upper, collapse mult blanks + msg0=msg !Input message + call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report + msg1=msg !Message without "OOO" + + if(nspecial.gt.0) then !or is a shorthand message + if(nspecial.eq.2) decoded="RO" + if(nspecial.eq.3) decoded="RRR" + if(nspecial.eq.4) decoded="73" + itype=-1 + msgtype="Shorthand" + go to 10 + endif + + call packmsg(msg1,dgen,itype) !Pack message into 12 six-bit bytes + msgtype="" + if(itype.eq.1) msgtype="Std Msg" + if(itype.eq.2) msgtype="Type 1 pfx" + if(itype.eq.3) msgtype="Type 1 sfx" + if(itype.eq.4) msgtype="Type 2 pfx" + if(itype.eq.5) msgtype="Type 2 sfx" + if(itype.eq.6) msgtype="Free text" + + call rs_encode(dgen,sent) !RS encode + call interleave63(sent,1) !Interleave channel symbols + call graycode(sent,63,1,sent) !Apply Gray code + + call graycode(sent,63,-1,tmp) !Remove Gray code + call interleave63(tmp,-1) !Remove interleaving + call rs_decode(tmp,era,0,recd,nerr) !Decode the message + call unpackmsg(recd,decoded) !Unpack the user message + if(cok.eq."OOO") decoded(20:22)=cok + call fmtmsg(decoded,iz) + +10 bad=" " + expected = 'EXACT' + if(decoded.ne.msg0) then + bad="*" + if(decoded(1:13).eq.msg0(1:13) .and. & + decoded(14:22).eq. ' ') expected = 'TRUNCATED' + endif + write(*,1020) imsg,msg0,decoded,bad,itype,msgtype,expected +1020 format(i2,'.',1x,a22,1x,a22,1x,a1,i3,":",a10,2x,a22) + enddo + + if(nmsg.eq.1 .and. nspecial.eq.0) then + write(*,1030) dgen +1030 format(/'Packed message, 6-bit symbols ',12i3) !Display packed symbols + + write(*,1040) sent +1040 format(/'Information-carrying channel symbols'/(i5,20i3)) + endif + +999 end program JT65code diff --git a/wsjtx_lib/lib/jt65sim.f90 b/wsjtx_lib/lib/jt65sim.f90 new file mode 100644 index 0000000..623a0fc --- /dev/null +++ b/wsjtx_lib/lib/jt65sim.f90 @@ -0,0 +1,312 @@ +program jt65sim + +! Generate simulated JT65 data for testing WSJT-X + + use wavhdr + use packjt + use options + parameter (NMAX=54*12000) ! = 648,000 @12kHz + parameter (NFFT=10*65536,NH=NFFT/2) + type(hdr) h !Header for .wav file + integer*2 iwave(NMAX) !Generated waveform + integer*4 itone(126) !Channel symbols (values 0-65) + integer dgen(12) !Twelve 6-bit data symbols + integer sent(63) !RS(63,12) codeword + real*4 xnoise(NMAX) !Generated random noise + real*4 dat(NMAX) !Generated real data + complex cdat(NMAX) !Generated complex waveform + complex cspread(0:NFFT-1) !Complex amplitude for Rayleigh fading + complex z + real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq,sps + character msg*22,fname*11,csubmode*1,c,optarg*500,numbuf*32 +! character call1*5,call2*5 + logical :: display_help=.false.,seed_prngs=.true. + type (option) :: long_options(13) = [ & + option ('help',.false.,'h','Display this help message',''), & + option ('sub-mode',.true.,'m','sub mode, default MODE=A','MODE'), & + option ('num-sigs',.true.,'n','number of signals per file, default SIGNALS=10','SIGNALS'), & + option ('f0',.true.,'F','base frequency offset, default F0=1500.0','F0'), & + option ('doppler-spread',.true.,'d','Doppler spread, default SPREAD=0.0','SPREAD'), & + option ('drift per min',.true.,'D','Frequency drift (Hz/min), default DRIFT=0.0','DRIFT'), & + option ('time-offset',.true.,'t','Time delta, default SECONDS=0.0','SECONDS'), & + option ('num-files',.true.,'f','Number of files to generate, default FILES=1','FILES'), & + option ('no-prng-seed',.false.,'p','Do not seed PRNGs (use for reproducible tests)',''), & + option ('strength',.true.,'s','S/N in dB (2500Hz reference b/w), default SNR=0','SNR'), & + option ('11025',.false.,'S','Generate at 11025Hz sample rate, default 12000Hz',''), & + option ('gain-offset',.true.,'G','Gain offset in dB, default GAIN=0dB','GAIN'), & + option ('message',.true.,'M','Message text','Message') ] + + integer nprc(126) !Sync pattern + data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & + 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & + 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & + 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & + 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & + 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & + 1,1,1,1,1,1/ + +! Default parameters: + csubmode='A' + mode65=1 + nsigs=10 + bf0=1500. + fspread=0. + drift=0. + xdt=0. + snrdb=0. + nfiles=1 + nsample_rate=12000 + gain_offset=0. + msg="K1ABC W9XYZ EN37" + + do + call getopt('hm:n:F:d:D:t:f:ps:SG:M:',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.) + if( nstat .ne. 0 ) then + exit + end if + select case (c) + case ('h') + display_help = .true. + case ('m') + read (optarg(:narglen), *) csubmode + if(csubmode.eq.'A') mode65=1 + if(csubmode.eq.'B') mode65=2 + if(csubmode.eq.'C') mode65=4 + case ('n') + read (optarg(:narglen), *,err=10) nsigs + case ('F') + read (optarg(:narglen), *,err=10) bf0 + case ('d') + read (optarg(:narglen), *,err=10) fspread + case ('D') + read (optarg(:narglen), *,err=10) drift + case ('t') + read (optarg(:narglen), *) numbuf + if (numbuf(1:1) == '\') then !'\' + read (numbuf(2:), *,err=10) xdt + else + read (numbuf, *,err=10) xdt + end if + case ('f') + read (optarg(:narglen), *,err=10) nfiles + case ('p') + seed_prngs=.false. + case ('s') + read (optarg(:narglen), *) numbuf + if (numbuf(1:1) == '\') then !'\' + read (numbuf(2:), *,err=10) snrdb + else + read (numbuf, *,err=10) snrdb + end if + case ('S') + nsample_rate=11025 + case ('G') + read (optarg(:narglen), *) numbuf + if (numbuf(1:1) == '\') then !'\' + read (numbuf(2:), *, err=10) gain_offset + else + read (numbuf, *, err=10) gain_offset + end if + case ('M') + read (optarg(:narglen), '(A)',err=10) msg + end select + cycle +10 display_help=.true. + print *, 'Optional argument format error for option -', c + end do + + if(display_help .or. nstat.lt.0 .or. nremain.ge.1) then + print *, '' + print *, 'Usage: jt65sim [OPTIONS]' + print *, '' + print *, ' Generate one or more simulated JT65 signals in .WAV file(s)' + print *, '' + print *, 'Example: jt65sim -m B -n 10 -d 0.2 -s \\-24.5 -t 0.0 -f 4' + print *, '' + print *, 'OPTIONS: NB Use \ (\\ on *nix shells) to escape -ve arguments' + print *, '' + do i = 1, size (long_options) + call long_options(i) % print (6) + end do + go to 999 + endif + + if (seed_prngs) then + call init_random_seed() ! seed Fortran RANDOM_NUMBER generator + call sgran() ! see C rand generator (used in gran) + end if + + rms=100. * 10. ** (gain_offset / 20.) + + fsample=nsample_rate !Sample rate (Hz) + dt=1.d0/fsample !Sample interval (s) + twopi=8.d0*atan(1.d0) + npts=54*nsample_rate !Total samples in .wav file + baud=11025.d0/4096.d0 !Keying rate + sps=real(nsample_rate)/baud !Samples per symbol, at fsample=NSAMPLE_RATE Hz + nsym=126 !Number of channel symbols + h=default_header(nsample_rate,npts) + dfsig=2000.0/nsigs !Freq spacing between sigs in file (Hz) + + do ifile=1,nfiles !Loop over requested number of files + write(fname,1002) ifile !Output filename +1002 format('000000_',i4.4) + open(10,file=fname//'.wav',access='stream',status='unknown') + + xnoise=0. + cdat=0. + if(snrdb.lt.90) then + do i=1,npts + xnoise(i)=gran() !Generate gaussian noise + enddo + endif + + do isig=1,nsigs !Generate requested number of sigs + if(mod(nsigs,2).eq.0) f0=bf0 + dfsig*(isig-0.5-nsigs/2) + if(mod(nsigs,2).eq.1) f0=bf0 + dfsig*(isig-(nsigs+1)/2) + xsnr=snrdb + if(snrdb.eq.0.0) xsnr=-19 - isig + if(csubmode.eq.'B' .and. snrdb.eq.0.0) xsnr=-21 - isig + if(csubmode.eq.'C' .and. snrdb.eq.0.0) xsnr=-21 - isig + + call packmsg(msg,dgen,itype) !Pack message into 12 six-bit bytes + call rs_encode(dgen,sent) !Encode using RS(63,12) + call interleave63(sent,1) !Interleave channel symbols + call graycode65(sent,63,1) !Apply Gray code + + nprc_test=0 + i1=len(trim(msg)) + if(i1.gt.10) then + if(msg(i1-3:i1).eq.' OOO') nprc_test=1 + endif + k=0 + do j=1,nsym !Insert sync and data into itone() + if(nprc(j).eq.nprc_test) then + k=k+1 + itone(j)=sent(k)+2 + else + itone(j)=0 + endif + enddo + + if(len(trim(msg)).eq.2.or.len(trim(msg)).eq.3) then + nshorthand=0 + if(msg(1:2).eq.'RO') nshorthand=2 + if(msg(1:3).eq.'RRR') nshorthand=3 + if(msg(1:2).eq.'73') nshorthand=4 + if(nshorthand.gt.0) then + ntoggle=0 + do i=1,nsym,4 + itone(i)=ntoggle*10*nshorthand + if(i+1.le.126) itone(i+1)=ntoggle*10*nshorthand + if(i+2.le.126) itone(i+2)=ntoggle*10*nshorthand + if(i+3.le.126) itone(i+3)=ntoggle*10*nshorthand + ntoggle=mod(ntoggle+1,2) + enddo + endif + endif + + bandwidth_ratio=2500.0/(fsample/2.0) + sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*xsnr) + if(xsnr.gt.90.0) sig=1.0 + write(*,1020) ifile,isig,f0,csubmode,xsnr,xdt,fspread,msg +1020 format(i4,i4,f10.3,2x,a1,2x,f5.1,f6.2,f5.1,1x,a22) + + phi=0.d0 + dphi=0.d0 + k=nsample_rate + xdt*nsample_rate !Start audio at t = xdt + 1.0 s + isym0=-99 + do i=1,npts !Add this signal into cdat() + isym=floor(i/sps)+1 + if(isym.gt.nsym) exit + freq=f0 + (drift/60.0)*(i-npts/2)*dt + itone(isym)*baud*mode65 + dphi=twopi*freq*dt + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + z=cmplx(cos(xphi),sin(xphi)) + k=k+1 + if(k.ge.1) cdat(k)=cdat(k) + sig*z + enddo + enddo + + if(fspread.ne.0) then !Apply specified Doppler spread + df=real(nsample_rate)/nfft + twopi=8*atan(1.0) + cspread(0)=1.0 + cspread(NH)=0. + +! The following options were added 3/15/2016 to make the half-power tone +! widths equal to the requested Doppler spread. (Previously we effectively +! used b=1.0 and Gaussian shape, which made the tones 1.665 times wider.) +! b=2.0*sqrt(log(2.0)) !Gaussian (before 3/15/2016) +! b=2.0 !Lorenzian 3/15 - 3/27 + 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(exp(-x*x)) !Gaussian + 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 + + do i=0,NFFT-1 + f=i*df + if(i.gt.NH) f=(i-nfft)*df + s=real(cspread(i))**2 + aimag(cspread(i))**2 +! write(13,3000) i,f,s,cspread(i) +!3000 format(i5,f10.3,3f12.6) + enddo +! s=real(cspread(0))**2 + aimag(cspread(0))**2 +! write(13,3000) 1024,0.0,s,cspread(0) + + 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 + cdat(1:npts)=cspread(1:npts)*cdat(1:npts) !Apply Rayleigh fading + +! do i=0,NFFT-1 +! p=real(cspread(i))**2 + aimag(cspread(i))**2 +! write(14,3010) i,p,cspread(i) +!3010 format(i8,3f12.6) +! enddo + + endif + + dat(1:npts)=aimag(cdat(1:npts)) + xnoise(1:npts) !Add the generated noise + if(snrdb.lt.90.0) then + dat(1:npts)=rms*dat(1:npts) + else + datpk=maxval(abs(dat(1:npts))) + fac=32766.9/datpk + dat(1:npts)=fac*dat(1:npts) + endif + if(any(abs(dat(1:npts)).gt.32767.0)) print*,"Warning - data will be clipped." + iwave(1:npts)=nint(dat(1:npts)) + write(10) h,iwave(1:npts) !Save the .wav file + close(10) + enddo + +999 end program jt65sim diff --git a/wsjtx_lib/lib/jt9.f90 b/wsjtx_lib/lib/jt9.f90 new file mode 100644 index 0000000..3621a0a --- /dev/null +++ b/wsjtx_lib/lib/jt9.f90 @@ -0,0 +1,373 @@ +program jt9 + +! Decoder for JT9. Can run stand-alone, reading data from *.wav files; +! or as the back end of wsjt-x, with data placed in a shared memory region. + + use options + use prog_args + use, intrinsic :: iso_c_binding + use FFTW3 + use timer_module, only: timer + use timer_impl, only: init_timer, fini_timer + use readwav + + include 'jt9com.f90' + + integer*2 id2a(180000) + integer(C_INT) iret + type(wav_header) wav + real*4 s(NSMAX) + real*8 TRperiod + character c + character(len=500) optarg, infile + character wisfile*256 +!### ndepth was defined as 60001. Why??? + integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700, & + fhigh=4000,nrxfreq=1500,ndepth=1,nexp_decode=0,nQSOProg=0 + logical :: read_files = .true., tx9 = .false., display_help = .false., & + bLowSidelobes = .false., nexp_decode_set = .false., & + have_ntol = .false. + type (option) :: long_options(32) = [ & + option ('help', .false., 'h', 'Display this help message', ''), & + option ('shmem',.true.,'s','Use shared memory for sample data','KEY'), & + option ('tr-period', .true., 'p', 'Tx/Rx period, default SECONDS=60', & + 'SECONDS'), & + option ('executable-path', .true., 'e', & + 'Location of subordinate executables (KVASD) default PATH="."', & + 'PATH'), & + option ('data-path', .true., 'a', & + 'Location of writeable data files, default PATH="."', 'PATH'), & + option ('temp-path', .true., 't', & + 'Temporary files path, default PATH="."', 'PATH'), & + option ('lowest', .true., 'L', & + 'Lowest frequency decoded (JT65), default HERTZ=200', 'HERTZ'), & + option ('highest', .true., 'H', & + 'Highest frequency decoded, default HERTZ=4007', 'HERTZ'), & + option ('split', .true., 'S', & + 'Lowest JT9 frequency decoded, default HERTZ=2700', 'HERTZ'), & + option ('rx-frequency', .true., 'f', & + 'Receive frequency offset, default HERTZ=1500', 'HERTZ'), & + option ('freq-tolerance', .true., 'F', & + 'Receive frequency tolerance, default HERTZ=20', 'HERTZ'), & + option ('patience', .true., 'w', & + 'FFTW3 planing patience (0-4), default PATIENCE=1', 'PATIENCE'), & + option ('fft-threads', .true., 'm', & + 'Number of threads to process large FFTs, default THREADS=1', & + 'THREADS'), & + option ('q65', .false., '3', 'Q65 mode', ''), & + option ('jt4', .false., '4', 'JT4 mode', ''), & + option ('ft4', .false., '5', 'FT4 mode', ''), & + option ('jt65', .false.,'6', 'JT65 mode', ''), & + option ('fst4', .false., '7', 'FST4 mode', ''), & + option ('fst4w', .false., 'W', 'FST4W mode', ''), & + option ('fst4w', .false., 'Y', 'FST4W mode, print hash22 values', ''), & + option ('ft8', .false., '8', 'FT8 mode', ''), & + option ('jt9', .false., '9', 'JT9 mode', ''), & + option ('qra64', .false., 'q', 'QRA64 mode', ''), & + option ('QSOprog', .true., 'Q', 'QSO progress (0-5), default PROGRESS=1',& + 'QSOprogress'), & + option ('sub-mode', .true., 'b', 'Sub mode, default SUBMODE=A', 'A'), & + option ('depth', .true., 'd', & + 'Decoding depth (1-3), default DEPTH=1', 'DEPTH'), & + option ('tx-jt9', .false., 'T', 'Tx mode is JT9', ''), & + option ('my-call', .true., 'c', 'my callsign', 'CALL'), & + option ('my-grid', .true., 'G', 'my grid locator', 'GRID'), & + option ('his-call', .true., 'x', 'his callsign', 'CALL'), & + option ('his-grid', .true., 'g', 'his grid locator', 'GRID'), & + option ('experience-decode', .true., 'X', & + 'experience based decoding flags (1..n), default FLAGS=0', & + 'FLAGS') ] + + type(dec_data), allocatable :: shared_data + character(len=20) :: datetime='' + character(len=12) :: mycall='K1ABC', hiscall='W9XYZ' + character(len=6) :: mygrid='', hisgrid='EN37' + common/patience/npatience,nthreads + common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano + data npatience/1/,nthreads/1/,wisfile/' '/ + + nsubmode = 0 + ntol = 20 + TRperiod=60.d0 + + do + call getopt('hs:e:a:b:r:m:p:d:f:F:w:t:9876543WYqTL:S:H:c:G:x:g:X:Q:', & + long_options,c,optarg,arglen,stat,offset,remain,.true.) + if (stat .ne. 0) then + exit + end if + select case (c) + case ('h') + display_help = .true. + case ('s') + read_files = .false. + shm_key = optarg(:arglen) + case ('e') + exe_dir = optarg(:arglen) + case ('a') + data_dir = optarg(:arglen) + case ('b') + nsubmode = ichar (optarg(:1)) - ichar ('A') + case ('t') + temp_dir = optarg(:arglen) + case ('m') + read (optarg(:arglen), *) nthreads + case ('p') + read (optarg(:arglen), *) TRperiod + case ('d') + read (optarg(:arglen), *) ndepth + case ('f') + read (optarg(:arglen), *) nrxfreq + case ('F') + read (optarg(:arglen), *) ntol + have_ntol = .true. + case ('L') + read (optarg(:arglen), *) flow + case ('S') + read (optarg(:arglen), *) fsplit + case ('H') + read (optarg(:arglen), *) fhigh + case ('q') + mode = 164 + case ('Q') + read (optarg(:arglen), *) nQSOProg + case ('3') + mode = 66 + case ('4') + mode = 4 + case ('5') + mode = 5 + case ('6') + if (mode.lt.65) mode = mode + 65 + case ('7') + mode = 240 + case ('8') + mode = 8 + case ('9') + if (mode.lt.9.or.mode.eq.65) mode = mode + 9 + case ('T') + tx9 = .true. + case ('w') + read (optarg(:arglen), *) npatience + case ('W') + mode = 241 + case ('Y') + mode = 242 + case ('c') + read (optarg(:arglen), *) mycall + case ('G') + read (optarg(:arglen), *) mygrid + case ('x') + read (optarg(:arglen), *) hiscall + case ('g') + read (optarg(:arglen), *) hisgrid + case ('X') + read (optarg(:arglen), *) nexp_decode + nexp_decode_set = .true. + end select + end do + + if (display_help .or. stat .lt. 0 & + .or. (.not. read_files .and. remain .gt. 0) & + .or. (read_files .and. remain .lt. 1)) then + + print *, 'Usage: jt9 [OPTIONS] file1 [file2 ...]' + print *, ' Reads data from *.wav files.' + print *, '' + print *, ' jt9 -s [-w patience] [-m threads] [-e path] [-a path] [-t path]' + print *, ' Gets data from shared memory region with key==' + print *, '' + print *, 'OPTIONS:' + print *, '' + do i = 1, size (long_options) + call long_options(i) % print (6) + end do + go to 999 + endif + + iret=fftwf_init_threads() !Initialize FFTW threading + +! Default to 1 thread, but use nthreads for the big ones + call fftwf_plan_with_nthreads(1) + +! Import FFTW wisdom, if available + wisfile=trim(data_dir)//'/jt9_wisdom.dat'// C_NULL_CHAR + iret=fftwf_import_wisdom_from_filename(wisfile) + + ntry65a=0 + ntry65b=0 + n65a=0 + n65b=0 + num9=0 + numfano=0 + + if (.not. read_files) then + call jt9a() !We're running under control of WSJT-X + go to 999 + endif + + if(mycall.eq.'b') mycall=' ' + if(hiscall.eq.'b') then + hiscall=' ' + hisgrid=' ' + endif + + if (mode .eq. 241 .or. mode .eq. 242) then + ntol = min (ntol, 100) + else if (mode .eq. 65 + 9 .and. .not. have_ntol) then + ntol = 20 + else if (mode .eq. 66 .and. .not. have_ntol) then + ntol = 10 + else + ntol = min (ntol, 1000) + end if + if (.not. nexp_decode_set) then + if (mode .eq. 240 .or. mode .eq. 241 .or. mode .eq. 242) then + nexp_decode = 3 * 256 ! single decode off and nb=0 + end if + end if + allocate(shared_data) + nflatten=0 + do iarg = offset + 1, offset + remain + call get_command_argument (iarg, optarg, arglen) + infile = optarg(:arglen) + call wav%read (infile) + nfsample=wav%audio_format%sample_rate + i1=index(infile,'.wav') + if(i1.lt.1) i1=index(infile,'.WAV') + if(infile(i1-5:i1-5).eq.'_') then + read(infile(i1-4:i1-1),*,err=1) nutc + else + read(infile(i1-6:i1-1),*,err=1) nutc + endif + go to 2 +1 nutc=0 +2 nsps=6912 + npts=TRperiod*12000.d0 + kstep=nsps/2 + k=0 + nhsym=0 + nhsym0=-999 + if(iarg .eq. offset + 1) then + call init_timer (trim(data_dir)//'/timer.out') + call timer('jt9 ',0) + endif + shared_data%id2=0 !??? Why is this necessary ??? + if(mode.eq.5) npts=21*3456 + if(mode.eq.66) npts=TRperiod*12000 + do iblk=1,npts/kstep + k=iblk*kstep + if(mode.eq.8 .and. k.gt.179712) exit + call timer('read_wav',0) + read(unit=wav%lun,end=3) shared_data%id2(k-kstep+1:k) + go to 4 +3 call timer('read_wav',1) + print*,'EOF on input file ',trim(infile) + exit +4 call timer('read_wav',1) + nhsym=(k-2048)/kstep + if(nhsym.ge.1 .and. nhsym.ne.nhsym0) then + if(mode.eq.9 .or. mode.eq.74) then +! Compute rough symbol spectra for the JT9 decoder + ingain=0 + call timer('symspec ',0) + nminw=1 + call symspec(shared_data,k,Tperiod,nsps,ingain, & + bLowSidelobes,nminw,pxdb,s,df3,ihsym,npts8,pxdbmax) + call timer('symspec ',1) + endif + nhsym0=nhsym + if(nhsym.ge.181 .and. mode.ne.240 .and. mode.ne.241 .and. & + mode.ne.242 .and. mode.ne.66) exit + endif + enddo + close(unit=wav%lun) + shared_data%params%nutc=nutc + shared_data%params%ndiskdat=.true. + shared_data%params%ntr=TRperiod + shared_data%params%nfqso=nrxfreq + shared_data%params%newdat=.true. + shared_data%params%npts8=74736 + shared_data%params%nfa=flow + shared_data%params%nfsplit=fsplit + shared_data%params%nfb=fhigh + shared_data%params%ntol=ntol + shared_data%params%kin=64800 + if(mode.eq.240) shared_data%params%kin=720000 !### 60 s periods ### + shared_data%params%nzhsym=nhsym + shared_data%params%ndepth=ndepth + shared_data%params%lft8apon=.true. + shared_data%params%ljt65apon=.true. + shared_data%params%napwid=75 + shared_data%params%dttol=3. + if(mode.eq.164 .and. nsubmode.lt.100) nsubmode=nsubmode+100 + shared_data%params%nagain=.false. + shared_data%params%nclearave=.false. + shared_data%params%lapcqonly=.false. + shared_data%params%naggressive=0 + shared_data%params%n2pass=2 + shared_data%params%nQSOprogress=nQSOProg + shared_data%params%nranera=6 !### ntrials=3000 + shared_data%params%nrobust=.false. + shared_data%params%nexp_decode=nexp_decode + shared_data%params%mycall=transfer(mycall,shared_data%params%mycall) + shared_data%params%mygrid=transfer(mygrid,shared_data%params%mygrid) + shared_data%params%hiscall=transfer(hiscall,shared_data%params%hiscall) + shared_data%params%hisgrid=transfer(hisgrid,shared_data%params%hisgrid) + if (tx9) then + shared_data%params%ntxmode=9 + else + shared_data%params%ntxmode=65 + end if + if (mode.eq.0) then + shared_data%params%nmode=65+9 + else + shared_data%params%nmode=mode + end if + shared_data%params%nsubmode=nsubmode + +!### temporary, for MAP65: + if(mode.eq.66 .and. TRperiod.eq.60) shared_data%params%emedelay=2.5 + + datetime="2013-Apr-16 15:13" !### Temp + shared_data%params%datetime=transfer(datetime,shared_data%params%datetime) + if(mode.eq.9 .and. fsplit.ne.2700) shared_data%params%nfa=fsplit + if(mode.eq.8) then +! "Early" decoding pass, FT8 only, when jt9 reads data from disk + nearly=41 + shared_data%params%nzhsym=nearly + id2a(1:nearly*3456)=shared_data%id2(1:nearly*3456) + id2a(nearly*3456+1:)=0 + call multimode_decoder(shared_data%ss,id2a, & + shared_data%params,nfsample) + nearly=47 + shared_data%params%nzhsym=nearly + id2a(1:nearly*3456)=shared_data%id2(1:nearly*3456) + id2a(nearly*3456+1:)=0 + call multimode_decoder(shared_data%ss,id2a, & + shared_data%params,nfsample) + id2a(nearly*3456+1:50*3456)=shared_data%id2(nearly*3456+1:50*3456) + id2a(50*3456+1:)=0 + shared_data%params%nzhsym=50 + call multimode_decoder(shared_data%ss,id2a, & + shared_data%params,nfsample) + cycle + endif +! Normal decoding pass + call multimode_decoder(shared_data%ss,shared_data%id2, & + shared_data%params,nfsample) + enddo + + call timer('jt9 ',1) + call timer('jt9 ',101) + +999 continue +! Output decoder statistics + call fini_timer () +! Save FFTW wisdom and free memory + if(len(trim(wisfile)).gt.0) iret=fftwf_export_wisdom_to_filename(wisfile) + call four2a(a,-1,1,1,1) + call filbig(a,-1,1,0.0,0,0,0,0,0) !used for FFT plans + call fftwf_cleanup_threads() + call fftwf_cleanup() +end program jt9 diff --git a/wsjtx_lib/lib/jt9_decode.f90 b/wsjtx_lib/lib/jt9_decode.f90 new file mode 100644 index 0000000..d862504 --- /dev/null +++ b/wsjtx_lib/lib/jt9_decode.f90 @@ -0,0 +1,172 @@ +module jt9_decode + + type :: jt9_decoder + procedure(jt9_decode_callback), pointer :: callback + contains + procedure :: decode + end type jt9_decoder + + abstract interface + subroutine jt9_decode_callback (this, sync, snr, dt, freq, drift, & + decoded) + import jt9_decoder + implicit none + class(jt9_decoder), intent(inout) :: this + real, intent(in) :: sync + integer, intent(in) :: snr + real, intent(in) :: dt + real, intent(in) :: freq + integer, intent(in) :: drift + character(len=22), intent(in) :: decoded + end subroutine jt9_decode_callback + end interface + +contains + + subroutine decode(this,callback,ss,id2,nfqso,newdat,npts8,nfa, & + nfsplit,nfb,ntol,nzhsym,nagain,ndepth,nmode,nsubmode,nexp_decode) + use timer_module, only: timer + + include 'constants.f90' + class(jt9_decoder), intent(inout) :: this + procedure(jt9_decode_callback) :: callback + real ss(184,NSMAX) + logical, intent(in) :: newdat, nagain + character*22 msg + real*4 ccfred(NSMAX) + real*4 red2(NSMAX) + logical ccfok(NSMAX) + logical done(NSMAX) + integer*2 id2(NTMAX*12000) + integer*1 i1SoftSymbols(207) + common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano + save ccfred,red2 + + if(nexp_decode.eq.-99) stop !Silence compiler warning + this%callback => callback + if(nmode.eq.9 .and. nsubmode.ge.1) then + call decode9w(nfqso,ntol,nsubmode,ss,id2,sync,nsnr,xdt,freq,msg) + if (associated(this%callback)) then + ndrift=0 + call this%callback(sync,nsnr,xdt,freq,ndrift,msg) + end if + go to 999 + endif + + nsynced=0 + ndecoded=0 + nsps=6912 !Params for JT9-1 + df3=1500.0/2048.0 + + tstep=0.5*nsps/12000.0 !Half-symbol step (seconds) + done=.false. + + nf0=0 + nf1=nfa + if(nmode.eq.65+9) nf1=nfsplit + ia=max(1,nint((nf1-nf0)/df3)) + ib=min(NSMAX,nint((nfb-nf0)/df3)) + lag1=-int(2.5/tstep + 0.9999) + lag2=int(5.0/tstep + 0.9999) + if(newdat) then + call timer('sync9 ',0) + call sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipk) + call timer('sync9 ',1) + endif + + nsps8=nsps/8 + df8=1500.0/nsps8 + dblim=db(864.0/nsps8) - 26.2 + + ia1=1 !quel compiler gripe + ib1=1 !quel compiler gripe + do nqd=1,0,-1 + limit=5000 + ccflim=3.0 + red2lim=1.6 + schklim=2.2 + if(iand(ndepth,7).eq.2) then + limit=10000 + ccflim=2.7 + endif + if(iand(ndepth,7).eq.3 .or. nqd.eq.1) then + limit=30000 + ccflim=2.5 + schklim=2.0 + endif + if(nagain) then + limit=100000 + ccflim=2.4 + schklim=1.8 + endif + ccfok=.false. + + if(nqd.eq.1) then + nfa1=nfqso-ntol + nfb1=nfqso+ntol + ia=max(1,nint((nfa1-nf0)/df3)) + ib=min(NSMAX,nint((nfb1-nf0)/df3)) + ccfok(ia:ib)=(ccfred(ia:ib).gt.(ccflim-2.0)) .and. & + (red2(ia:ib).gt.(red2lim-1.0)) + ia1=ia + ib1=ib + else + nfa1=nf1 + nfb1=nfb + ia=max(1,nint((nfa1-nf0)/df3)) + ib=min(NSMAX,nint((nfb1-nf0)/df3)) + do i=ia,ib + ccfok(i)=ccfred(i).gt.ccflim .and. red2(i).gt.red2lim + enddo + ccfok(ia1:ib1)=.false. + endif + + fgood=0. + do i=ia,ib + if(done(i) .or. (.not.ccfok(i))) cycle + f=(i-1)*df3 + if(nqd.eq.1 .or. & + (ccfred(i).ge.ccflim .and. abs(f-fgood).gt.10.0*df8)) then + + call timer('softsym ',0) + fpk=nf0 + df3*(i-1) + call softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, & + freq,drift,a3,schk,i1SoftSymbols) + call timer('softsym ',1) + + sync=(syncpk+1)/4.0 + if(nqd.eq.1 .and. ((sync.lt.0.5) .or. (schk.lt.1.0))) cycle + if(nqd.ne.1 .and. ((sync.lt.1.0) .or. (schk.lt.1.5))) cycle + + call timer('jt9fano ',0) + call jt9fano(i1SoftSymbols,limit,nlim,msg) + call timer('jt9fano ',1) + + if(sync.lt.0.0 .or. snrdb.lt.dblim-2.0) sync=0.0 + nsync=int(sync) + if(nsync.gt.10) nsync=10 + nsnr=nint(snrdb) + ndrift=nint(drift/df3) + num9=num9+1 + + if(msg.ne.' ') then + numfano=numfano+1 + if (associated(this%callback)) then + call this%callback(sync,nsnr,xdt,freq,ndrift,msg) + end if + iaa=max(1,i-1) + ibb=min(NSMAX,i+22) + fgood=f + nsynced=1 + ndecoded=1 + ccfok(iaa:ibb)=.false. + done(iaa:ibb)=.true. + endif + endif + enddo + if(nagain) exit + enddo + +999 return + end subroutine decode +end module jt9_decode diff --git a/wsjtx_lib/lib/jt9a.f90 b/wsjtx_lib/lib/jt9a.f90 new file mode 100644 index 0000000..f9399f4 --- /dev/null +++ b/wsjtx_lib/lib/jt9a.f90 @@ -0,0 +1,95 @@ +subroutine jt9a() + use, intrinsic :: iso_c_binding, only: c_f_pointer, c_null_char, c_bool + use prog_args + use timer_module, only: timer + use timer_impl, only: init_timer !, limtrace + use shmem + + include 'jt9com.f90' + + integer*2 id2a(180000) +! Multiple instances: + type(dec_data), pointer, volatile :: shared_data !also makes target volatile + type(params_block) :: local_params + logical(c_bool) :: ok + + call init_timer (trim(data_dir)//'/timer.out') +! open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown') + +! limtrace=-1 !Disable all calls to timer() + +! Multiple instances: set the shared memory key before attaching + call shmem_setkey(trim(shm_key)//c_null_char) + ok=shmem_attach() + if(.not.ok) call abort + msdelay=30 + call c_f_pointer(shmem_address(),shared_data) + +! Terminate if ipc(2) is 999 +10 ok=shmem_lock() + if(.not.ok) call abort + if(shared_data%ipc(2).eq.999.0) then + ok=shmem_unlock() + ok=shmem_detach() + go to 999 + endif +! Wait here until GUI has set ipc(2) to 1 + if(shared_data%ipc(2).ne.1) then + ok=shmem_unlock() + if(.not.ok) call abort + call sleep_msec(msdelay) + go to 10 + endif + shared_data%ipc(2)=0 + + nbytes=shmem_size() + if(nbytes.le.0) then + ok=shmem_unlock() + ok=shmem_detach() + print*,'jt9a: Shared memory does not exist.' + print*,"Must start 'jt9 -s ' from within WSJT-X." + go to 999 + endif + local_params=shared_data%params !save a copy because wsjtx carries on accessing + ok=shmem_unlock() + if(.not.ok) call abort + call flush(6) + call timer('decoder ',0) + if(local_params%nmode.eq.8 .and. local_params%ndiskdat .and. & + .not. local_params%nagain) then +! Early decoding pass, FT8 only, when wsjtx reads from disk + nearly=41 + local_params%nzhsym=nearly + id2a(1:nearly*3456)=shared_data%id2(1:nearly*3456) + id2a(nearly*3456+1:)=0 + call multimode_decoder(shared_data%ss,id2a,local_params,12000) + nearly=47 + local_params%nzhsym=nearly + id2a(1:nearly*3456)=shared_data%id2(1:nearly*3456) + id2a(nearly*3456+1:)=0 + call multimode_decoder(shared_data%ss,id2a,local_params,12000) + local_params%nzhsym=50 + endif +! Normal decoding pass + call multimode_decoder(shared_data%ss,shared_data%id2,local_params,12000) + call timer('decoder ',1) + + +! Wait here until GUI routine decodeDone() has set ipc(3) to 1 +100 ok=shmem_lock() + if(.not.ok) call abort + if(shared_data%ipc(3).ne.1) then + ok=shmem_unlock() + if(.not.ok) call abort + call sleep_msec(msdelay) + go to 100 + endif + shared_data%ipc(3)=0 + ok=shmem_unlock() + if(.not.ok) call abort + go to 10 + +999 call timer('decoder ',101) + + return +end subroutine jt9a diff --git a/wsjtx_lib/lib/jt9code.f90 b/wsjtx_lib/lib/jt9code.f90 new file mode 100644 index 0000000..0ab96d8 --- /dev/null +++ b/wsjtx_lib/lib/jt9code.f90 @@ -0,0 +1,86 @@ +program jt9code + +! Generate simulated data for testing of WSJT-X + + character*22 msg,msgchk,msg0,msg1,decoded,cok*3,bad*1,msgtype*10,expected + integer*4 i4tone(85) !Channel symbols (values 0-8) + include 'testmsg.f90' + include 'jt9sync.f90' + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: jt9code "message"' + print*,' jt9code -t' + go to 999 + endif + + call getarg(1,msg) + nmsg=1 + if(msg(1:2).eq."-t") then + if (NTEST+5 > MAXTEST) then + write(*,*) "NTEST exceed MAXTEST" + endif + testmsg(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" + testmsg(NTEST+2)="KA1ABC WB9XYZ OOO" + testmsg(NTEST+3)="RO" + testmsg(NTEST+4)="RRR" + testmsg(NTEST+5)="73" + testmsgchk(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" + testmsgchk(NTEST+2)="KA1ABC WB9XYZ OOO" + testmsgchk(NTEST+3)="RO" + testmsgchk(NTEST+4)="RRR" + testmsgchk(NTEST+5)="73" + nmsg=NTEST+5 + endif + + write(*,1010) +1010 format(" Message Decoded Err? Type Expected"/ & + 76("-")) + do imsg=1,nmsg + if(nmsg.gt.1) then + msg=testmsg(imsg) + msgchk=testmsgchk(imsg) + endif + call fmtmsg(msg,iz) !To upper case, collapse multiple blanks + msg0=msg + ichk=0 + call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report + msg1=msg !Message without "OOO" + + if(nspecial.gt.0) then !or is a shorthand message + if(nspecial.eq.2) decoded="RO" + if(nspecial.eq.3) decoded="RRR" + if(nspecial.eq.4) decoded="73" + itype=-1 + msgtype="Shorthand" + go to 10 + endif + + call gen9(msg,ichk,decoded,i4tone,itype) !Encode message into tone #s + + msgtype="" + if(itype.eq.1) msgtype="Std Msg" + if(itype.eq.2) msgtype="Type 1 pfx" + if(itype.eq.3) msgtype="Type 1 sfx" + if(itype.eq.4) msgtype="Type 2 pfx" + if(itype.eq.5) msgtype="Type 2 sfx" + if(itype.eq.6) msgtype="Free text" + + if(cok.eq."OOO") decoded(20:22)=cok + call fmtmsg(decoded,iz) + +10 bad=" " + expected = 'EXACT' + if(decoded.ne.msg0) then + bad="*" + if(decoded(1:13).eq.msg0(1:13) .and. & + decoded(14:22).eq. ' ') expected = 'TRUNCATED' + endif + write(*,1020) imsg,msg0,decoded,bad,itype,msgtype,expected +1020 format(i2,'.',1x,a22,1x,a22,1x,a1,i3,":",a10,2x,a22) + enddo + + if(nmsg.eq.1) write(*,1030) i4tone +1030 format(/'Channel symbols'/(30i2)) + +999 end program jt9code diff --git a/wsjtx_lib/lib/jt9com.f90 b/wsjtx_lib/lib/jt9com.f90 new file mode 100644 index 0000000..5b2970c --- /dev/null +++ b/wsjtx_lib/lib/jt9com.f90 @@ -0,0 +1,59 @@ + use, intrinsic :: iso_c_binding, only: c_int, c_short, c_float, c_char, c_bool + + include 'constants.f90' + + ! + ! these structures must be kept in sync with ../commons.h + ! + type, bind(C) :: params_block + integer(c_int) :: nutc + logical(c_bool) :: ndiskdat + integer(c_int) :: ntr + integer(c_int) :: nQSOProgress ! See MainWindow::m_QSOProgress for values + integer(c_int) :: nfqso + integer(c_int) :: nftx + logical(c_bool) :: newdat + integer(c_int) :: npts8 + integer(c_int) :: nfa + integer(c_int) :: nfsplit + integer(c_int) :: nfb + integer(c_int) :: ntol + integer(c_int) :: kin + integer(c_int) :: nzhsym + integer(c_int) :: nsubmode + logical(c_bool) :: nagain + integer(c_int) :: ndepth + logical(c_bool) :: lft8apon + logical(c_bool) :: lapcqonly + logical(c_bool) :: ljt65apon + integer(c_int) :: napwid + integer(c_int) :: ntxmode + integer(c_int) :: nmode + integer(c_int) :: minw + logical(c_bool) :: nclearave + integer(c_int) :: minsync + real(c_float) :: emedelay + real(c_float) :: dttol + integer(c_int) :: nlist + integer(c_int) :: listutc(10) + integer(c_int) :: n2pass + integer(c_int) :: nranera + integer(c_int) :: naggressive + logical(c_bool) :: nrobust + integer(c_int) :: nexp_decode + integer(c_int) :: max_drift + character(kind=c_char) :: datetime(20) + character(kind=c_char) :: mycall(12) + character(kind=c_char) :: mygrid(6) + character(kind=c_char) :: hiscall(12) + character(kind=c_char) :: hisgrid(6) + end type params_block + + type, bind(C) :: dec_data + integer(c_int) :: ipc(3) + real(c_float) :: ss(184,NSMAX) + real(c_float) :: savg(NSMAX) + real(c_float) :: sred(5760) + integer(c_short) :: id2(NMAX) + type(params_block) :: params + end type dec_data diff --git a/wsjtx_lib/lib/jt9fano.f90 b/wsjtx_lib/lib/jt9fano.f90 new file mode 100644 index 0000000..7ac1f3a --- /dev/null +++ b/wsjtx_lib/lib/jt9fano.f90 @@ -0,0 +1,92 @@ +subroutine jt9fano(i1SoftSymbols,limit,nlim,msg) + +! Decoder for JT9 +! Input: i1SoftSymbols(207) - Single-bit soft symbols +! Output: msg - decoded message (blank if erasure) + + use packjt + character*22 msg + integer*4 i4DecodedBytes(9) + integer*4 i4Decoded6BitWords(12) + integer*1 i1DecodedBytes(13) !72 bits and zero tail as 8-bit bytes + integer*1 i1SoftSymbols(207) + integer*1 i1DecodedBits(72) + + real*4 xx0(0:262) + + logical first + integer*4 mettab(-128:127,0:1) + data first/.true./ + 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, & + 1.43370769e-019,2.64031087e-006,6.25548654e+028, & + 2.44565251e+020,4.74227538e+030,10497312.,7.74079654e-039/ + save + + if(first) then +! Get the metric table + bias=0.5 + scale=50 + ndelta=nint(3.4*scale) + ib=160 !Break point + slope=2 !Slope beyond break + 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) + first=.false. + endif + + msg=' ' + nbits=72 + call fano232(i1SoftSymbols,nbits+31,mettab,ndelta,limit,i1DecodedBytes, & + ncycles,metric,ierr) + + nlim=ncycles/(nbits+31) + if(ncycles.lt.((nbits+31)*limit)) then + nbytes=(nbits+7)/8 + do i=1,nbytes + n=i1DecodedBytes(i) + i4DecodedBytes(i)=iand(n,255) + enddo + call unpackbits(i4DecodedBytes,nbytes,8,i1DecodedBits) + call packbits(i1DecodedBits,12,6,i4Decoded6BitWords) + call unpackmsg(i4Decoded6BitWords,msg) !Unpack decoded msg + if(index(msg,'000AAA ').gt.0) msg=' ' + endif + + return +end subroutine jt9fano diff --git a/wsjtx_lib/lib/jt9sim.f90 b/wsjtx_lib/lib/jt9sim.f90 new file mode 100644 index 0000000..e195b40 --- /dev/null +++ b/wsjtx_lib/lib/jt9sim.f90 @@ -0,0 +1,175 @@ +program jt9sim + +! Generate simulated data for testing of WSJT-X + + use wavhdr + use packjt + parameter (NTMAX=120) + parameter (NMAX=NTMAX*12000) + type(hdr) h + integer*2 iwave(NMAX) !Generated waveform (no noise) + real*4 dat(NMAX) + real*8 f0,f,dt,twopi,phi,dphi,baud,fspan,fsample,freq + character msg*22,msg0*22,message*22,msgsent*22,arg*8,fname*11 + + integer*4 i4tone(85) !Channel symbols (values 0-8) + integer*4 i4DataSymNoGray(69) !Data Symbols, values 0-7 + integer*1 i1ScrambledBits(207) !Unpacked bits, scrambled order + integer*1 i1Bits(207) !Encoded information-carrying bits + integer*1 i1SoftSymbols(207) + include 'jt9sync.f90' + + nargs=iargc() + if(nargs.ne.6) then + print*,'Usage: jt9sim "message" fspan nsigs minutes SNR nfiles' + print*,'Example: jt9sim "CQ K1ABC FN42" 200 20 2 -28 1' + print*,' ' + print*,'Enter message = "" to use entries in msgs.txt.' + print*,'Enter SNR = 0 to generate a range of SNRs.' + print*,'Enter SNR = 99 to generate a noiseless signal at frequency fspan' + go to 999 + endif + + call getarg(1,msg0) + call fmtmsg(msg0,iz) + message=msg0 !Transmitted message + call getarg(2,arg) + read(arg,*) fspan !Total freq range (Hz) + call getarg(3,arg) + read(arg,*) nsigs !Number of signals in each file + call getarg(4,arg) + read(arg,*) minutes !Length of file (1 2 5 10 30 minutes) + call getarg(5,arg) + read(arg,*) snrdb !S/N in dB (2500 hz reference BW) + call getarg(6,arg) + read(arg,*) nfiles !Number of files + + rmsdb=25. + rms=10.0**(0.05*rmsdb) + fsample=12000.d0 !Sample rate (Hz) + dt=1.d0/fsample !Sample interval (s) + twopi=8.d0*atan(1.d0) + npts=12000*(60*minutes-6) + nsps=0 + if(minutes.eq.1) nsps=6912 + if(minutes.eq.2) nsps=15360 + if(minutes.eq.5) nsps=40960 + if(minutes.eq.10) nsps=82944 + if(minutes.eq.30) nsps=252000 + if(nsps.eq.0) stop 'Bad value for minutes.' + + f0=1400.d0 !Center frequency (Hz) +! f0=3000.d0 !Center frequency (Hz) + +! f0=1500.0 +! if(minutes.eq.5) f0=1100. +! if(minutes.eq.10) f0=1050. +! if(minutes.eq.30) f0=1025. + + + call init_random_seed() ! seed Fortran RANDOM_NUMBER generator + call sgran() ! see C rand generator (used in gran) + + h=default_header(12000,npts) + k=0 !Silence compiler warning + + if(msg0(1:3).eq.'sin') read(msg0(4:),*) sinfreq + + if(message.eq."") open(12,file='msgs.txt',status='old') + + write(*,1000) +1000 format('File N freq S/N Message'/ & + '---------------------------------------------------') + + do ifile=1,nfiles !Loop over all files + nmin=(ifile-1)*minutes + ihr=nmin/60 + imin=mod(nmin,60) + write(fname,1002) ihr,imin !Create output filename +1002 format('000000_',2i2.2) + open(10,file=fname//'.wav',access='stream',status='unknown') + + if(snrdb.lt.90) then + do i=1,npts + dat(i)=gran() + enddo + else + dat(1:npts)=0. + endif + + if(msg0.ne.' ') then + call gen9(message,0,msgsent,i4tone,itype) !Encode message into tone #s + endif + + rewind 12 + do isig=1,nsigs !Loop over multiple signals + + if(msg0.eq.' ') then + read(12,1004) message !Use pre-generated message texts +1004 format(a22) + call gen9(message,0,msgsent,i4tone,itype) + endif + + f=f0 + if(nsigs.gt.1) f=f0 - 0.5d0*fspan + fspan*(isig-1.d0)/(nsigs-1.d0) + snrdbx=snrdb +! snrdbx=snrdb + (ifile-1)*4.0 + sig=10.0**(0.05*snrdbx) + if(snrdb.gt.90.0) sig=1.0 + write(*,1020) ifile,isig,f,snrdbx,msgsent +1020 format(i3,i4,f10.3,f7.1,2x,a22) + + phi=0. + baud=12000.d0/nsps + k=12000 !Start audio at t = 1.0 s +! f1=0.0001 * (ifile-1) + f1=0. +! print*,ifile-1,f1 + dphi2=0. + ddphi2=twopi*f1*dt/60.0 + do isym=1,85 + freq=f + i4tone(isym)*baud + if(msg0(1:3).eq.'sin') freq=sinfreq + dphi=twopi*freq*dt + dphi2 + do i=1,nsps + phi=phi + dphi + dphi2=dphi2 + ddphi2 + if(phi.lt.-twopi) phi=phi+twopi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + k=k+1 + dat(k)=dat(k) + sig*sin(xphi) !Use lookup table for i*2 sin(x) ? + enddo + enddo + enddo + + fac=32767.0/nsigs + if(snrdb.ge.90.0) iwave(1:npts)=nint(fac*dat(1:npts)) + if(snrdb.lt.90.0) iwave(1:npts)=nint(rms*dat(1:npts)) + + write(10) h,iwave(1:npts) + close(10) + +! We're done! Now decode the data symbols from i4tone, as a test. + if(msg0.ne.' ') then + j=0 + do i=1,85 + if(isync(i).eq.1) cycle + j=j+1 + i4DataSymNoGray(j)=igray(i4tone(i)-1,-1) + enddo + call unpackbits(i4DataSymNoGray,69,3,i1ScrambledBits) + call interleave9(i1ScrambledBits,-1,i1Bits) + + do i=1,206 + i4=-10 + if(i1Bits(i).eq.1) i4=10 + i1SoftSymbols(i)=i4 + enddo + limit=1000 + call jt9fano(i1SoftSymbols,limit,nlim,msg) + if(msg.ne.msg0) print*,'Decode error: ',msg0,' ',msg + endif + enddo + +999 end program jt9sim diff --git a/wsjtx_lib/lib/jt9sync.f90 b/wsjtx_lib/lib/jt9sync.f90 new file mode 100644 index 0000000..34b7e19 --- /dev/null +++ b/wsjtx_lib/lib/jt9sync.f90 @@ -0,0 +1,18 @@ + integer ii(16) !Locations of sync symbols + data ii/ 1,2,5,10,16,23,33,35,51,52,55,60,66,73,83,85/ + + integer ii2(16) !Locations of sync half-symbols + data ii2/1,3,9,19,31,45,65,69,101,103,109,119,131,145,165,169/ + + integer ka(16),kb(16) !Reference symbols for sync + data ka/5,5,11,21,33,47,63,71,97,105,111,121,133,147,159,163/ + data kb/7,7,13,23,35,49,67,73,99,107,113,123,135,149,161,167/ + + + integer isync(85) !Sync vector + data isync/ & + 1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0, & + 0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,0,0,0,0,1, & + 0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + 0,0,1,0,1/ diff --git a/wsjtx_lib/lib/jt9w.f90 b/wsjtx_lib/lib/jt9w.f90 new file mode 100644 index 0000000..47623e7 --- /dev/null +++ b/wsjtx_lib/lib/jt9w.f90 @@ -0,0 +1,28 @@ +program jt9w + + parameter (NSMAX=6827,NZMAX=60*12000) + real ss(184,NSMAX) + real ref(NSMAX) + integer*2 id2(NZMAX) + character*12 arg + character*22 decoded + + call getarg(1,arg) + read(arg,*) iutc + + open(20,file='refspec.dat',status='old') + do i=1,NSMAX + read(20,*) j,freq,ref(i) + enddo + + do ifile=1,999 + read(60,end=999) nutc,nfqso,ntol,ndepth,nmode,nsubmode,ss,id2 + if(nutc.ne.iutc) cycle + ntol=100 + call decode9w(nutc,nfqso,ntol,nsubmode,ss,id2,sync,nsnr,xdt,freq,decoded) + write(*,1100) nutc,nsnr,xdt1-1.0,nint(freq),decoded +1100 format(i4.4,i4,f5.1,i5,1x,'@',1x,a22) + exit + enddo + +999 end program jt9w diff --git a/wsjtx_lib/lib/jtmsg.f90 b/wsjtx_lib/lib/jtmsg.f90 new file mode 100644 index 0000000..8c21213 --- /dev/null +++ b/wsjtx_lib/lib/jtmsg.f90 @@ -0,0 +1,131 @@ +subroutine jtmsg(msg,iflag) + +! Attempts to identify false decodes in JT-style messages. + +! Returns iflag with sum of bits as follows: +! ------------------------------------------ +! 1 Grid/Report invalid +! 2 Second callsign invalid +! 4 First callsign invalid +! 8 Very unlikely free text +! 16 Questionable free text +! 0 Message is probably OK +! ------------------------------------------ + + character*22 msg,t + character*13 w1,w2,w3,w + character*6 bc1,bc2,bc3 + character*1 c + logical c1ok,c2ok,c3ok,isdigit,isletter,isgrid4 + +! Statement functions + isdigit(c)=(ichar(c).ge.ichar('0')) .and. (ichar(c).le.ichar('9')) + isletter(c)=(ichar(c).ge.ichar('A')) .and. (ichar(c).le.ichar('Z')) + isgrid4(w)=(len_trim(w).eq.4 .and. & + ichar(w(1:1)).ge.ichar('A') .and. ichar(w(1:1)).le.ichar('R') .and. & + ichar(w(2:2)).ge.ichar('A') .and. ichar(w(2:2)).le.ichar('R') .and. & + ichar(w(3:3)).ge.ichar('0') .and. ichar(w(3:3)).le.ichar('9') .and. & + ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9')) + + t=trim(msg) !Temporary copy of msg + nt=len_trim(t) + +! Check for standard messages +! Insert underscore in "CQ AA " to "CQ ZZ ", "CQ nnn " to make them one word. + if(t(1:3).eq.'CQ ' .and. isletter(t(4:4)) .and. & + isletter(t(5:5)) .and. t(6:6).eq.' ') t(3:3)='_' + if(t(1:3).eq.'CQ ' .and. isdigit(t(4:4)) .and. & + isdigit(t(5:5)) .and. isdigit(t(6:6)) .and. t(7:7).eq.' ') t(3:3)='_' + +! Parse first three words + w1=' ' + w2=' ' + w3=' ' + i1=index(t,' ') + if(i1.gt.0) w1(1:i1-1)=t(1:i1-1) + t=t(i1+1:) + i2=index(t,' ') + if(i2.gt.0) w2(1:i2-1)=t(1:i2-1) + t=t(i2+1:) + i3=index(t,' ') + if(i3.gt.0) w3(1:i3-1)=t(1:i3-1) + + if(w1(1:3).eq.'CQ ' .or. w1(1:3).eq.'CQ_' .or. w1(1:3).eq.'DE ' .or. & + w1(1:4).eq.'QRZ ') then +! CQ/DE/QRZ: Should have one good callsign in w2 and maybe a grid/rpt in w3 + call chkcall(w2,bc2,c2ok) + iflag=0 + if(.not.c2ok) iflag=iflag+2 + if(len_trim(w3).ne.0 .and. (.not.isgrid4(w3))) iflag=iflag+1 + if(w1(1:3).eq.'DE ' .and. c2ok) iflag=0 + if(iflag.eq.0) return + endif + +! Check for two calls and maybe a grid, rpt, R+rpr, RRR, or 73 + iflag=0 + call chkcall(w1,bc1,c1ok) + call chkcall(w2,bc2,c2ok) + if(.not.c1ok) iflag=iflag+4 + if(.not.c2ok) iflag=iflag+2 + if(len_trim(w3).ne.0 .and. (.not.isgrid4(w3)) .and. & + w3(1:1).ne.'+' .and. w3(1:1).ne.'-' .and. & + w3(1:2).ne.'R+' .and. w3(1:2).ne.'R-' .and. & + w3(1:3).ne.'73 ' .and. w3(1:4).ne.'RRR ') iflag=iflag+1 + call chkcall(w3,bc3,c3ok) +! Allow(?) non-standard messages of the form CQ AS OC K1JT + if(w1(1:3).eq.'CQ_'.and.isletter(w2(1:1)).and.isletter(w2(2:2)).and. & + w2(3:3).eq.' '.and.c3ok) iflag=0 + if(iflag.eq.0 .or. nt.gt.13) return + +! Check for plausible free text + + nc=0 + np=0 + do i=1,13 + c=msg(i:i) + if(c.ne.' ') nc=nc+1 !Number of non-blank characters + if(c.eq.'+') np=np+1 !Number of punctuation characters + if(c.eq.'-') np=np+1 + if(c.eq.'.') np=np+1 + if(c.eq.'/') np=np+1 + if(c.eq.'?') np=np+1 + enddo + nb=13-nc !Number of blanks + iflag=16 !Mark as potentially questionable + if(nc.ge.12 .or. (nc.ge.11 .and. np.gt.0)) then + iflag=8 !Unlikely free text, flag it + endif + +! Save messages containing some common words + if(msg(1:3).eq.'CQ ') iflag=0 + if(index(msg,'DE ').gt.0) iflag=0 + if(index(msg,'TU ').gt.0) iflag=0 + if(index(msg,' TU').gt.0) iflag=0 + if(index(msg,'73 ').gt.0) iflag=0 + if(index(msg,' 73').gt.0) iflag=0 + if(index(msg,'TNX').gt.0) iflag=0 + if(index(msg,'THX').gt.0) iflag=0 + if(index(msg,'EQSL').gt.0) iflag=0 + if(index(msg,'LOTW').gt.0) iflag=0 + if(index(msg,'DECOD').gt.0) iflag=0 + if(index(msg,'CHK').gt.0) iflag=0 + if(index(msg,'CLK').gt.0) iflag=0 + if(index(msg,'CLOCK').gt.0) iflag=0 + if(index(msg,'LOG').gt.0) iflag=0 + if(index(msg,'QRM').gt.0) iflag=0 + if(index(msg,'QSY').gt.0) iflag=0 + if(index(msg,'TEST').gt.0) iflag=0 + if(index(msg,'CQDX').gt.0) iflag=0 + if(index(msg,'CALL').gt.0) iflag=0 + if(index(msg,'QRZ').gt.0) iflag=0 + if(index(msg,'AUTO').gt.0) iflag=0 + if(index(msg,'PHOTO').gt.0) iflag=0 + if(index(msg,'HYBRID').gt.0) iflag=0 + + if(c1ok .and. w1(1:6).eq.bc1) iflag=0 + if(c2ok .and. w2(1:6).eq.bc2) iflag=0 + + if(nb.ge.4) iflag=0 + + return +end subroutine jtmsg diff --git a/wsjtx_lib/lib/ldpc32_table.c b/wsjtx_lib/lib/ldpc32_table.c new file mode 100644 index 0000000..4dce20a --- /dev/null +++ b/wsjtx_lib/lib/ldpc32_table.c @@ -0,0 +1,30 @@ +void ldpc32_table_(int cw[]) +{ + // Compute and return the table of 65535 codewords for the (32,16) code. + + // Array y contains the sixteen rows (columns) of the parity-check matrix + int y[16] = { 0xd452, 0x7ecb, 0xc5d5, 0xf81c, + 0x61d7, 0x0ed8, 0xa3c5, 0x9ef9, + 0xb3bd, 0xe5b6, 0x2fcd, 0xc23a, + 0x5deb, 0xfa0e, 0x35fc, 0x1379 }; + + unsigned int c[2]; /* Codeword composed of 16-bit info and 16-bit parity */ + + + int i,j,k; + int aux; + int weight(int vector); + + for(k=0; k<65536; k++) { + c[0] = k; + c[1] = 0; + for (i=0; i<16; i++) { + aux = 0; + for (j=0; j<16; j++) { + aux = aux ^ ((c[0] & y[i]) >> j & 1); + } + c[1] = (c[1] << 1) ^ aux; + } + cw[k]=65536*c[1] + c[0]; + } +} diff --git a/wsjtx_lib/lib/ldpc_128_90_b_generator.f90 b/wsjtx_lib/lib/ldpc_128_90_b_generator.f90 new file mode 100644 index 0000000..97cb2b8 --- /dev/null +++ b/wsjtx_lib/lib/ldpc_128_90_b_generator.f90 @@ -0,0 +1,41 @@ +character*23 g(38) + +data g/ & + "c555076254d8161b5cf0d3c", & + "de721b14e8339ab48de8e54", & + "e72d0efb6ca44934a896ca0", & + "631b7cc783a5e626c360598", & + "7050206b9b2e40439d17d94", & + "2f31c22ab472282d65cde44", & + "822baa20e8bcd6487d34268", & + "f9a85b9d103459b8ac34830", & + "60335e63618f9e59e031a5c", & + "b106c464771df41ab75884c", & + "3936fcebf87320d200e6b1c", & + "00135e63218f1c59c031e5c", & + "554abf55a1605425b8e8248", & + "2211850e5b32c02e42c85ec", & + "853e66d64fdf2f5cf4237a8", & + "90592d932a0c8e8190e6c50", & + "d0cdf8954d48457b6a43df0", & + "83714b5735b5bcd718887f0", & + "3146c024731df43a3750844", & + "a231a50e5232c0ae40c8dac", & + "8f5f0d73fab5d0d57bb9c48", & + "5650a8094847925466e560c", & + "5842d5c55ff32151f36ca3c", & + "0f571d7bfab4d0c57bfbcc8", & + "bb68edb9987ea6a4f56a214", & + "9d7cb35b100c0e8d07cff80", & + "6774a36c46e8d7b518780b0", & + "b07ca6f22cc3db62ca73fac", & + "d6610575c99c82edcddd028", & + "e64c7bb5d67de03d1fb0824", & + "e9bb04fe35bb65a16e856ec", & + "6c5c41bc591174e3b81e950", & + "49b480238e0623d1dd61e08", & + "c48ae6d581d94c8c2b4a8a0", & + "a16ace594ec778f95e5020c", & + "ef2cd3309b2a4e8e9a98614", & + "06008a62f368d236fbf2998", & + "015fe1f7dd017a9f67be59c"/ diff --git a/wsjtx_lib/lib/ldpc_128_90_b_reordered_parity.f90 b/wsjtx_lib/lib/ldpc_128_90_b_reordered_parity.f90 new file mode 100644 index 0000000..c46719b --- /dev/null +++ b/wsjtx_lib/lib/ldpc_128_90_b_reordered_parity.f90 @@ -0,0 +1,184 @@ +data Mn/ & + 10, 25, 37, 0, & + 1, 19, 20, 0, & + 20, 27, 29, 0, & + 3, 22, 36, 0, & + 4, 26, 30, 0, & + 5, 15, 28, 0, & + 6, 21, 23, 0, & + 7, 16, 32, 0, & + 9, 31, 38, 0, & + 10, 13, 18, 0, & + 11, 20, 37, 0, & + 12, 24, 33, 0, & + 14, 25, 33, 0, & + 15, 17, 32, 0, & + 1, 9, 14, 0, & + 2, 16, 17, 0, & + 3, 5, 18, 0, & + 4, 23, 38, 0, & + 6, 24, 37, 0, & + 7, 25, 35, 0, & + 8, 29, 33, 0, & + 10, 30, 36, 0, & + 11, 27, 28, 0, & + 12, 22, 32, 0, & + 13, 17, 21, 0, & + 10, 19, 31, 0, & + 18, 26, 34, 0, & + 1, 5, 30, 0, & + 2, 19, 25, 0, & + 3, 9, 21, 0, & + 4, 8, 11, 0, & + 6, 35, 38, 0, & + 7, 13, 29, 0, & + 12, 20, 26, 0, & + 14, 24, 27, 0, & + 15, 23, 34, 0, & + 16, 31, 37, 0, & + 10, 22, 28, 0, & + 28, 34, 36, 0, & + 1, 37, 38, 0, & + 2, 5, 13, 0, & + 3, 7, 14, 0, & + 4, 16, 19, 0, & + 6, 18, 29, 0, & + 8, 17, 23, 0, & + 9, 33, 36, 0, & + 11, 12, 35, 0, & + 15, 25, 27, 0, & + 20, 30, 32, 0, & + 21, 24, 26, 0, & + 22, 31, 33, 0, & + 1, 3, 17, 0, & + 2, 8, 36, 0, & + 4, 14, 34, 0, & + 5, 20, 24, 0, & + 6, 12, 30, 0, & + 7, 19, 37, 0, & + 9, 22, 23, 0, & + 10, 27, 35, 0, & + 11, 25, 38, 0, & + 13, 28, 31, 0, & + 11, 15, 29, 0, & + 16, 18, 21, 0, & + 26, 27, 32, 0, & + 1, 4, 10, 0, & + 2, 9, 29, 32, & + 3, 6, 20, 33, & + 5, 21, 31, 34, & + 7, 8, 15, 30, & + 12, 13, 14, 16, & + 17, 22, 26, 37, & + 15, 18, 36, 38, & + 19, 22, 24, 35, & + 12, 23, 25, 28, & + 1, 13, 32, 33, & + 2, 11, 14, 18, & + 3, 10, 26, 38, & + 4, 24, 31, 32, & + 5, 6, 17, 25, & + 7, 9, 24, 28, & + 8, 9, 34, 37, & + 16, 20, 23, 35, & + 19, 21, 27, 30, & + 16, 26, 29, 36, & + 1, 22, 25, 29, & + 2, 3, 15, 37, & + 4, 12, 21, 36, & + 5, 8, 14, 19, & + 6, 7, 10, 34, & + 11, 17, 19, 33, & + 1, 12, 31, 0, & + 2, 4, 33, 0, & + 3, 16, 30, 0, & + 1, 2, 24, 0, & + 5, 23, 27, 0, & + 6, 28, 32, 0, & + 7, 17, 36, 0, & + 8, 22, 38, 0, & + 9, 18, 20, 0, & + 10, 21, 29, 0, & + 11, 13, 34, 0, & + 4, 20, 22, 0, & + 7, 11, 21, 0, & + 14, 35, 37, 0, & + 15, 19, 26, 0, & + 3, 28, 29, 0, & + 9, 13, 35, 0, & + 14, 17, 30, 0, & + 10, 15, 33, 0, & + 5, 12, 37, 0, & + 18, 25, 32, 0, & + 8, 16, 27, 0, & + 19, 34, 38, 0, & + 24, 25, 36, 0, & + 2, 28, 35, 0, & + 19, 23, 36, 0, & + 3, 12, 34, 0, & + 9, 15, 16, 0, & + 4, 5, 7, 0, & + 1, 8, 21, 0, & + 6, 13, 22, 0, & + 11, 24, 30, 0, & + 8, 26, 35, 0, & + 6, 26, 31, 0, & + 14, 32, 38, 0, & + 18, 23, 33, 0, & + 2, 27, 34, 0, & + 17, 29, 31, 0/ + +data Nm/ & + 2, 15, 28, 40, 52, 65, 75, 85, 91, 94, 120, 0, & + 16, 29, 41, 53, 66, 76, 86, 92, 94, 115, 127, 0, & + 4, 17, 30, 42, 52, 67, 77, 86, 93, 106, 117, 0, & + 5, 18, 31, 43, 54, 65, 78, 87, 92, 102, 119, 0, & + 6, 17, 28, 41, 55, 68, 79, 88, 95, 110, 119, 0, & + 7, 19, 32, 44, 56, 67, 79, 89, 96, 121, 124, 0, & + 8, 20, 33, 42, 57, 69, 80, 89, 97, 103, 119, 0, & + 21, 31, 45, 53, 69, 81, 88, 98, 112, 120, 123, 0, & + 9, 15, 30, 46, 58, 66, 80, 81, 99, 107, 118, 0, & + 1, 10, 22, 26, 38, 59, 65, 77, 89, 100, 109, 0, & + 11, 23, 31, 47, 60, 62, 76, 90, 101, 103, 122, 0, & + 12, 24, 34, 47, 56, 70, 74, 87, 91, 110, 117, 0, & + 10, 25, 33, 41, 61, 70, 75, 101, 107, 121, 0, 0, & + 13, 15, 35, 42, 54, 70, 76, 88, 104, 108, 125, 0, & + 6, 14, 36, 48, 62, 69, 72, 86, 105, 109, 118, 0, & + 8, 16, 37, 43, 63, 70, 82, 84, 93, 112, 118, 0, & + 14, 16, 25, 45, 52, 71, 79, 90, 97, 108, 128, 0, & + 10, 17, 27, 44, 63, 72, 76, 99, 111, 126, 0, 0, & + 2, 26, 29, 43, 57, 73, 83, 88, 90, 105, 113, 116, & + 2, 3, 11, 34, 49, 55, 67, 82, 99, 102, 0, 0, & + 7, 25, 30, 50, 63, 68, 83, 87, 100, 103, 120, 0, & + 4, 24, 38, 51, 58, 71, 73, 85, 98, 102, 121, 0, & + 7, 18, 36, 45, 58, 74, 82, 95, 116, 126, 0, 0, & + 12, 19, 35, 50, 55, 73, 78, 80, 94, 114, 122, 0, & + 1, 13, 20, 29, 48, 60, 74, 79, 85, 111, 114, 0, & + 5, 27, 34, 50, 64, 71, 77, 84, 105, 123, 124, 0, & + 3, 23, 35, 48, 59, 64, 83, 95, 112, 127, 0, 0, & + 6, 23, 38, 39, 61, 74, 80, 96, 106, 115, 0, 0, & + 3, 21, 33, 44, 62, 66, 84, 85, 100, 106, 128, 0, & + 5, 22, 28, 49, 56, 69, 83, 93, 108, 122, 0, 0, & + 9, 26, 37, 51, 61, 68, 78, 91, 124, 128, 0, 0, & + 8, 14, 24, 49, 64, 66, 75, 78, 96, 111, 125, 0, & + 12, 13, 21, 46, 51, 67, 75, 90, 92, 109, 126, 0, & + 27, 36, 39, 54, 68, 81, 89, 101, 113, 117, 127, 0, & + 20, 32, 47, 59, 73, 82, 104, 107, 115, 123, 0, 0, & + 4, 22, 39, 46, 53, 72, 84, 87, 97, 114, 116, 0, & + 1, 11, 19, 37, 40, 57, 71, 81, 86, 104, 110, 0, & + 9, 18, 32, 40, 60, 72, 77, 98, 113, 125, 0, 0/ + +data nrw/ & +11,11,11,11,11,11,11,11,11,11,11,11,10,11,11,11, & +11,10,12,10,11,11,10,11,11,11,10,10,11,10,10,11, & +11,11,10,11,11,10/ + +data ncw/ & +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,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,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/ diff --git a/wsjtx_lib/lib/ldpc_128_90_generator.f90 b/wsjtx_lib/lib/ldpc_128_90_generator.f90 new file mode 100644 index 0000000..200d170 --- /dev/null +++ b/wsjtx_lib/lib/ldpc_128_90_generator.f90 @@ -0,0 +1,41 @@ +character*23 g(38) + +data g/ & + "a08ea80879050a5e94da994", & + "59f3b48040ca089c81ee880", & + "e4070262802e31b7b17d3dc", & + "95cbcbaf032dc3d960bacc8", & + "c4d79b5dcc21161a254ffbc", & + "93fde9cdbf2622a70868424", & + "e73b888bb1b01167379ba28", & + "45a0d0a0f39a7ad2439949c", & + "759acef19444bcad79c4964", & + "71eb4dddf4f5ed9e2ea17e0", & + "80f0ad76fb247d6b4ca8d38", & + "184fff3aa1b82dc66640104", & + "ca4e320bb382ed14cbb1094", & + "52514447b90e25b9e459e28", & + "dd10c1666e071956bd0df38", & + "99c332a0b792a2da8ef1ba8", & + "7bd9f688e7ed402e231aaac", & + "00fcad76eb647d6a0ca8c38", & + "6ac8d0499c43b02eed78d70", & + "2c2c764baf795b4788db010", & + "0e907bf9e280d2624823dd0", & + "b857a6e315afd8c1c925e64", & + "8deb58e22d73a141cae3778", & + "22d3cb80d92d6ac132dfe08", & + "754763877b28c187746855c", & + "1d1bb7cf6953732e04ebca4", & + "2c65e0ea4466ab9f5e1deec", & + "6dc530ca37fc916d1f84870", & + "49bccbbee152355be7ac984", & + "e8387f3f4367cf45a150448", & + "8ce25e03d67d51091c81884", & + "b798012ffa40a93852752c8", & + "2e43307933adfca37adc3c8", & + "ca06e0a42ca1ec782d6c06c", & + "c02b762927556a7039e638c", & + "4a3e9b7d08b6807f8619fac", & + "45e8030f68997bb68544424", & + "7e79362c16773efc6482e30"/ diff --git a/wsjtx_lib/lib/ldpc_128_90_reordered_parity.f90 b/wsjtx_lib/lib/ldpc_128_90_reordered_parity.f90 new file mode 100644 index 0000000..b3a5e9b --- /dev/null +++ b/wsjtx_lib/lib/ldpc_128_90_reordered_parity.f90 @@ -0,0 +1,176 @@ +data Mn/ & + 21, 34, 36, & + 1, 8, 28, & + 2, 9, 37, & + 3, 7, 19, & + 4, 16, 32, & + 2, 5, 22, & + 6, 13, 25, & + 10, 31, 33, & + 11, 24, 27, & + 12, 15, 23, & + 14, 18, 26, & + 17, 20, 29, & + 17, 30, 34, & + 6, 34, 35, & + 1, 10, 30, & + 3, 18, 23, & + 4, 12, 25, & + 5, 28, 36, & + 7, 14, 21, & + 8, 15, 31, & + 9, 27, 32, & + 11, 19, 35, & + 13, 16, 37, & + 20, 24, 38, & + 21, 22, 26, & + 12, 29, 33, & + 1, 17, 35, & + 2, 28, 30, & + 3, 10, 32, & + 4, 8, 36, & + 5, 19, 29, & + 6, 20, 27, & + 7, 22, 37, & + 9, 11, 33, & + 13, 24, 26, & + 14, 31, 34, & + 15, 16, 25, & + 13, 18, 38, & + 8, 20, 23, & + 1, 32, 33, & + 2, 17, 19, & + 3, 24, 34, & + 4, 7, 38, & + 5, 11, 31, & + 6, 18, 21, & + 9, 15, 36, & + 10, 16, 28, & + 12, 26, 30, & + 14, 27, 29, & + 22, 25, 35, & + 23, 30, 32, & + 4, 11, 37, & + 1, 14, 23, & + 2, 8, 25, & + 3, 13, 27, & + 5, 10, 37, & + 6, 16, 31, & + 7, 15, 18, & + 9, 22, 24, & + 12, 19, 36, & + 17, 26, 38, & + 20, 21, 33, & + 20, 28, 35, & + 4, 29, 34, & + 1, 26, 36, & + 2, 23, 34, & + 3, 9, 38, & + 5, 6, 17, & + 7, 27, 35, & + 8, 14, 32, & + 10, 15, 22, & + 11, 18, 29, & + 12, 13, 28, & + 16, 19, 33, & + 21, 25, 31, & + 24, 30, 37, & + 1, 3, 21, & + 2, 18, 31, & + 4, 6, 9, & + 5, 8, 33, & + 7, 29, 32, & + 10, 13, 19, & + 11, 22, 23, & + 12, 27, 34, & + 14, 15, 30, & + 16, 27, 38, & + 17, 28, 37, & + 20, 25, 26, & + 5, 24, 35, & + 3, 6, 36, & + 1, 12, 31, & + 2, 4, 33, & + 3, 16, 30, & + 1, 2, 24, & + 5, 23, 27, & + 6, 28, 32, & + 7, 17, 36, & + 8, 22, 38, & + 9, 18, 20, & + 10, 21, 29, & + 11, 13, 34, & + 4, 14, 20, & + 11, 30, 38, & + 14, 35, 37, & + 15, 19, 26, & + 3, 28, 29, & + 7, 8, 9, & + 5, 18, 34, & + 13, 15, 17, & + 12, 16, 35, & + 10, 23, 25, & + 19, 21, 37, & + 17, 27, 31, & + 24, 25, 36, & + 1, 18, 19, & + 6, 26, 33, & + 22, 31, 32, & + 3, 20, 22, & + 4, 21, 27, & + 2, 13, 29, & + 6, 7, 12, & + 15, 24, 32, & + 9, 25, 30, & + 23, 37, 38, & + 5, 16, 26, & + 11, 14, 28, & + 33, 36, 38, & + 8, 10, 35/ + +data Nm/ & + 2, 15, 27, 40, 53, 65, 77, 91, 94, 115, 0, & + 3, 6, 28, 41, 54, 66, 78, 92, 94, 120, 0, & + 4, 16, 29, 42, 55, 67, 77, 90, 93, 106, 118, & + 5, 17, 30, 43, 52, 64, 79, 92, 102, 119, 0, & + 6, 18, 31, 44, 56, 68, 80, 89, 95, 108, 125, & + 7, 14, 32, 45, 57, 68, 79, 90, 96, 116, 121, & + 4, 19, 33, 43, 58, 69, 81, 97, 107, 121, 0, & + 2, 20, 30, 39, 54, 70, 80, 98, 107, 128, 0, & + 3, 21, 34, 46, 59, 67, 79, 99, 107, 123, 0, & + 8, 15, 29, 47, 56, 71, 82, 100, 111, 128, 0, & + 9, 22, 34, 44, 52, 72, 83, 101, 103, 126, 0, & + 10, 17, 26, 48, 60, 73, 84, 91, 110, 121, 0, & + 7, 23, 35, 38, 55, 73, 82, 101, 109, 120, 0, & + 11, 19, 36, 49, 53, 70, 85, 102, 104, 126, 0, & + 10, 20, 37, 46, 58, 71, 85, 105, 109, 122, 0, & + 5, 23, 37, 47, 57, 74, 86, 93, 110, 125, 0, & + 12, 13, 27, 41, 61, 68, 87, 97, 109, 113, 0, & + 11, 16, 38, 45, 58, 72, 78, 99, 108, 115, 0, & + 4, 22, 31, 41, 60, 74, 82, 105, 112, 115, 0, & + 12, 24, 32, 39, 62, 63, 88, 99, 102, 118, 0, & + 1, 19, 25, 45, 62, 75, 77, 100, 112, 119, 0, & + 6, 25, 33, 50, 59, 71, 83, 98, 117, 118, 0, & + 10, 16, 39, 51, 53, 66, 83, 95, 111, 124, 0, & + 9, 24, 35, 42, 59, 76, 89, 94, 114, 122, 0, & + 7, 17, 37, 50, 54, 75, 88, 111, 114, 123, 0, & + 11, 25, 35, 48, 61, 65, 88, 105, 116, 125, 0, & + 9, 21, 32, 49, 55, 69, 84, 86, 95, 113, 119, & + 2, 18, 28, 47, 63, 73, 87, 96, 106, 126, 0, & + 12, 26, 31, 49, 64, 72, 81, 100, 106, 120, 0, & + 13, 15, 28, 48, 51, 76, 85, 93, 103, 123, 0, & + 8, 20, 36, 44, 57, 75, 78, 91, 113, 117, 0, & + 5, 21, 29, 40, 51, 70, 81, 96, 117, 122, 0, & + 8, 26, 34, 40, 62, 74, 80, 92, 116, 127, 0, & + 1, 13, 14, 36, 42, 64, 66, 84, 101, 108, 0, & + 14, 22, 27, 50, 63, 69, 89, 104, 110, 128, 0, & + 1, 18, 30, 46, 60, 65, 90, 97, 114, 127, 0, & + 3, 23, 33, 52, 56, 76, 87, 104, 112, 124, 0, & + 24, 38, 43, 61, 67, 86, 98, 103, 124, 127, 0/ + +data nrw/ & +10,10,11,10,11,11,10,10,10,10,10,10,10,10,10,10,10,10, & +10,10,10,10,10,10,10,10,11,10,10,10,10,10,10,10,10,10, & +10,10/ + +ncw=3 diff --git a/wsjtx_lib/lib/ldpcsim128_90.f90 b/wsjtx_lib/lib/ldpcsim128_90.f90 new file mode 100644 index 0000000..28e7fef --- /dev/null +++ b/wsjtx_lib/lib/ldpcsim128_90.f90 @@ -0,0 +1,142 @@ +program ldpcsim128_90 + +! Simulate the performance of the (128,90) code that is used in +! the second incarnation of MSK144. + + use packjt77 + integer, parameter:: N=128, K=90, M=N-K +! character*12 recent_calls(NRECENT) + character*37 msg,msgsent,msgreceived + character*77 c77 + character*8 arg + integer*1 codeword(N), message77(77) + integer*1 apmask(N),cw(N) + integer*1 msgbits(77) + integer*4 i4Msg6BitWords(13) + integer nerrtot(0:N),nerrdec(0:N) + logical unpk77_success + real*8 rxdata(N), rxavgd(N) + real llr(N),llra(N) + + do i=1,MAXNRECENT + recent_calls(i)=' ' + enddo + nerrtot=0 + nerrdec=0 + + nargs=iargc() + if(nargs.ne.5) then + print*,'Usage: ldpcsim niter ndeep navg #trials s ' + print*,'eg: ldpcsim 10 2 1 1000 0.75' + return + endif + call getarg(1,arg) + read(arg,*) max_iterations + call getarg(2,arg) + read(arg,*) ndeep + call getarg(3,arg) + read(arg,*) navg + call getarg(4,arg) + read(arg,*) ntrials + call getarg(5,arg) + read(arg,*) s + + rate=real(77)/real(N) + + write(*,*) "rate: ",rate + write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s + + msg="K1ABC RR73; W9XYZ -12" + i3=0 + n3=1 + call pack77(msg,i3,n3,c77) + call unpack77(c77,0,msgsent,unpk77_success) + read(c77,'(77i1)') msgbits + + write(*,*) "message sent ",msgsent + + write(*,*) 'msgbits' + write(*,'(77i1)') msgbits + +! msgbits is the 77-bit message, codeword is 128 bits + call encode_128_90(msgbits,codeword) + +! call init_random_seed() + + write(*,*) "Eb/N0 SNR2500 ngood nundetected sigma psymerr" + do idb = 6,6,-1 + db=idb/2.0-1.0 + sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) + ngood=0 + nue=0 + nbadcrc=0 + nsumerr=0 + + do itrial=1, ntrials + rxavgd=0d0 + do iav=1,navg +! call sgran() +! Create a realization of a noisy received word + do i=1,N + rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() + enddo + rxavgd=rxavgd+rxdata + enddo + rxdata=rxavgd + nerr=0 + do i=1,N + if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1 + enddo + nerrtot(nerr)=nerrtot(nerr)+1 + + rxav=sum(rxdata)/N + rx2av=sum(rxdata*rxdata)/N + rxsig=sqrt(rx2av-rxav*rxav) + rxdata=rxdata/rxsig +! 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 bpdecode128_90(llr, apmask, max_iterations, message77, cw, nharderrors, niterations) + + if(ndeep.ge.0 .and. nharderrors.lt.0) then + call osd128_90(llr, apmask, ndeep, message77, cw, nharderrors, dmin) + endif + +! If the decoder finds a valid codeword, nharderrors will be .ge. 0. + if( nharderrors .ge. 0 ) then + write(c77,'(77i1)') message77 + call unpack77(c77,1,msgreceived,unpk77_success) + nhw=count(cw.ne.codeword) + if(nhw.eq.0) then ! this is a good decode + ngood=ngood+1 + nerrdec(nerr)=nerrdec(nerr)+1 + else ! this is an undetected error + nue=nue+1 + endif + endif + nsumerr=nsumerr+nerr + enddo + + snr2500=db+10*log10(rate*2000.0/2500.0) ! symbol rate is 2000 s^-1 and ref BW is 2500 Hz. + pberr=real(nsumerr)/real(ntrials*N) + write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,7x,f5.2,3x,e10.3)") db,snr2500,ngood,nue,ss,pberr + + enddo + + open(unit=23,file='nerrhisto.dat',status='unknown') + do i=0,N + write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10) + enddo + close(23) + +end program ldpcsim128_90 diff --git a/wsjtx_lib/lib/ldpcsim40.f90 b/wsjtx_lib/lib/ldpcsim40.f90 new file mode 100644 index 0000000..b9c15e4 --- /dev/null +++ b/wsjtx_lib/lib/ldpcsim40.f90 @@ -0,0 +1,138 @@ +program ldpcsim + +use, intrinsic :: iso_c_binding +use hashing +use packjt + +character*22 msg,msgsent,msgreceived +character*8 arg +integer*1, allocatable :: codeword(:), decoded(:), message(:) +real*8, allocatable :: rxdata(:), rxavgd(:) +real, allocatable :: llr(:) +integer ihash +integer*1 hardbits(32) + +nargs=iargc() +if(nargs.ne.4) then + print*,'Usage: ldpcsim niter navg #trials s ' + print*,'eg: ldpcsim 10 1 1000 0.75' + return +endif +call getarg(1,arg) +read(arg,*) max_iterations +call getarg(2,arg) +read(arg,*) navg +call getarg(3,arg) +read(arg,*) ntrials +call getarg(4,arg) +read(arg,*) s + +K=16 +N=32 +!rate=real(K)/real(N) +! don't count hash bits as data bits +rate=4.0/real(N) +write(*,*) "rate: ",rate +write(*,*) "niter= ",max_iterations,"navg= ",navg," s= ",s + +allocate ( codeword(N), decoded(K), message(K) ) +allocate ( rxdata(N), rxavgd(N), llr(N) ) + +msg="K1JT K9AN" +call fmtmsg(msg,iz) +call hash(msg,22,ihash) +irpt=14 +ihash=iand(ihash,4095) !12-bit hash +ig=16*ihash + irpt !4-bit report +write(*,*) irpt,ihash,ig + +do i=1,16 + message(i)=iand(1,ishft(ig,1-i)) +enddo +write(*,'(16i1)') message +call encode_msk40(message,codeword) +write(*,'(32i1)') codeword +call init_random_seed() + +write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadhash" +do idb = 0, 30 + db=idb/2.0 + sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) + ngood=0 + nue=0 + nbadhash=0 + + itsum=0 + do itrial=1, ntrials + rxavgd=0d0 + do iav=1,navg + call sgran() +! Create a realization of a noisy received word + do i=1,N + rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() + enddo + rxavgd=rxavgd+rxdata + enddo + rxdata=rxavgd + +! 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 + if( s .le. 0 ) then + ss=sigma + else + ss=s + endif + + llr=2.0*rxdata/(ss*ss) + + call bpdecode40(llr, max_iterations, decoded, niterations) +! If the decoder finds a valid codeword, niterations will be .ge. 0. + if( niterations .ge. 0 ) then + nueflag=0 + nhashflag=0 + imsg=0 + do i=1,16 + imsg=ishft(imsg,1)+iand(1,decoded(17-i)) + enddo + nrxrpt=iand(imsg,15) + nrxhash=(imsg-nrxrpt)/16 + if( nrxhash .ne. ihash ) then + nbadhash=nbadhash+1 + nhashflag=1 + endif + +! Check the message plus hash against what was sent. + do i=1,K + if( message(i) .ne. decoded(i) ) then + nueflag=1 + endif + enddo + + if( nhashflag .eq. 0 .and. nueflag .eq. 0 ) then + ngood=ngood+1 + itsum=itsum+niterations + else if( nhashflag .eq. 0 .and. nueflag .eq. 1 ) then + nue=nue+1; + endif + else + hardbits=0 + where(llr .gt. 0) hardbits=1 +! write(*,'(32i1)') hardbits +! write(*,'(32i1)') codeword + isum=0 + do i=1,32 + if( hardbits(i) .ne. codeword(i) ) isum=isum+1 + enddo +! write(*,*) 'number of errors ',isum + endif + enddo + avits=real(itsum)/real(ngood+0.1) + snr2500=db-10.0 + write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,1x,f8.2,1x,f8.1)") db,snr2500,ngood,nue,nbadhash,ss,avits + +enddo + +end program ldpcsim diff --git a/wsjtx_lib/lib/libration.f90 b/wsjtx_lib/lib/libration.f90 new file mode 100644 index 0000000..7330d04 --- /dev/null +++ b/wsjtx_lib/lib/libration.f90 @@ -0,0 +1,38 @@ +subroutine libration(jd,RA,Dec,xl,b) + +! Compute optical libration of moon at jd: that is, the sub-observer +! point (xl,b) in selenographic coordinates. RA and Dec are +! topocentric values. + + implicit real*8 (a-h,o-z) + parameter (RADS=0.0174532925199433d0) + parameter (TWOPI=6.28318530717959d0) + real*8 jd,j2000,mjd,lambda + + j2000=2451545.0d0 + RA2000=RA + Dec2000=Dec + year=2000.0d0 + (jd-j2000)/365.25d0 + mjd=jd-2400000.d0 + call sla_PRECES('FK5',year,2000.d0,RA2000,Dec2000) + call sla_EQECL(RA2000,Dec2000,mjd,lambda,beta) + day=jd - j2000 + t = day / 36525.d0 + xi = 1.54242 * RADS + ft = 93.2720993 + 483202.0175273 * t - .0034029 * t * t + b= ft / 360 + a = 360 * (b - floor(b)) + if (a.lt.0.d0) a = 360 + a; + f=a/57.2957795131d0 + omega=sla_dranrm(2.182439196d0 - t*33.7570446085d0 + t*t*3.6236526d-5) + w = lambda - omega + y = sin(w) * cos(beta) * cos(xi) - sin(beta) * sin(xi) + x = cos(w) * cos(beta) + a = sla_dranrm(atan2(y, x)) + xl = a - f + if(xl.lt.-0.25*TWOPI) xl=xl+TWOPI !Fix 'round the back' angles + if(xl.gt.0.25*TWOPI) xl=xl-TWOPI + b = asin(-sin(w) * cos(beta) * sin(xi) - sin(beta) * cos(xi)) + + return +end subroutine libration diff --git a/wsjtx_lib/lib/lorentzian.f90 b/wsjtx_lib/lib/lorentzian.f90 new file mode 100644 index 0000000..f3f4e14 --- /dev/null +++ b/wsjtx_lib/lib/lorentzian.f90 @@ -0,0 +1,102 @@ +subroutine lorentzian(y,npts,a) + +! Input: y(npts); assume x(i)=i, i=1,npts +! Output: a(1:5) +! a(1) = baseline +! a(2) = amplitude +! a(3) = x0 +! a(4) = width +! a(5) = chisqr + + real y(npts) + real a(5) + real deltaa(4) + + a=0. + df=12000.0/8192.0 !df = 1.465 Hz + width=0. + ipk=0 + ymax=-1.e30 + do i=1,npts + if(y(i).gt.ymax) then + ymax=y(i) + ipk=i + endif +! write(50,3001) i,i*df,y(i) +!3001 format(i6,2f12.3) + enddo +! base=(sum(y(ipk-149:ipk-50)) + sum(y(ipk+51:ipk+150)))/200.0 + base=(sum(y(1:20)) + sum(y(npts-19:npts)))/40.0 + stest=ymax - 0.5*(ymax-base) + ssum=y(ipk) + do i=1,50 + if(ipk+i.gt.npts) exit + if(y(ipk+i).lt.stest) exit + ssum=ssum + y(ipk+i) + enddo + do i=1,50 + if(ipk-i.lt.1) exit + if(y(ipk-i).lt.stest) exit + ssum=ssum + y(ipk-i) + enddo + ww=ssum/y(ipk) + width=2 + t=ww*ww - 5.67 + if(t.gt.0.0) width=sqrt(t) + a(1)=base + a(2)=ymax-base + a(3)=ipk + a(4)=width + +! Now find Lorentzian parameters + + deltaa(1)=0.1 + deltaa(2)=0.1 + deltaa(3)=1.0 + deltaa(4)=1.0 + nterms=4 + +! Start the iteration + chisqr=0. + chisqr0=1.e6 + do iter=1,5 + do j=1,nterms + chisq1=fchisq0(y,npts,a) + fn=0. + delta=deltaa(j) +10 a(j)=a(j)+delta + chisq2=fchisq0(y,npts,a) + if(chisq2.eq.chisq1) go to 10 + if(chisq2.gt.chisq1) then + delta=-delta !Reverse direction + a(j)=a(j)+delta + tmp=chisq1 + chisq1=chisq2 + chisq2=tmp + endif +20 fn=fn+1.0 + a(j)=a(j)+delta + chisq3=fchisq0(y,npts,a) + if(chisq3.lt.chisq2) then + chisq1=chisq2 + chisq2=chisq3 + go to 20 + endif + +! Find minimum of parabola defined by last three points + delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5) + a(j)=a(j)-delta + deltaa(j)=deltaa(j)*fn/3. +! write(*,4000) iter,j,a,chisq2 +!4000 format(i1,i2,4f10.4,f11.3) + enddo + chisqr=fchisq0(y,npts,a) +! write(*,4000) 0,0,a,chisqr + if(chisqr/chisqr0.gt.0.99) exit + chisqr0=chisqr + enddo + a(5)=chisqr + + return +end subroutine lorentzian + diff --git a/wsjtx_lib/lib/lpf1.f90 b/wsjtx_lib/lib/lpf1.f90 new file mode 100644 index 0000000..a620e9a --- /dev/null +++ b/wsjtx_lib/lib/lpf1.f90 @@ -0,0 +1,29 @@ +subroutine lpf1(dd,jz,dat,jz2) + + parameter (NFFT1=64*11025,NFFT2=32*11025) + real dd(jz) + real dat(jz) + real x(NFFT1) + complex cx(0:NFFT1/2) + equivalence (x,cx) + save x,cx + + fac=1.0/float(NFFT1) + x(1:jz)=fac*dd(1:jz) + x(jz+1:NFFT1)=0.0 + call four2a(cx,NFFT1,1,-1,0) !Forwarxd FFT, r2c + cx(NFFT2/2:)=0.0 + +! df=11025.0/NFFT1 +! do i=1,NFFT1/2 +! sx=real(cx(i))**2 + aimag(cx(i))**2 +! write(50,3000) i*df,sx +!3000 format(f15.6,e12.3) +! enddo + + call four2a(cx,NFFT2,1,1,-1) !Inverse FFT, c2r + jz2=jz/2 + dat(1:jz2)=x(1:jz2) + + return +end subroutine lpf1 diff --git a/wsjtx_lib/lib/makepings.f90 b/wsjtx_lib/lib/makepings.f90 new file mode 100644 index 0000000..0d42df0 --- /dev/null +++ b/wsjtx_lib/lib/makepings.f90 @@ -0,0 +1,25 @@ +subroutine makepings(pings,nTRperiod,npts,width,sig) + + real pings(npts) + real*8 t + real t0(29) + + dt=1.0/12000.0 + do i=1,nTRperiod-1 + t0(i)=i !Make pings at t=1, 2, ... 14 s. + enddo + amp=sig + + do i=1,npts + iping=min(max(1,i/12000),nTRperiod-1) + t=(i*dt-t0(iping))/width + if(t.lt.0.d0 .or. t.gt.10.0) then + fac=0. + else + fac=2.718*t*dexp(-t) + endif + pings(i)=fac*amp + enddo + + return +end subroutine makepings diff --git a/wsjtx_lib/lib/map65_mmdec.f90 b/wsjtx_lib/lib/map65_mmdec.f90 new file mode 100644 index 0000000..52b70a4 --- /dev/null +++ b/wsjtx_lib/lib/map65_mmdec.f90 @@ -0,0 +1,90 @@ +subroutine map65_mmdec(nutc,id2,nqd,nsubmode,nfa,nfb,nfqso,ntol,newdat, & + nagain,max_drift,ndepth,mycall,hiscall,hisgrid) + + use prog_args + use timer_module, only: timer + use q65_decode + + include 'jt9com.f90' + include 'timer_common.inc' + + type, extends(q65_decoder) :: counting_q65_decoder + integer :: decoded + end type counting_q65_decoder + + logical single_decode,bVHF,lnewdat,lagain,lclearave,lapcqonly + integer*2 id2(300*12000) + integer nqf(20) +! type(params_block) :: params + character(len=12) :: mycall, hiscall + character(len=6) :: hisgrid + data ntr0/-1/ + save + type(counting_q65_decoder) :: my_q65 + +! Cast C character arrays to Fortran character strings +! datetime=transfer(params%datetime, datetime) +! mycall=transfer(params%mycall,mycall) +! hiscall=transfer(params%hiscall,hiscall) +! mygrid=transfer(params%mygrid,mygrid) +! hisgrid=transfer(params%hisgrid,hisgrid) + + my_q65%decoded = 0 + ncontest=0 + nQSOprogress=0 + lclearave=.false. + single_decode=.false. + lapcqonly=.false. + lnewdat=(newdat.ne.0) + lagain=(nagain.ne.0) + bVHF=.true. + emedelay=2.5 + ntrperiod=60 + + call timer('dec_q65 ',0) + call my_q65%decode(q65_decoded,id2,nqd,nutc,ntrperiod,nsubmode,nfqso, & + ntol,ndepth,nfa,nfb,lclearave,single_decode,lagain,max_drift,lnewdat, & + emedelay,mycall,hiscall,hisgrid,nQSOProgress,ncontest,lapcqonly,navg0,nqf) + call timer('dec_q65 ',1) + + return + +contains + + subroutine q65_decoded (this,nutc,snr1,nsnr,dt,freq,decoded,idec, & + nused,ntrperiod) + + use q65_decode + implicit none + + class(q65_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: snr1 + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: idec + integer, intent(in) :: nused + integer, intent(in) :: ntrperiod + + if(nutc+snr1+nsnr+dt+freq+idec+nused+ntrperiod.eq.-999) stop + if(decoded.eq.'-999') stop + + cq0='q ' + write(cq0(2:2),'(i1)') idec + if(nused.ge.2) write(cq0(3:3),'(i1)') nused + nsnr0=nsnr + xdt0=dt + nfreq0=nint(freq) + msg0=decoded + + select type(this) + type is (counting_q65_decoder) + if(idec.ge.0) this%decoded = this%decoded + 1 + end select + + return + end subroutine q65_decoded + +end subroutine map65_mmdec diff --git a/wsjtx_lib/lib/met8.21 b/wsjtx_lib/lib/met8.21 new file mode 100644 index 0000000..a5d3006 --- /dev/null +++ b/wsjtx_lib/lib/met8.21 @@ -0,0 +1,256 @@ + -25.6 1.000 -9.966 1.000000 0.000000 + -25.4 1.000 -9.966 1.000000 0.000000 + -25.2 1.000 -9.966 1.000000 0.000000 + -25.0 1.000 -9.966 1.000000 0.000000 + -24.8 1.000 -9.966 1.000000 0.000000 + -24.6 1.000 -9.966 1.000000 0.000000 + -24.4 1.000 -9.966 1.000000 0.000000 + -24.2 1.000 -9.966 1.000000 0.000000 + -24.0 1.000 -9.966 1.000000 0.000000 + -23.8 1.000 -9.966 1.000000 0.000000 + -23.6 1.000 -9.966 1.000000 0.000000 + -23.4 1.000 -9.966 1.000000 0.000000 + -23.2 1.000 -9.966 1.000000 0.000000 + -23.0 1.000 -9.966 1.000000 0.000000 + -22.8 1.000 -9.966 1.000000 0.000000 + -22.6 1.000 -9.966 1.000000 0.000000 + -22.4 1.000 -9.966 1.000000 0.000000 + -22.2 1.000 -9.966 1.000000 0.000000 + -22.0 1.000 -9.966 1.000000 0.000000 + -21.8 1.000 -9.966 1.000000 0.000000 + -21.6 1.000 -9.966 1.000000 0.000000 + -21.4 1.000 -9.966 1.000000 0.000000 + -21.2 1.000 -9.966 1.000000 0.000000 + -21.0 1.000 -9.966 1.000000 0.000000 + -20.8 1.000 -9.966 1.000000 0.000000 + -20.6 1.000 -9.966 1.000000 0.000000 + -20.4 1.000 -9.966 1.000000 0.000000 + -20.2 1.000 -9.966 1.000000 0.000000 + -20.0 1.000 -9.966 1.000000 0.000000 + -19.8 1.000 -9.966 1.000000 0.000000 + -19.6 1.000 -9.966 1.000000 0.000000 + -19.4 1.000 -9.966 1.000000 0.000000 + -19.2 1.000 -9.966 1.000000 0.000000 + -19.0 1.000 -9.966 1.000000 0.000000 + -18.8 1.000 -9.966 1.000000 0.000000 + -18.6 1.000 -9.966 1.000000 0.000000 + -18.4 1.000 -9.966 1.000000 0.000000 + -18.2 1.000 -9.966 1.000000 0.000000 + -18.0 1.000 -9.966 1.000000 0.000000 + -17.8 1.000 -9.966 1.000000 0.000000 + -17.6 1.000 -9.966 1.000000 0.000000 + -17.4 1.000 -9.966 1.000000 0.000000 + -17.2 1.000 -9.966 1.000000 0.000000 + -17.0 1.000 -9.966 1.000000 0.000000 + -16.8 1.000 -9.966 1.000000 0.000000 + -16.6 1.000 -9.966 1.000000 0.000000 + -16.4 1.000 -9.966 1.000000 0.000000 + -16.2 1.000 -9.966 1.000000 0.000000 + -16.0 0.988 -5.858 0.991379 0.008621 + -15.8 1.000 -9.966 1.000000 0.000000 + -15.6 0.991 -6.313 0.993711 0.006289 + -15.4 0.993 -6.629 0.994950 0.005051 + -15.2 1.000 -9.966 1.000000 0.000000 + -15.0 0.995 -7.055 0.996241 0.003759 + -14.8 1.000 -9.966 1.000000 0.000000 + -14.6 0.991 -6.371 0.993958 0.006042 + -14.4 1.000 -9.966 1.000000 0.000000 + -14.2 0.991 -6.313 0.993711 0.006289 + -14.0 0.992 -6.426 0.994186 0.005814 + -13.8 0.991 -6.288 0.993600 0.006400 + -13.6 0.990 -6.113 0.992775 0.007225 + -13.4 0.990 -6.152 0.992968 0.007032 + -13.2 0.992 -6.534 0.994606 0.005394 + -13.0 0.996 -7.332 0.996898 0.003102 + -12.8 0.990 -6.184 0.993121 0.006879 + -12.6 0.994 -7.016 0.996136 0.003864 + -12.4 0.993 -6.658 0.995049 0.004950 + -12.2 0.991 -6.369 0.993953 0.006047 + -12.0 0.992 -6.559 0.994699 0.005301 + -11.8 0.989 -6.002 0.992197 0.007803 + -11.6 0.991 -6.304 0.993671 0.006329 + -11.4 0.987 -5.826 0.991188 0.008812 + -11.2 0.985 -5.632 0.989919 0.010081 + -11.0 0.989 -5.995 0.992162 0.007838 + -10.8 0.984 -5.544 0.989284 0.010717 + -10.6 0.983 -5.377 0.987966 0.012034 + -10.4 0.979 -5.108 0.985502 0.014498 + -10.2 0.977 -4.954 0.983869 0.016131 + -10.0 0.971 -4.652 0.980118 0.019882 + -9.8 0.975 -4.870 0.982896 0.017104 + -9.6 0.974 -4.822 0.982324 0.017676 + -9.4 0.970 -4.608 0.979490 0.020510 + -9.2 0.970 -4.623 0.979702 0.020298 + -9.0 0.970 -4.621 0.979679 0.020321 + -8.8 0.967 -4.472 0.977465 0.022535 + -8.6 0.962 -4.261 0.973915 0.026085 + -8.4 0.960 -4.186 0.972538 0.027462 + -8.2 0.957 -4.098 0.970806 0.029194 + -8.0 0.956 -4.062 0.970061 0.029939 + -7.8 0.953 -3.975 0.968209 0.031791 + -7.6 0.942 -3.677 0.960918 0.039082 + -7.4 0.946 -3.768 0.963301 0.036699 + -7.2 0.937 -3.550 0.957308 0.042692 + -7.0 0.933 -3.463 0.954652 0.045348 + -6.8 0.929 -3.377 0.951866 0.048134 + -6.6 0.920 -3.212 0.946042 0.053958 + -6.4 0.917 -3.164 0.944202 0.055798 + -6.2 0.911 -3.058 0.939981 0.060019 + -6.0 0.903 -2.939 0.934818 0.065182 + -5.8 0.895 -2.829 0.929642 0.070358 + -5.6 0.884 -2.690 0.922540 0.077459 + -5.4 0.877 -2.608 0.917972 0.082028 + -5.2 0.869 -2.531 0.913509 0.086491 + -5.0 0.858 -2.411 0.905967 0.094033 + -4.8 0.846 -2.301 0.898525 0.101475 + -4.6 0.834 -2.201 0.891269 0.108731 + -4.4 0.821 -2.096 0.883085 0.116915 + -4.2 0.806 -1.992 0.874340 0.125660 + -4.0 0.790 -1.882 0.864307 0.135693 + -3.8 0.775 -1.790 0.855445 0.144555 + -3.6 0.755 -1.678 0.843726 0.156274 + -3.4 0.737 -1.587 0.833538 0.166462 + -3.2 0.713 -1.473 0.819841 0.180159 + -3.0 0.691 -1.376 0.807345 0.192655 + -2.8 0.667 -1.280 0.794093 0.205907 + -2.6 0.640 -1.181 0.779404 0.220596 + -2.4 0.612 -1.084 0.764178 0.235822 + -2.2 0.581 -0.987 0.747708 0.252292 + -2.0 0.548 -0.895 0.731037 0.268963 + -1.8 0.510 -0.796 0.712035 0.287965 + -1.6 0.472 -0.706 0.693474 0.306526 + -1.4 0.425 -0.606 0.671514 0.328486 + -1.2 0.378 -0.514 0.649948 0.350053 + -1.0 0.328 -0.425 0.627452 0.372548 + -0.8 0.274 -0.338 0.604549 0.395451 + -0.6 0.212 -0.249 0.579151 0.420849 + -0.4 0.146 -0.163 0.553389 0.446611 + -0.2 0.075 -0.079 0.526648 0.473352 + 0.0 0.000 0.000 0.500000 0.500000 + 0.2 -0.079 0.075 0.473352 0.526648 + 0.4 -0.163 0.146 0.446611 0.553389 + 0.6 -0.249 0.212 0.420849 0.579151 + 0.8 -0.338 0.274 0.395451 0.604549 + 1.0 -0.425 0.328 0.372548 0.627452 + 1.2 -0.514 0.378 0.350053 0.649948 + 1.4 -0.606 0.425 0.328486 0.671514 + 1.6 -0.706 0.472 0.306526 0.693474 + 1.8 -0.796 0.510 0.287965 0.712035 + 2.0 -0.895 0.548 0.268963 0.731037 + 2.2 -0.987 0.581 0.252292 0.747708 + 2.4 -1.084 0.612 0.235822 0.764178 + 2.6 -1.181 0.640 0.220596 0.779404 + 2.8 -1.280 0.667 0.205907 0.794093 + 3.0 -1.376 0.691 0.192655 0.807345 + 3.2 -1.473 0.713 0.180159 0.819841 + 3.4 -1.587 0.737 0.166462 0.833538 + 3.6 -1.678 0.755 0.156274 0.843726 + 3.8 -1.790 0.775 0.144555 0.855445 + 4.0 -1.882 0.790 0.135693 0.864307 + 4.2 -1.992 0.806 0.125660 0.874340 + 4.4 -2.096 0.821 0.116915 0.883085 + 4.6 -2.201 0.834 0.108731 0.891269 + 4.8 -2.301 0.846 0.101475 0.898525 + 5.0 -2.411 0.858 0.094033 0.905967 + 5.2 -2.531 0.869 0.086491 0.913509 + 5.4 -2.608 0.877 0.082028 0.917972 + 5.6 -2.690 0.884 0.077459 0.922540 + 5.8 -2.829 0.895 0.070358 0.929642 + 6.0 -2.939 0.903 0.065182 0.934818 + 6.2 -3.058 0.911 0.060019 0.939981 + 6.4 -3.164 0.917 0.055798 0.944202 + 6.6 -3.212 0.920 0.053958 0.946042 + 6.8 -3.377 0.929 0.048134 0.951866 + 7.0 -3.463 0.933 0.045348 0.954652 + 7.2 -3.550 0.937 0.042692 0.957308 + 7.4 -3.768 0.946 0.036699 0.963301 + 7.6 -3.677 0.942 0.039082 0.960918 + 7.8 -3.975 0.953 0.031791 0.968210 + 8.0 -4.062 0.956 0.029939 0.970061 + 8.2 -4.098 0.957 0.029194 0.970806 + 8.4 -4.186 0.960 0.027462 0.972538 + 8.6 -4.261 0.962 0.026085 0.973915 + 8.8 -4.472 0.967 0.022535 0.977465 + 9.0 -4.621 0.970 0.020321 0.979679 + 9.2 -4.623 0.970 0.020298 0.979702 + 9.4 -4.608 0.970 0.020510 0.979490 + 9.6 -4.822 0.974 0.017676 0.982324 + 9.8 -4.870 0.975 0.017104 0.982896 + 10.0 -4.652 0.971 0.019882 0.980118 + 10.2 -4.954 0.977 0.016131 0.983869 + 10.4 -5.108 0.979 0.014498 0.985502 + 10.6 -5.377 0.983 0.012034 0.987966 + 10.8 -5.544 0.984 0.010717 0.989284 + 11.0 -5.995 0.989 0.007838 0.992162 + 11.2 -5.632 0.985 0.010081 0.989919 + 11.4 -5.826 0.987 0.008812 0.991188 + 11.6 -6.304 0.991 0.006329 0.993671 + 11.8 -6.002 0.989 0.007803 0.992197 + 12.0 -6.559 0.992 0.005301 0.994699 + 12.2 -6.369 0.991 0.006047 0.993953 + 12.4 -6.658 0.993 0.004950 0.995049 + 12.6 -7.016 0.994 0.003864 0.996136 + 12.8 -6.184 0.990 0.006879 0.993121 + 13.0 -7.332 0.996 0.003102 0.996898 + 13.2 -6.534 0.992 0.005394 0.994606 + 13.4 -6.152 0.990 0.007032 0.992968 + 13.6 -6.113 0.990 0.007225 0.992775 + 13.8 -6.288 0.991 0.006400 0.993600 + 14.0 -6.426 0.992 0.005814 0.994186 + 14.2 -6.313 0.991 0.006289 0.993711 + 14.4 -9.966 1.000 0.000000 1.000000 + 14.6 -6.371 0.991 0.006042 0.993958 + 14.8 -9.966 1.000 0.000000 1.000000 + 15.0 -7.055 0.995 0.003759 0.996241 + 15.2 -9.966 1.000 0.000000 1.000000 + 15.4 -6.629 0.993 0.005051 0.994949 + 15.6 -6.313 0.991 0.006289 0.993711 + 15.8 -9.966 1.000 0.000000 1.000000 + 16.0 -5.858 0.988 0.008621 0.991379 + 16.2 -9.966 1.000 0.000000 1.000000 + 16.4 -9.966 1.000 0.000000 1.000000 + 16.6 -9.966 1.000 0.000000 1.000000 + 16.8 -9.966 1.000 0.000000 1.000000 + 17.0 -9.966 1.000 0.000000 1.000000 + 17.2 -9.966 1.000 0.000000 1.000000 + 17.4 -9.966 1.000 0.000000 1.000000 + 17.6 -9.966 1.000 0.000000 1.000000 + 17.8 -9.966 1.000 0.000000 1.000000 + 18.0 -9.966 1.000 0.000000 1.000000 + 18.2 -9.966 1.000 0.000000 1.000000 + 18.4 -9.966 1.000 0.000000 1.000000 + 18.6 -9.966 1.000 0.000000 1.000000 + 18.8 -9.966 1.000 0.000000 1.000000 + 19.0 -9.966 1.000 0.000000 1.000000 + 19.2 -9.966 1.000 0.000000 1.000000 + 19.4 -9.966 1.000 0.000000 1.000000 + 19.6 -9.966 1.000 0.000000 1.000000 + 19.8 -9.966 1.000 0.000000 1.000000 + 20.0 -9.966 1.000 0.000000 1.000000 + 20.2 -9.966 1.000 0.000000 1.000000 + 20.4 -9.966 1.000 0.000000 1.000000 + 20.6 -9.966 1.000 0.000000 1.000000 + 20.8 -9.966 1.000 0.000000 1.000000 + 21.0 -9.966 1.000 0.000000 1.000000 + 21.2 -9.966 1.000 0.000000 1.000000 + 21.4 -9.966 1.000 0.000000 1.000000 + 21.6 -9.966 1.000 0.000000 1.000000 + 21.8 -9.966 1.000 0.000000 1.000000 + 22.0 -9.966 1.000 0.000000 1.000000 + 22.2 -9.966 1.000 0.000000 1.000000 + 22.4 -9.966 1.000 0.000000 1.000000 + 22.6 -9.966 1.000 0.000000 1.000000 + 22.8 -9.966 1.000 0.000000 1.000000 + 23.0 -9.966 1.000 0.000000 1.000000 + 23.2 -9.966 1.000 0.000000 1.000000 + 23.4 -9.966 1.000 0.000000 1.000000 + 23.6 -9.966 1.000 0.000000 1.000000 + 23.8 -9.966 1.000 0.000000 1.000000 + 24.0 -9.966 1.000 0.000000 1.000000 + 24.2 -9.966 1.000 0.000000 1.000000 + 24.4 -9.966 1.000 0.000000 1.000000 + 24.6 -9.966 1.000 0.000000 1.000000 + 24.8 -9.966 1.000 0.000000 1.000000 + 25.0 -9.966 1.000 0.000000 1.000000 + 25.2 -9.966 1.000 0.000000 1.000000 + 25.4 -9.966 1.000 0.000000 1.000000 diff --git a/wsjtx_lib/lib/mixlpf.f90 b/wsjtx_lib/lib/mixlpf.f90 new file mode 100644 index 0000000..cd775ab --- /dev/null +++ b/wsjtx_lib/lib/mixlpf.f90 @@ -0,0 +1,25 @@ +subroutine mixlpf(x1,nbfo,c0) + + real*4 x1(512) + real*8 twopi,phi,dphi + complex c1(512),c2(105+512) + complex c0(64) + data phi/0.d0/ + save phi,c2 + + twopi=8.d0*atan(1.d0) + dphi=twopi*nbfo/12000.d0 + + do i=1,512 + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + c1(i)=x1(i)*cmplx(cos(xphi),sin(xphi)) + enddo + c2(106:105+512)=c1 + + call fil3c(c2,105+512,c0,n2) + c2(1:105)=c1(512-104:512) !Save 105 trailing samples + + return +end subroutine mixlpf diff --git a/wsjtx_lib/lib/moondopjpl.f90 b/wsjtx_lib/lib/moondopjpl.f90 new file mode 100644 index 0000000..20fbb5e --- /dev/null +++ b/wsjtx_lib/lib/moondopjpl.f90 @@ -0,0 +1,43 @@ +subroutine MoonDopJPL(nyear,month,nday,uth4,lon4,lat4,RAMoon4, & + DecMoon4,LST4,HA4,AzMoon4,ElMoon4,vr4,dist4) + + implicit real*8 (a-h,o-z) + real*4 uth4 !UT in hours + real*4 lon4 !East longitude, degrees + real*4 lat4 !Latitude, degrees + real*4 RAMoon4 !Topocentric RA of moon, hours + real*4 DecMoon4 !Topocentric Dec of Moon, degrees + real*4 LST4 !Locat sidereal time, hours + real*4 HA4 !Local Hour angle, degrees + real*4 AzMoon4 !Topocentric Azimuth of moon, degrees + real*4 ElMoon4 !Topocentric Elevation of moon, degrees + real*4 vr4 !Radial velocity of moon wrt obs, km/s + real*4 dist4 !Echo time, seconds + + twopi=8.d0*atan(1.d0) !Define some constants + rad=360.d0/twopi + clight=2.99792458d5 + + call sla_CLDJ(nyear,month,nday,djutc,j) + djutc=djutc + uth4/24.d0 + dut=-0.460d0 + + east_long=lon4/rad + geodetic_lat=lat4/rad + height=40. + nspecial=0 + + call ephem(djutc,dut,east_long,geodetic_lat,height,nspecial, & + RA,Dec,Az,El,techo,dop,fspread_1GHz,vr) + + RAMoon4=RA + DecMoon4=Dec + LST4=0. !These two variables not presently used + HA4=0. + AzMoon4=Az*rad + ElMoon4=El*rad + vr4=vr + dist4=techo + + return +end subroutine MoonDopJPL diff --git a/wsjtx_lib/lib/morse.f90 b/wsjtx_lib/lib/morse.f90 new file mode 100644 index 0000000..7b42895 --- /dev/null +++ b/wsjtx_lib/lib/morse.f90 @@ -0,0 +1,87 @@ +subroutine morse(msg,idat,n) + +! Convert ascii message to a Morse code bit string. +! Dash = 3 dots +! Space between dots, dashes = 1 dot +! Space between letters = 3 dots +! Space between words = 7 dots + + character*(*) msg + integer idat(250) + integer*1 ic(21,38) + data ic/ & + 1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,20, & + 1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,18, & + 1,0,1,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,16, & + 1,0,1,0,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,14, & + 1,0,1,0,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,12, & + 1,0,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,1,1,0,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,12, & + 1,1,1,0,1,1,1,0,1,0,1,0,1,0,0,0,0,0,0,0,14, & + 1,1,1,0,1,1,1,0,1,1,1,0,1,0,1,0,0,0,0,0,16, & + 1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,0,0,0,18, & + 1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 6, & + 1,1,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,1,1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,12, & + 1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, & + 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 2, & + 1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, & + 1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 4, & + 1,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,14, & + 1,1,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,1,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, & + 1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 6, & + 1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,0,0,12, & + 1,0,1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,12, & + 1,1,1,0,1,1,1,0,1,0,1,1,1,0,0,0,0,0,0,0,14, & + 1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, & + 1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 6, & + 1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 4, & + 1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, & + 1,0,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,10, & + 1,1,1,0,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,12, & + 1,1,1,0,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,14, & + 1,1,1,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,12, & + 1,1,1,0,1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,14, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 2/ !Incremental word space + save + + msglen=len(msg) + idat=0 + n=6 + do k=1,msglen + jj=ichar(msg(k:k)) + if(jj.ge.97 .and. jj.le.122) jj=jj-32 !Convert lower to upper case + if(jj.ge.48 .and. jj.le.57) j=jj-48 !Numbers + if(jj.ge.65 .and. jj.le.90) j=jj-55 !Letters + if(jj.eq.47) j=36 !Slash (/) + if(jj.eq.32) j=37 !Word space + j=j+1 + +! Insert this character + nmax=ic(21,j) + if (n + nmax + 4 .gt. size (idat)) exit + do i=1,nmax + n=n+1 + idat(n)=ic(i,j) + enddo + +! Insert character space of 2 dit lengths: + n=n+1 + idat(n)=0 + n=n+1 + idat(n)=0 + enddo + +! Insert word space at end of message + do j=1,4 + n=n+1 + idat(n)=0 + enddo + + return +end subroutine morse diff --git a/wsjtx_lib/lib/move.f90 b/wsjtx_lib/lib/move.f90 new file mode 100644 index 0000000..25f23c1 --- /dev/null +++ b/wsjtx_lib/lib/move.f90 @@ -0,0 +1,7 @@ +subroutine move(x,y,n) + real x(n),y(n) + do i=1,n + y(i)=x(i) + enddo + return +end subroutine move diff --git a/wsjtx_lib/lib/msgs.txt b/wsjtx_lib/lib/msgs.txt new file mode 100644 index 0000000..cb06304 --- /dev/null +++ b/wsjtx_lib/lib/msgs.txt @@ -0,0 +1,60 @@ +W1AAA K2BBB EM00 +W2CCC K3DDD EM01 +W3EEE K4FFF EM02 +W5GGG K6HHH EM03 +W7III K8JJJ EM04 +W9KKK K0LLL EM05 +G0MMM F1NNN JN06 +G2OOO F3PPP JN07 +G4QQQ F5RRR JN08 +G6SSS F7TTT JN09 +W1XAA K2XBB EM10 +W2XCC K3XDD EM11 +W3XEE K4XFF EM12 +W5XGG K6XHH EM13 +W7XII K8XJJ EM14 +W9XKK K0XLL EM15 +G0XMM F1XNN JN16 +G2XOO F3XPP JN17 +G4XQQ F5XRR JN18 +G6XSS F7XTT JN19 +W1YAA K2YBB EM20 +W2YCC K3YDD EM21 +W3YEE K4YFF EM22 +W5YGG K6YHH EM23 +W7YII K8YJJ EM24 +W9YKK K0YLL EM25 +G0YMM F1YNN JN26 +G2YOO F3YPP JN27 +G4YQQ F5YRR JN28 +G6YSS F7YTT JN29 +W1ZAA K2ZBB EM30 +W2ZCC K3ZDD EM31 +W3ZEE K4ZFF EM32 +W5ZGG K6ZHH EM33 +W7ZII K8ZJJ EM34 +W9ZKK K0ZLL EM35 +G0ZMM F1ZNN JN36 +G2ZOO F3ZPP JN37 +G4ZQQ F5ZRR JN38 +G6ZSS F7ZTT JN39 +W1AXA K2BXB EM40 +W2CXC K3DXD EM41 +W3EXE K4FXF EM42 +W5GXG K6HXH EM43 +W7IXI K8JXJ EM44 +W9KXK K0LXL EM45 +G0MXM F1NXN JN46 +G2OXO F3PXP JN47 +G4QXQ F5RXR JN48 +G6SXS F7TXT JN49 +W1AYA K2BYB EM50 +W2CYC K3DYD EM51 +W3EYE K4FYF EM52 +W5GYG K6HYH EM53 +W7IYI K8JYJ EM54 +W9KYK K0LYL EM55 +G0MYM F1NYN JN56 +G2OYO F3PYP JN57 +G4QYQ F5RYR JN58 +G6SYS F7TYT JN59 diff --git a/wsjtx_lib/lib/msk144_freq_search.f90 b/wsjtx_lib/lib/msk144_freq_search.f90 new file mode 100644 index 0000000..5029816 --- /dev/null +++ b/wsjtx_lib/lib/msk144_freq_search.f90 @@ -0,0 +1,50 @@ +subroutine msk144_freq_search(cdat,fc,if1,if2,delf,nframes,navmask,cb, & + cdat2,xmax,bestf,cs,xccs) + + parameter (NSPM=864,NZ=7*NSPM) + complex cdat(NZ) + complex cdat2(NZ) + complex c(NSPM) !Coherently averaged complex data + complex ct2(2*NSPM) + complex cs(NSPM) + complex cb(42) !Complex waveform for sync word + complex cc(0:NSPM-1) + real xcc(0:NSPM-1) + real xccs(0:NSPM-1) + integer navmask(nframes) !Tells which frames to average + + navg=sum(navmask) + n=nframes*NSPM + fac=1.0/(48.0*sqrt(float(navg))) + + do ifr=if1,if2 !Find freq that maximizes sync + ferr=ifr*delf + call tweak1(cdat,n,-(fc+ferr),cdat2) + c=0 + sumw=0. + do i=1,nframes + ib=(i-1)*NSPM+1 + ie=ib+NSPM-1 + if(navmask(i).eq.1) c=c + cdat2(ib:ie) + enddo + + cc=0 + ct2(1:NSPM)=c + ct2(NSPM+1:2*NSPM)=c + + do ish=0,NSPM-1 + cc(ish)=dot_product(ct2(1+ish:42+ish)+ct2(337+ish:378+ish),cb(1:42)) + enddo + + xcc=abs(cc) + xb=maxval(xcc)*fac + if(xb.gt.xmax) then + xmax=xb + bestf=ferr + cs=c + xccs=xcc + endif + enddo + + return +end subroutine msk144_freq_search diff --git a/wsjtx_lib/lib/msk144_testmsg.f90 b/wsjtx_lib/lib/msk144_testmsg.f90 new file mode 100644 index 0000000..e1cff13 --- /dev/null +++ b/wsjtx_lib/lib/msk144_testmsg.f90 @@ -0,0 +1,47 @@ + parameter (MAXTEST=75,NTEST=43) + character*37 testmsg(MAXTEST) + data testmsg(1:NTEST)/ & + "CQ K1ABC FN42", & + "K1ABC W9XYZ EN37", & + "W9XYZ K1ABC -11", & + "K1ABC W9XYZ R-09", & + "W9XYZ K1ABC RRR", & + "K1ABC W9XYZ 73", & + "K1ABC W9XYZ RR73", & + "CQ KH1/KH7Z", & + "CQ TEST K1ABC/R FN42", & + "K1ABC/R W9XYZ EN37", & + "W9XYZ K1ABC/R R FN42", & + "K1ABC/R W9XYZ RR73", & + "CQ TEST K1ABC FN42", & + "K1ABC/R W9XYZ/R R FN42", & + "CQ G4ABC/P IO91", & + "G4ABC/P PA9XYZ JO22", & + "PA9XYZ 590003 IO91NP", & + "G4ABC/P R 570007 JO22DB", & + "PA9XYZ G4ABC/P RR73", & + "CQ PJ4/K1ABC", & + "PJ4/K1ABC ", & + "W9XYZ -11", & + " W9XYZ R-09", & + " PJ4/K1ABC RRR", & + "PJ4/K1ABC 73", & + "CQ W9XYZ EN37", & + " YW18FIFA", & + " W9XYZ -11", & + "W9XYZ R-09", & + "YW18FIFA RRR", & + " YW18FIFA 73", & + "TNX BOB 73 GL", & + "CQ YW18FIFA", & + " KA1ABC", & + "KA1ABC -11", & + " KA1ABC R-17", & + " YW18FIFA RR73", & + " KA1ABC 73", & + "123456789ABCDEF012", & + " -03", & + " R+03", & + " RRR", & + " 73"/ + diff --git a/wsjtx_lib/lib/msk144code.f90 b/wsjtx_lib/lib/msk144code.f90 new file mode 100644 index 0000000..2cb4d6a --- /dev/null +++ b/wsjtx_lib/lib/msk144code.f90 @@ -0,0 +1,83 @@ +program msk144code + +! Provides examples of message packing, bit and symbol ordering, +! LDPC encoding, and other necessary details of the MSK144 protocol. + + use packjt77 + character*77 c77 + character msg*37,msgsent*37,bad*1,msgtype*18 + integer*4 i4tone(144) + include 'msk144_testmsg.f90' + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: msk144code "message"' + print*,' msk144code -t' + print*,' ' + print*,'Examples:' + print*,' msk144code "KA1ABC WB9XYZ EN37"' + print*,' msk144code " R-03"' + print*,' msk144code "KA1ABC WB9XYZ R EN37"' + go to 999 + endif + + call getarg(1,msg) + nmsg=1 + if(msg(1:2).eq."-t") then + nmsg=NTEST + endif + + write(*,1010) +1010 format(4x,"Message",31x,"Decoded",29x,"Err i3.n3"/100("-")) + + do imsg=1,nmsg + if(nmsg.gt.1) msg=testmsg(imsg) + call fmtmsg(msg,iz) !To upper case, collapse multiple blanks + call genmsk_128_90(msg,ichk,msgsent,i4tone,itype) + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + msgtype="" + if(i3.eq.0) then + if(n3.eq.0) msgtype="Free text" + if(n3.eq.1) msgtype="DXpedition mode" + if(n3.eq.2) msgtype="EU VHF Contest" + if(n3.eq.3) msgtype="ARRL Field Day" + if(n3.eq.4) msgtype="ARRL Field Day" + if(n3.eq.5) msgtype="Telemetry" + if(n3.ge.6) msgtype="Undefined type" + endif + if(i3.eq.1) msgtype="Standard msg" + if(i3.eq.2) msgtype="EU VHF Contest" + if(i3.eq.3) msgtype="ARRL RTTY Roundup" + if(i3.eq.4) msgtype="Nonstandard calls" + if(i3.eq.5) msgtype="EU VHF Contest" + if(i3.ge.6) msgtype="Undefined msg type" + if(i3.ge.1) n3=-1 + if(i4tone(41).lt.0) then + msgtype="Sh msg" + i3=-1 + endif + bad=" " + if(msg.ne.msgsent) bad="*" + if(i3.eq.0.and.n3.ge.0) then + write(*,1020) imsg,msg,msgsent,bad,i3,n3,msgtype +1020 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',i1,1x,a18) + elseif(i3.ge.1) then + write(*,1022) imsg,msg,msgsent,bad,i3,msgtype +1022 format(i2,'.',1x,a37,1x,a37,1x,a1,2x,i1,'.',1x,1x,a18) + elseif(i3.lt.0) then + write(*,1024) imsg,msg,msgsent,bad,msgtype +1024 format(i2,'.',1x,a37,1x,a37,1x,a1,6x,a18) + endif + + enddo + + if(nmsg.eq.1) then + n=144 + if(i4tone(41).lt.0) n=40 + write(*,1030) i4tone(1:n) +1030 format(/'Channel symbols'/(72i1)) + endif + +999 end program msk144code diff --git a/wsjtx_lib/lib/msk144decodeframe.f90 b/wsjtx_lib/lib/msk144decodeframe.f90 new file mode 100644 index 0000000..b8bdba2 --- /dev/null +++ b/wsjtx_lib/lib/msk144decodeframe.f90 @@ -0,0 +1,112 @@ +subroutine msk144decodeframe(c,softbits,msgreceived,nsuccess) +! use timer_module, only: timer + use packjt77 + parameter (NSPM=864) + character*37 msgreceived + character*77 c77 + complex cb(42) + complex cfac,cca,ccb + complex c(NSPM) + integer*1 decoded77(77),apmask(128),cw(128) + integer s8(8),hardbits(144) + real*8 dt, fs, pi, twopi + real cbi(42),cbq(42) + real pp(12) + real softbits(144) + real llr(128) + logical first,unpk77_success + data first/.true./ + data s8/0,1,1,1,0,0,1,0/ + save first,cb,fs,pi,twopi,dt,s8,pp + + if(first) then +! define half-sine pulse and raised-cosine edge window + pi=4d0*datan(1d0) + twopi=8d0*datan(1d0) + fs=12000.0 + dt=1.0/fs + + do i=1,12 + angle=(i-1)*pi/12.0 + pp(i)=sin(angle) + enddo + +! define the sync word waveforms + s8=2*s8-1 + cbq(1:6)=pp(7:12)*s8(1) + cbq(7:18)=pp*s8(3) + cbq(19:30)=pp*s8(5) + cbq(31:42)=pp*s8(7) + cbi(1:12)=pp*s8(2) + cbi(13:24)=pp*s8(4) + cbi(25:36)=pp*s8(6) + cbi(37:42)=pp(1:6)*s8(8) + cb=cmplx(cbi,cbq) + first=.false. + endif + + nsuccess=0 + msgreceived=' ' + +! Estimate carrier phase. + cca=sum(c(1:1+41)*conjg(cb)) + ccb=sum(c(1+56*6:1+56*6+41)*conjg(cb)) + cfac=ccb*conjg(cca) + phase0=atan2(imag(cca+ccb),real(cca+ccb)) + +! Remove phase error - want constellation rotated so that sample points lie on I/Q axes + cfac=cmplx(cos(phase0),sin(phase0)) + c=c*conjg(cfac) + +! matched filter - + softbits(1)=sum(imag(c(1:6))*pp(7:12))+sum(imag(c(864-5:864))*pp(1:6)) + softbits(2)=sum(real(c(1:12))*pp) + do i=2,72 + softbits(2*i-1)=sum(imag(c(1+(i-1)*12-6:1+(i-1)*12+5))*pp) + softbits(2*i)=sum(real(c(7+(i-1)*12-6:7+(i-1)*12+5))*pp) + enddo + +! sync word hard error weight is used as a discriminator for +! frames that have reasonable probability of decoding + hardbits=0 + do i=1,144 + if( softbits(i) .ge. 0.0 ) then + hardbits(i)=1 + endif + enddo + nbadsync1=(8-sum( (2*hardbits(1:8)-1)*s8 ) )/2 + nbadsync2=(8-sum( (2*hardbits(1+56:8+56)-1)*s8 ) )/2 + nbadsync=nbadsync1+nbadsync2 + if( nbadsync .gt. 4 ) then + return + endif + +! normalize the softsymbols before submitting to decoder + sav=sum(softbits)/144 + s2av=sum(softbits*softbits)/144 + ssig=sqrt(s2av-sav*sav) + softbits=softbits/ssig + + sigma=0.60 + llr(1:48)=softbits(9:9+47) + llr(49:128)=softbits(65:65+80-1) + llr=2.0*llr/(sigma*sigma) + + max_iterations=10 + apmask=0 + dmin=0.0 + call bpdecode128_90(llr,apmask,max_iterations,decoded77,cw,nharderror,niterations) + if( nharderror .ge. 0 .and. nharderror .lt. 18 ) then + nsuccess=1 + write(c77,'(77i1)') decoded77 + read(c77(72:77),'(2b3)') n3,i3 + if( (i3.eq.0.and.(n3.eq.1 .or. n3.eq.3 .or. n3.eq.4 .or. n3.gt.5)) .or. i3.eq.3 .or. i3.gt.5 ) then + nsuccess=0 + else + call unpack77(c77,1,msgreceived,unpk77_success) + if(.not.unpk77_success) nsuccess=0 + endif + endif + + return +end subroutine msk144decodeframe diff --git a/wsjtx_lib/lib/msk144signalquality.f90 b/wsjtx_lib/lib/msk144signalquality.f90 new file mode 100644 index 0000000..c2ba5f6 --- /dev/null +++ b/wsjtx_lib/lib/msk144signalquality.f90 @@ -0,0 +1,213 @@ +subroutine msk144signalquality(cframe,snr,freq,t0,softbits,msg,dxcall, & + btrain,datadir,nbiterrors,eyeopening,pcoeffs) + + character*37 msg,msgsent + character*12 dxcall + character*12 training_dxcall + character*12 trained_dxcall + character*512 pcoeff_filename + character*8 date + character*10 time + character*5 zone + character*(*) datadir + + complex cframe(864) + complex cross(864) + complex cross_avg(864) + complex canalytic(1024) + complex cmodel(1024) + + integer i4tone(144) + integer hardbits(144) + integer msgbits(144) + integer values(8) + + logical*1 btrain + logical*1 first + logical*1 currently_training + logical*1 msg_has_dxcall + logical*1 is_training_frame + + real softbits(144) + real waveform(0:863) + real d(1024) + real phase(864) + real twopi,freq,phi,dphi0,dphi1,dphi + real*8 x(145),y(145),pp(145),sigmay(145),a(5),chisqr + real*8 pcoeffs(5) + + parameter (NFREQLOW=500,NFREQHIGH=2500) + data first/.true./ + save cross_avg,wt_avg,first,currently_training, & + navg,tlast,training_dxcall,trained_dxcall + + if (first) then + navg=0 + cross=cmplx(0.0,0.0) + cross_avg=cmplx(0.0,0.0) + wt_avg=0.0 + tlast=0.0 + trained_dxcall(1:12)=' ' + training_dxcall(1:12)=' ' + currently_training=.false. + first=.false. + endif + + if( (currently_training .and. (dxcall .ne. training_dxcall)) .or. & + (navg .gt. 10 )) then !reset and retrain + navg=0 + cross=cmplx(0.0,0.0) + cross_avg=cmplx(0.0,0.0) + wt_avg=0.0 + tlast=0.0 + trained_dxcall(1:12)=' ' + currently_training=.false. + training_dxcall(1:12)=' ' + trained_dxcall(1:12)=' ' +!write(*,*) 'reset to untrained state ' + endif + + indx_dxcall=index(msg,trim(dxcall)) + msg_has_dxcall = indx_dxcall .ge. 4 + + if( btrain .and. msg_has_dxcall .and. (.not. currently_training) ) then + currently_training=.true. + training_dxcall=trim(dxcall) + trained_dxcall(1:12)=' ' +!write(*,*) 'start training on call ',training_dxcall + endif + + if( msg_has_dxcall .and. currently_training ) then + trained_dxcall(1:12)=' ' + training_dxcall=dxcall + endif + +! use decoded message to figure out how many bit errors in the frame + do i=1, 144 + hardbits(i)=0 + if(softbits(i) .gt. 0 ) hardbits(i)=1 + enddo + +! generate tones from decoded message + ichk=0 + call genmsk_128_90(msg,ichk,msgsent,i4tone,itype) + +! reconstruct message bits from tones + msgbits(1)=0 + do i=1,143 + if( i4tone(i) .eq. 0 ) then + if( mod(i,2) .eq. 1 ) then + msgbits(i+1)=msgbits(i) + else + msgbits(i+1)=mod(msgbits(i)+1,2) + endif + else + if( mod(i,2) .eq. 1 ) then + msgbits(i+1)=mod(msgbits(i)+1,2) + else + msgbits(i+1)=msgbits(i) + endif + endif + enddo + + nbiterrors=0 + do i=1,144 + if( hardbits(i) .ne. msgbits(i) ) nbiterrors=nbiterrors+1 + enddo + + nplus=0 + nminus=0 + eyetop=1 + eyebot=-1 + do i=1,144 + if( msgbits(i) .eq. 1 ) then + if( softbits(i) .lt. eyetop ) eyetop=softbits(i) + else + if( softbits(i) .gt. eyebot ) eyebot=softbits(i) + endif + enddo + eyeopening=eyetop-eyebot + + is_training_frame = & + (snr.gt.5.0 .and.(nbiterrors.lt.7)) .and. & + (abs(t0-tlast) .gt. 0.072) .and. & + msg_has_dxcall + if( currently_training .and. is_training_frame ) then + twopi=8.0*atan(1.0) + nsym=144 + if( i4tone(41) .lt. 0 ) nsym=40 + dphi0=twopi*(freq-500)/12000.0 + dphi1=twopi*(freq+500)/12000.0 + phi=-twopi/8 + indx=0 + do i=1,nsym + if( i4tone(i) .eq. 0 ) then + dphi=dphi0 + else + dphi=dphi1 + endif + do j=1,6 + waveform(indx)=cos(phi); + indx=indx+1 + phi=mod(phi+dphi,twopi) + enddo + enddo +! convert the passband waveform to complex baseband + npts=864 + nfft=1024 + d=0 + d(1:864)=waveform(0:863) + call analytic(d,npts,nfft,canalytic,pcoeffs,.false.) ! don't equalize the model + call tweak1(canalytic,nfft,-freq,cmodel) + call four2a(cframe(1:864),864,1,-1,1) + call four2a(cmodel(1:864),864,1,-1,1) + +! Cross spectra from different messages can be averaged +! as long as all messages originate from dxcall. + cross=cmodel(1:864)*conjg(cframe)/1000.0 + cross=cshift(cross,864/2) + cross_avg=cross_avg+10**(snr/20.0)*cross + wt_avg=wt_avg+10**(snr/20.0) + navg=navg+1 + tlast=t0 + phase=atan2(imag(cross_avg),real(cross_avg)) + df=12000.0/864.0 + nm=145 + do i=1,145 + x(i)=(i-73)*df/1000.0 + enddo + y=phase((864/2-nm/2):(864/2+nm/2)) + sigmay=wt_avg/abs(cross_avg((864/2-nm/2):(864/2+nm/2))) + mode=1 + npts=145 + nterms=5 + call polyfit(x,y,sigmay,npts,nterms,mode,a,chisqr) + pp=a(1)+x*(a(2)+x*(a(3)+x*(a(4)+x*a(5)))) + rmsdiff=sum( (pp-phase((864/2-nm/2):(864/2+nm/2)))**2 )/145.0 +!write(*,*) 'training ',navg,sqrt(chisqr),rmsdiff + if( (sqrt(chisqr).lt.1.8) .and. (rmsdiff.lt.0.5) .and. (navg.ge.5) ) then + trained_dxcall=dxcall + call date_and_time(date,time,zone,values) + write(pcoeff_filename,'(i2.2,i2.2,i2.2,"_",i2.2,i2.2,i2.2)') & + values(1)-2000,values(2),values(3),values(5),values(6),values(7) + pcoeff_filename=trim(trained_dxcall)//"_"//trim(pcoeff_filename)//".pcoeff" + pcoeff_filename=datadir//'/'//trim(pcoeff_filename) +!write(*,*) 'trained - writing coefficients to: ',pcoeff_filename + open(17,file=pcoeff_filename,status='new') + write(17,'(i4,2f10.2,3i5,5e25.16)') navg,sqrt(chisqr),rmsdiff,NFREQLOW,NFREQHIGH,nterms,a + do i=1, 145 + write(17,*) x(i),pp(i),y(i),sigmay(i) + enddo + do i=1,864 + write(17,*) i,real(cframe(i)),imag(cframe(i)),real(cross_avg(i)),imag(cross_avg(i)) + enddo + close(17) + training_dxcall(1:12)=' ' + currently_training=.false. + btrain=.false. + navg=0 + endif + endif + + return + end subroutine msk144signalquality diff --git a/wsjtx_lib/lib/msk144sim.f90 b/wsjtx_lib/lib/msk144sim.f90 new file mode 100644 index 0000000..5a4f3cb --- /dev/null +++ b/wsjtx_lib/lib/msk144sim.f90 @@ -0,0 +1,106 @@ +program msk144sim + + use wavhdr + parameter (NMAX=30*12000) + real pings(0:NMAX-1) + real waveform(0:NMAX-1) + character arg*8,msg*37,msgsent*37,fname*40 + real wave(0:NMAX-1) !Simulated received waveform + real*8 twopi,freq,phi,dphi0,dphi1,dphi + type(hdr) h !Header for .wav file + integer*2 iwave(0:NMAX-1) + integer itone(144) !Message bits + + nargs=iargc() + if(nargs.ne.6) then + print*,'Usage: msk144sim message TRp freq width snr nfiles' + print*,'Example: msk144sim "K1ABC W9XYZ EN37" 15 1500 0.12 2 1' + print*,' msk144sim "K1ABC W9XYZ EN37" 30 1500 2.5 15 1' + go to 999 + endif + call getarg(1,msg) + call getarg(2,arg) + read(arg,*) nTRperiod + call getarg(3,arg) + read(arg,*) freq + call getarg(4,arg) + read(arg,*) width + call getarg(5,arg) + read(arg,*) snrdb + call getarg(6,arg) + read(arg,*) nfiles + +!sig is the peak amplitude of the ping. + sig=sqrt(2.0)*10.0**(0.05*snrdb) + npts=nTRperiod*12000 + h=default_header(12000,npts) + i1=len(trim(msg))-5 + ichk=0 + itype=1 + call fmtmsg(msg,iz) + call genmsk_128_90(msg,ichk,msgsent,itone,itype) + write(*,*) 'Requested message: ',msg + write(*,*) 'Message sent : ',msgsent + write(*,*) 'Tones: ' + if(itone(41).ge.0) then + write(*,'(1x,72i1)') itone(1:72) + write(*,'(1x,72i1)') itone(73:144) + else + write(*,'(1x,40i1)') itone(1:40) + endif + + twopi=8.d0*atan(1.d0) + nsym=144 + nsps=6 + if( itone(41) .lt. 0 ) nsym=40 + baud=2000.d0 + dphi0=twopi*(freq-0.25d0*baud)/12000.d0 + dphi1=twopi*(freq+0.25d0*baud)/12000.d0 + phi=0.0 + k=0 + nreps=npts/(nsym*nsps) + + do jrep=1,nreps + do i=1,nsym + if( itone(i) .eq. 0 ) then + dphi=dphi0 + else + dphi=dphi1 + endif + do j=1,nsps + waveform(k)=cos(phi) + k=k+1 + phi=mod(phi+dphi,twopi) + enddo + enddo + enddo + + if(itype.lt.1 .or. itype.gt.7) then + print*,'Illegal message' + go to 999 + endif + + call makepings(pings,nTRperiod,npts,width,sig) + +! call sgran() + do ifile=1,nfiles !Loop over requested number of files + write(fname,1002) ifile !Output filename +1002 format('000000_',i6.6) + open(10,file=fname(1:13)//'.wav',access='stream',status='unknown') + + wave=0.0 + iwave=0 + fac=sqrt(6000.0/2500.0) + do i=0,npts-1 + xx=gran() + wave(i)=pings(i)*waveform(i) + fac*xx + iwave(i)=30.0*wave(i) + enddo + + write(10) h,iwave(0:npts-1) !Save the .wav file + endfile(10) + close(10) + + enddo + +999 end program msk144sim diff --git a/wsjtx_lib/lib/msk144spd.f90 b/wsjtx_lib/lib/msk144spd.f90 new file mode 100644 index 0000000..2bc6dcf --- /dev/null +++ b/wsjtx_lib/lib/msk144spd.f90 @@ -0,0 +1,196 @@ +subroutine msk144spd(cbig,n,ntol,nsuccess,msgreceived,fc,fret,tret,navg,ct, & + softbits) + +! MSK144 short-ping-decoder + + use packjt77 + use timer_module, only: timer + + parameter (NSPM=864, MAXSTEPS=100, NFFT=NSPM, MAXCAND=5, NPATTERNS=6) + character*37 msgreceived + complex cbig(n) + complex cdat(3*NSPM) !Analytic signal + complex c(NSPM) + complex ct(NSPM) + complex ctmp(NFFT) + integer, dimension(1) :: iloc + integer indices(MAXSTEPS) + integer npkloc(10) + integer navpatterns(3,NPATTERNS) + integer navmask(3) + integer nstart(MAXCAND) + logical ismask(NFFT) + real detmet(-2:MAXSTEPS+3) + real detmet2(-2:MAXSTEPS+3) + real detfer(MAXSTEPS) + real rcw(12) + real ferrs(MAXCAND) + real snrs(MAXCAND) + real softbits(144) + real tonespec(NFFT) + real tpat(NPATTERNS) + real*8 dt, df, fs, pi, twopi + logical first + data first/.true./ + data navpatterns/ & + 0,1,0, & + 1,0,0, & + 0,0,1, & + 1,1,0, & + 0,1,1, & + 1,1,1/ + data tpat/1.5,0.5,2.5,1.0,2.0,1.5/ + + save df,first,fs,pi,twopi,dt,tframe,rcw + + if(first) then + nmatchedfilter=1 +! define half-sine pulse and raised-cosine edge window + pi=4d0*datan(1d0) + twopi=8d0*datan(1d0) + fs=12000.0 + dt=1.0/fs + df=fs/NFFT + tframe=NSPM/fs + + do i=1,12 + angle=(i-1)*pi/12.0 + rcw(i)=(1-cos(angle))/2 + enddo + + first=.false. + endif + + ! fill the detmet, detferr arrays + nstep=(n-NSPM)/216 ! 72ms/4=18ms steps + detmet=0 + detmet2=0 + detfer=-999.99 + nfhi=2*(fc+500) + nflo=2*(fc-500) + ihlo=nint((nfhi-2*ntol)/df) + 1 + ihhi=nint((nfhi+2*ntol)/df) + 1 + illo=nint((nflo-2*ntol)/df) + 1 + ilhi=nint((nflo+2*ntol)/df) + 1 + i2000=nint(nflo/df) + 1 + i4000=nint(nfhi/df) + 1 + do istp=1,nstep + ns=1+216*(istp-1) + ne=ns+NSPM-1 + if( ne .gt. n ) exit + ctmp=cmplx(0.0,0.0) + ctmp(1:NSPM)=cbig(ns:ne) + +! Coarse carrier frequency sync - seek tones at 2000 Hz and 4000 Hz in +! squared signal spectrum. + + ctmp=ctmp**2 + ctmp(1:12)=ctmp(1:12)*rcw + ctmp(NSPM-11:NSPM)=ctmp(NSPM-11:NSPM)*rcw(12:1:-1) + call four2a(ctmp,NFFT,1,-1,1) + tonespec=abs(ctmp)**2 + + ismask=.false. + ismask(ihlo:ihhi)=.true. ! high tone search window + iloc=maxloc(tonespec,ismask) + ihpk=iloc(1) + deltah=-real( (ctmp(ihpk-1)-ctmp(ihpk+1)) / (2*ctmp(ihpk)-ctmp(ihpk-1)-ctmp(ihpk+1)) ) + ah=tonespec(ihpk) + ahavp=(sum(tonespec,ismask)-ah)/count(ismask) + trath=ah/(ahavp+0.01) + ismask=.false. + ismask(illo:ilhi)=.true. ! window for low tone + iloc=maxloc(tonespec,ismask) + ilpk=iloc(1) + deltal=-real( (ctmp(ilpk-1)-ctmp(ilpk+1)) / (2*ctmp(ilpk)-ctmp(ilpk-1)-ctmp(ilpk+1)) ) + al=tonespec(ilpk) + alavp=(sum(tonespec,ismask)-al)/count(ismask) + tratl=al/(alavp+0.01) + fdiff=(ihpk+deltah-ilpk-deltal)*df + ferrh=(ihpk+deltah-i4000)*df/2.0 + ferrl=(ilpk+deltal-i2000)*df/2.0 + if( ah .ge. al ) then + ferr=ferrh + else + ferr=ferrl + endif + detmet(istp)=max(ah,al) + detmet2(istp)=max(trath,tratl) + detfer(istp)=ferr + enddo ! end of detection-metric and frequency error estimation loop + + call indexx(detmet(1:nstep),nstep,indices) !find median of detection metric vector + xmed=detmet(indices(nstep/4)) + detmet=detmet/xmed ! noise floor of detection metric is 1.0 + ndet=0 + + do ip=1,MAXCAND ! Find candidates + iloc=maxloc(detmet(1:nstep)) + il=iloc(1) + if( (detmet(il) .lt. 3.0) ) exit + if( abs(detfer(il)) .le. ntol ) then + ndet=ndet+1 + nstart(ndet)=1+(il-1)*216+1 + ferrs(ndet)=detfer(il) + snrs(ndet)=12.0*log10(detmet(il))/2-9.0 + endif + detmet(il)=0.0 + enddo + + if( ndet .lt. 3 ) then + do ip=1,MAXCAND-ndet ! Find candidates + iloc=maxloc(detmet2(1:nstep)) + il=iloc(1) + if( (detmet2(il) .lt. 12.0) ) exit + if( abs(detfer(il)) .le. ntol ) then + ndet=ndet+1 + nstart(ndet)=1+(il-1)*216+1 + ferrs(ndet)=detfer(il) + snrs(ndet)=12.0*log10(detmet2(il))/2-9.0 + endif + detmet2(il)=0.0 + enddo + endif + + nsuccess=0 + msgreceived=' ' + npeaks=2 + ntol0=8 + deltaf=2.0 + do icand=1,ndet ! Try to sync/demod/decode each candidate. + ib=max(1,nstart(icand)-NSPM) + ie=ib-1+3*NSPM + if( ie .gt. n ) then + ie=n + ib=ie-3*NSPM+1 + endif + cdat=cbig(ib:ie) + fo=fc+ferrs(icand) + do iav=1,NPATTERNS + navmask=navpatterns(1:3,iav) + call msk144sync(cdat,3,ntol0,deltaf,navmask,npeaks,fo,fest,npkloc, & + nsyncsuccess,xmax,c) + + if( nsyncsuccess .eq. 0 ) cycle + + do ipk=1,npeaks + do is=1,3 + ic0=npkloc(ipk) + if( is.eq.2) ic0=max(1,ic0-1) + if( is.eq.3) ic0=min(NSPM,ic0+1) + ct=cshift(c,ic0-1) + call msk144decodeframe(ct,softbits,msgreceived,ndecodesuccess) + if( ndecodesuccess .gt. 0 ) then + tret=(nstart(icand)+NSPM/2)/fs + fret=fest + navg=sum(navmask) + nsuccess=1 + return + endif + enddo + enddo + enddo + enddo ! candidate loop + + return +end subroutine msk144spd diff --git a/wsjtx_lib/lib/msk144sync.f90 b/wsjtx_lib/lib/msk144sync.f90 new file mode 100644 index 0000000..cfcd8c9 --- /dev/null +++ b/wsjtx_lib/lib/msk144sync.f90 @@ -0,0 +1,101 @@ +subroutine msk144sync(cdat,nframes,ntol,delf,navmask,npeaks,fc,fest, & + npklocs,nsuccess,xmax,c) + +!$ use omp_lib + + parameter (NSPM=864) + complex cdat(NSPM*nframes) + complex cdat2(NSPM*nframes,8) + complex c(NSPM) !Coherently averaged complex data + complex cs(NSPM,8) + complex cb(42) !Complex waveform for sync word + + integer s8(8) + integer iloc(1) + integer npklocs(npeaks) + integer navmask(nframes) ! defines which frames to average + + real cbi(42),cbq(42) + real pkamps(npeaks) + real xcc(0:NSPM-1) + real xccs(0:NSPM-1,8) + real xm(8) + real bf(8) + real pp(12) !Half-sine pulse shape + logical first + data first/.true./ + data s8/0,1,1,1,0,0,1,0/ + save first,cb,fs,pi,twopi,dt,s8,pp + + if(first) then + pi=4.0*atan(1.0) + twopi=8.0*atan(1.0) + fs=12000.0 + dt=1.0/fs + + do i=1,12 !Define half-sine pulse + angle=(i-1)*pi/12.0 + pp(i)=sin(angle) + enddo + +! Define the sync word waveforms + s8=2*s8-1 + cbq(1:6)=pp(7:12)*s8(1) + cbq(7:18)=pp*s8(3) + cbq(19:30)=pp*s8(5) + cbq(31:42)=pp*s8(7) + cbi(1:12)=pp*s8(2) + cbi(13:24)=pp*s8(4) + cbi(25:36)=pp*s8(6) + cbi(37:42)=pp(1:6)*s8(8) + cb=cmplx(cbi,cbq) + + first=.false. + endif + + nfreqs=2*nint(ntol/delf) + 1 + xm=0.0 + bf=0.0 + nthreads=1 +!$ nthreads=min(4,int(OMP_GET_MAX_THREADS(),4)) + nstep=nfreqs/nthreads + +!$OMP PARALLEL NUM_THREADS(nthreads) PRIVATE(id,if1,if2) + id=1 +!$ id=OMP_GET_THREAD_NUM() + 1 !Thread id = 1,2,... + if1=-nint(ntol/delf) + (id-1)*nstep + if2=if1+nstep-1 + if(id.eq.nthreads) if2=nint(ntol/delf) + call msk144_freq_search(cdat,fc,if1,if2,delf,nframes,navmask,cb, & + cdat2(1,id),xm(id),bf(id),cs(1,id),xccs(1,id)) +!$OMP END PARALLEL + + xmax=xm(1) + fest=fc+bf(1) + c=cs(1:NSPM,1) + xcc=xccs(0:NSPM-1,1) + if(nthreads.gt.1) then + do i=2,nthreads + if(xm(i).gt.xmax) then + xmax=xm(i) + fest=fc+bf(i) + c=cs(1:NSPM,i) + xcc=xccs(0:NSPM-1,i) + endif + enddo + endif + +! Find npeaks largest peaks + do ipk=1,npeaks + iloc=maxloc(xcc) + ic2=iloc(1) + npklocs(ipk)=ic2 + pkamps(ipk)=xcc(ic2-1) + xcc(max(0,ic2-7):min(NSPM-1,ic2+7))=0.0 + enddo + + nsuccess=0 + if(xmax.ge.1.3) nsuccess=1 + + return +end subroutine msk144sync diff --git a/wsjtx_lib/lib/msk40_freq_search.f90 b/wsjtx_lib/lib/msk40_freq_search.f90 new file mode 100644 index 0000000..97f74f5 --- /dev/null +++ b/wsjtx_lib/lib/msk40_freq_search.f90 @@ -0,0 +1,53 @@ +subroutine msk40_freq_search(cdat,fc,if1,if2,delf,nframes,navmask,cb, & + cdat2,xmax,bestf,cs,xccs) + + parameter (NSPM=240,NZ=7*NSPM) + complex cdat(NZ) + complex cdat2(NZ) + complex c(NSPM) !Coherently averaged complex data + complex ct2(2*NSPM) + complex cs(NSPM) + complex cb(42) !Complex waveform for sync word + complex cc(0:NSPM-1) + real xcc(0:NSPM-1) + real xccs(0:NSPM-1) + integer navmask(nframes) !Tells which frames to average + + navg=sum(navmask) + n=nframes*NSPM +! fac=1.0/(48.0*sqrt(float(navg))) + fac=1.0/(24.0*sqrt(float(navg))) + + do ifr=if1,if2 !Find freq that maximizes sync + ferr=ifr*delf + call tweak1(cdat,n,-(fc+ferr),cdat2) + c=0 + do i=1,nframes + ib=(i-1)*NSPM+1 + ie=ib+NSPM-1 + if( navmask(i) .eq. 1 ) c=c+cdat2(ib:ie) + enddo + + cc=0 + ct2(1:NSPM)=c + ct2(NSPM+1:2*NSPM)=c + + do ish=0,NSPM-1 + cc(ish)=dot_product(ct2(1+ish:42+ish),cb(1:42)) + enddo + + xcc=abs(cc) + xb=maxval(xcc)*fac + if(xb.gt.xmax) then + xmax=xb + bestf=ferr + cs=c + xccs=xcc + endif + enddo + +! write(71,3001) fc,delf,if1,if2,nframes,bestf,xmax +!3001 format(2f8.3,3i5,2f8.3) + + return +end subroutine msk40_freq_search diff --git a/wsjtx_lib/lib/msk40decodeframe.f90 b/wsjtx_lib/lib/msk40decodeframe.f90 new file mode 100644 index 0000000..277f89d --- /dev/null +++ b/wsjtx_lib/lib/msk40decodeframe.f90 @@ -0,0 +1,163 @@ +subroutine msk40decodeframe(c,mycall,hiscall,xsnr,bswl,nhasharray, & + msgreceived,nsuccess) +! use timer_module, only: timer + use packjt77 + + parameter (NSPM=240) + character*4 rpt(0:15) + character*12 mycall,hiscall,mycall0,hiscall0 + character*37 hashmsg,msgreceived + complex cb(42) + complex cfac,cca + complex c(NSPM) + integer*1 cw(32) + integer*1 decoded(16) + integer s8r(8),hardbits(40) + integer nhasharray(MAXRECENT,MAXRECENT) + real*8 dt, fs, pi, twopi + real cbi(42),cbq(42) + real pp(12) + real softbits(40) + real llr(32) + logical first + logical*1 bswl + data first/.true./ + data s8r/1,0,1,1,0,0,0,1/ + data mycall0/'dummy'/,hiscall0/'dummy'/ + data rpt/"-03 ","+00 ","+03 ","+06 ","+10 ","+13 ","+16 ", & + "R-03","R+00","R+03","R+06","R+10","R+13","R+16", & + "RRR ","73 "/ + save first,cb,fs,pi,twopi,dt,s8r,pp,rpt,mycall0,hiscall0,ihash + + if(first) then +! define half-sine pulse and raised-cosine edge window + pi=4d0*datan(1d0) + twopi=8d0*datan(1d0) + fs=12000.0 + dt=1.0/fs + + do i=1,12 + angle=(i-1)*pi/12.0 + pp(i)=sin(angle) + enddo + +! define the sync word waveforms + s8r=2*s8r-1 + cbq(1:6)=pp(7:12)*s8r(1) + cbq(7:18)=pp*s8r(3) + cbq(19:30)=pp*s8r(5) + cbq(31:42)=pp*s8r(7) + cbi(1:12)=pp*s8r(2) + cbi(13:24)=pp*s8r(4) + cbi(25:36)=pp*s8r(6) + cbi(37:42)=pp(1:6)*s8r(8) + cb=cmplx(cbi,cbq) + first=.false. + endif + + if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0) then + hashmsg=trim(mycall)//' '//trim(hiscall) + if( hashmsg .ne. ' ' .and. hiscall .ne. '' ) then ! protect against blank mycall/hiscall + call fmtmsg(hashmsg,iz) + call hash(hashmsg,37,ihash) + ihash=iand(ihash,4095) + else + ihash=9999 ! so that it can never match a received hash + endif + mycall0=mycall + hiscall0=hiscall + endif + + nsuccess=0 + msgreceived=' ' + +! Estimate carrier phase. + cca=sum(c(1:1+41)*conjg(cb)) + phase0=atan2(imag(cca),real(cca)) + +! Remove phase error - want constellation rotated so that sample points lie on I/Q axes + cfac=cmplx(cos(phase0),sin(phase0)) + c=c*conjg(cfac) + +! Matched filter. + softbits(1)=sum(imag(c(1:6))*pp(7:12))+sum(imag(c(NSPM-5:NSPM))*pp(1:6)) + softbits(2)=sum(real(c(1:12))*pp) + do i=2,20 + softbits(2*i-1)=sum(imag(c(1+(i-1)*12-6:1+(i-1)*12+5))*pp) + softbits(2*i)=sum(real(c(7+(i-1)*12-6:7+(i-1)*12+5))*pp) + enddo + +! Sync word hard error weight is used to reject frames that +! are unlikely to decode. + hardbits=0 + do i=1,40 + if( softbits(i) .ge. 0.0 ) then + hardbits(i)=1 + endif + enddo + nbadsync1=(8-sum( (2*hardbits(1:8)-1)*s8r ) )/2 + nbadsync=nbadsync1 + if( nbadsync .gt. 3 ) then + return + endif + +! Normalize the softsymbols before submitting to decoder. + sav=sum(softbits)/40 + s2av=sum(softbits*softbits)/40 + ssig=sqrt(s2av-sav*sav) + softbits=softbits/ssig + + sigma=0.75 +! if(xsnr.lt.0.0) sigma=0.75-0.0875*xsnr + if(xsnr.lt.0.0) sigma=0.75-0.11*xsnr + llr(1:32)=softbits(9:40) + llr=2.0*llr/(sigma*sigma) + + max_iterations=5 + call bpdecode40(llr,max_iterations,decoded,niterations) + if( niterations .ge. 0.0 ) then + call encode_msk40(decoded,cw) + nhammd=0 + cord=0.0 + do i=1,32 + if( cw(i) .ne. hardbits(i+8) ) then + nhammd=nhammd+1 + cord=cord+abs(softbits(i+8)) + endif + enddo + + imsg=0 + do i=1,16 + imsg=ishft(imsg,1)+iand(1_1,decoded(17-i)) + enddo + nrxrpt=iand(imsg,15) + nrxhash=(imsg-nrxrpt)/16 + if(nhammd.le.4 .and. cord .lt. 0.65 .and. & + nrxhash.eq.ihash .and. nrxrpt.ge.7) then + nsuccess=1 + write(msgreceived,'(a1,a,1x,a,a1,1x,a4)') "<",trim(mycall), & + trim(hiscall),">",rpt(nrxrpt) + return + elseif(bswl .and. nhammd.le.4 .and. cord.lt.0.65 .and. nrxrpt.ge.7 ) then + do i=1,MAXRECENT + do j=i+1,MAXRECENT + if( nrxhash .eq. nhasharray(i,j) ) then + nsuccess=2 + write(msgreceived,'(a1,a,1x,a,a1,1x,a4)') "<",trim(recent_calls(i)), & + trim(recent_calls(j)),">",rpt(nrxrpt) + elseif( nrxhash .eq. nhasharray(j,i) ) then + nsuccess=2 + write(msgreceived,'(a1,a,1x,a,a1,1x,a4)') "<",trim(recent_calls(j)), & + trim(recent_calls(i)),">",rpt(nrxrpt) + endif + enddo + enddo + if(nsuccess.eq.0) then + nsuccess=3 + write(msgreceived,'(a1,i4.4,a1,1x,a4)') "<",nrxhash,">",rpt(nrxrpt) + endif + endif + endif + + return +end subroutine msk40decodeframe diff --git a/wsjtx_lib/lib/msk40spd.f90 b/wsjtx_lib/lib/msk40spd.f90 new file mode 100644 index 0000000..63532ae --- /dev/null +++ b/wsjtx_lib/lib/msk40spd.f90 @@ -0,0 +1,198 @@ +subroutine msk40spd(cbig,n,ntol,mycall,hiscall,bswl,nhasharray, & + nsuccess,msgreceived,fc,fret,tret,navg) +! msk40 short-ping-decoder + + use packjt77 + use timer_module, only: timer + + parameter (NSPM=240, MAXSTEPS=150, NFFT=NSPM, MAXCAND=5, NPATTERNS=6) + character*12 mycall,hiscall + character*37 msgreceived + complex cbig(n) + complex cdat(3*NSPM) !Analytic signal + complex c(NSPM) + complex ct(NSPM) + complex ctmp(NFFT) + integer, dimension(1) :: iloc + integer indices(MAXSTEPS) + integer npkloc(10) + integer navpatterns(3,NPATTERNS) + integer navmask(3) + integer nstart(MAXCAND) + logical ismask(NFFT) + logical*1 bswl + real detmet(-2:MAXSTEPS+3) + real detmet2(-2:MAXSTEPS+3) + real detfer(MAXSTEPS) + real rcw(12) + real ferrs(MAXCAND) + real snrs(MAXCAND) + real tonespec(NFFT) + real tpat(NPATTERNS) + real*8 dt, df, fs, pi, twopi + logical first + data first/.true./ + data navpatterns/ & + 0,1,0, & + 1,0,0, & + 0,0,1, & + 1,1,0, & + 0,1,1, & + 1,1,1/ + data tpat/1.5,0.5,2.5,1.0,2.0,1.5/ + save df,first,fs,pi,twopi,dt,tframe,rcw + + if(first) then + nmatchedfilter=1 +! define half-sine pulse and raised-cosine edge window + pi=4d0*datan(1d0) + twopi=8d0*datan(1d0) + fs=12000.0 + dt=1.0/fs + df=fs/NFFT + tframe=NSPM/fs + + do i=1,12 + angle=(i-1)*pi/12.0 + rcw(i)=(1-cos(angle))/2 + enddo + + first=.false. + endif + + + ! fill the detmet, detferr arrays + nstep=(n-NSPM)/60 ! 20ms/4=5ms steps + detmet=0 + detmet2=0 + detfer=-999.99 + nfhi=2*(fc+500) + nflo=2*(fc-500) + ihlo=nint((nfhi-2*ntol)/df)+1 + ihhi=nint((nfhi+2*ntol)/df)+1 + illo=nint((nflo-2*ntol)/df)+1 + ilhi=nint((nflo+2*ntol)/df)+1 + i2000=nint(nflo/df)+1 + i4000=nint(nfhi/df)+1 + do istp=1,nstep + ns=1+60*(istp-1) + ne=ns+NSPM-1 + if( ne .gt. n ) exit + ctmp=cmplx(0.0,0.0) + ctmp(1:NSPM)=cbig(ns:ne) + +! Coarse carrier frequency sync - seek tones at 2000 Hz and 4000 Hz in +! squared signal spectrum. + + ctmp=ctmp**2 + ctmp(1:12)=ctmp(1:12)*rcw + ctmp(NSPM-11:NSPM)=ctmp(NSPM-11:NSPM)*rcw(12:1:-1) + call four2a(ctmp,NFFT,1,-1,1) + tonespec=abs(ctmp)**2 + + ismask=.false. + ismask(ihlo:ihhi)=.true. ! high tone search window + iloc=maxloc(tonespec,ismask) + ihpk=iloc(1) + deltah=-real( (ctmp(ihpk-1)-ctmp(ihpk+1)) / (2*ctmp(ihpk)-ctmp(ihpk-1)-ctmp(ihpk+1)) ) + ah=tonespec(ihpk) + ahavp=(sum(tonespec,ismask)-ah)/count(ismask) + trath=ah/(ahavp+0.01) + ismask=.false. + ismask(illo:ilhi)=.true. ! window for low tone + iloc=maxloc(tonespec,ismask) + ilpk=iloc(1) + deltal=-real( (ctmp(ilpk-1)-ctmp(ilpk+1)) / (2*ctmp(ilpk)-ctmp(ilpk-1)-ctmp(ilpk+1)) ) + al=tonespec(ilpk) + alavp=(sum(tonespec,ismask)-al)/count(ismask) + tratl=al/(alavp+0.01) + fdiff=(ihpk+deltah-ilpk-deltal)*df + ferrh=(ihpk+deltah-i4000)*df/2.0 + ferrl=(ilpk+deltal-i2000)*df/2.0 + if( ah .ge. al ) then + ferr=ferrh + else + ferr=ferrl + endif + detmet(istp)=max(ah,al) + detmet2(istp)=max(trath,tratl) + detfer(istp)=ferr + enddo ! end of detection-metric and frequency error estimation loop + + call indexx(detmet(1:nstep),nstep,indices) !find median of detection metric vector + xmed=detmet(indices(nstep/4)) + detmet=detmet/xmed ! noise floor of detection metric is 1.0 + ndet=0 + + do ip=1,MAXCAND ! Find candidates + iloc=maxloc(detmet(1:nstep)) + il=iloc(1) + if( (detmet(il) .lt. 3.5) ) exit + if( abs(detfer(il)) .le. ntol ) then + ndet=ndet+1 + nstart(ndet)=1+(il-1)*60+1 + ferrs(ndet)=detfer(il) + snrs(ndet)=12.0*log10(detmet(il))/2-9.0 + endif + detmet(il)=0.0 + enddo + + if( ndet .lt. 3 ) then + do ip=1,MAXCAND-ndet ! Find candidates + iloc=maxloc(detmet2(1:nstep)) + il=iloc(1) + if( (detmet2(il) .lt. 12.0) ) exit + if( abs(detfer(il)) .le. ntol ) then + ndet=ndet+1 + nstart(ndet)=1+(il-1)*60+1 + ferrs(ndet)=detfer(il) + snrs(ndet)=12.0*log10(detmet2(il))/2-9.0 + endif + detmet2(il)=0.0 + enddo + endif + + nsuccess=0 + msgreceived=' ' + npeaks=2 + ntol0=29 + deltaf=7.2 + do icand=1,ndet ! Try to sync/demod/decode each candidate. + ib=max(1,nstart(icand)-NSPM) + ie=ib-1+3*NSPM + if( ie .gt. n ) then + ie=n + ib=ie-3*NSPM+1 + endif + cdat=cbig(ib:ie) + fo=fc+ferrs(icand) + xsnr=snrs(icand) + do iav=1,NPATTERNS + navmask=navpatterns(1:3,iav) + call msk40sync(cdat,3,ntol0,deltaf,navmask,npeaks,fo,fest,npkloc, & + nsyncsuccess,c) + if( nsyncsuccess .eq. 0 ) cycle + + do ipk=1,npeaks + do is=1,3 + ic0=npkloc(ipk) + if( is.eq.2) ic0=max(1,ic0-1) + if( is.eq.3) ic0=min(NSPM,ic0+1) + ct=cshift(c,ic0-1) + call msk40decodeframe(ct,mycall,hiscall,xsnr,bswl,nhasharray, & + msgreceived,ndecodesuccess) + if( ndecodesuccess .gt. 0 ) then +!write(*,*) icand, iav, ipk, is, tret, fret, msgreceived + tret=(nstart(icand)+NSPM/2)/fs + fret=fest + navg=sum(navmask) + nsuccess=ndecodesuccess + return + endif + enddo + enddo + enddo + enddo ! candidate loop + + return +end subroutine msk40spd diff --git a/wsjtx_lib/lib/msk40sync.f90 b/wsjtx_lib/lib/msk40sync.f90 new file mode 100644 index 0000000..5a2ca1e --- /dev/null +++ b/wsjtx_lib/lib/msk40sync.f90 @@ -0,0 +1,103 @@ +subroutine msk40sync(cdat,nframes,ntol,delf,navmask,npeaks,fc,fest, & + npklocs,nsuccess,c) + + !$ use omp_lib + + parameter (NSPM=240) + complex cdat(NSPM*nframes) + complex cdat2(NSPM*nframes,8) + complex c(NSPM) !Coherently averaged complex data + complex cs(NSPM,8) + complex cb(42) !Complex waveform for sync word + + integer s8r(8) + integer iloc(1) + integer npklocs(npeaks) + integer navmask(nframes) ! defines which frames to average + + real cbi(42),cbq(42) + real pkamps(npeaks) + real xcc(0:NSPM-1) + real xccs(0:NSPM-1,8) + real xm(8) + real bf(8) + real pp(12) !Half-sine pulse shape + logical first + data first/.true./ + data s8r/1,0,1,1,0,0,0,1/ + save first,cb,fs,pi,twopi,dt,s8r,pp + + if(first) then + pi=4.0*atan(1.0) + twopi=8.0*atan(1.0) + fs=12000.0 + dt=1.0/fs + + do i=1,12 !Define half-sine pulse + angle=(i-1)*pi/12.0 + pp(i)=sin(angle) + enddo + +! Define the sync word waveforms + s8r=2*s8r-1 + cbq(1:6)=pp(7:12)*s8r(1) + cbq(7:18)=pp*s8r(3) + cbq(19:30)=pp*s8r(5) + cbq(31:42)=pp*s8r(7) + cbi(1:12)=pp*s8r(2) + cbi(13:24)=pp*s8r(4) + cbi(25:36)=pp*s8r(6) + cbi(37:42)=pp(1:6)*s8r(8) + cb=cmplx(cbi,cbq) + + first=.false. + endif + + nfreqs=2*nint(ntol/delf) + 1 + xm=0.0 + bf=0.0 + nthreads=1 + !$ nthreads=min(8,int(OMP_GET_MAX_THREADS(),4)) + nstep=nfreqs/nthreads + + !$OMP PARALLEL NUM_THREADS(nthreads) PRIVATE(id,if1,if2) + id=1 + !$ id=OMP_GET_THREAD_NUM() + 1 !Thread id = 1,2,... + if1=-nint(ntol/delf) + (id-1)*nstep + if2=if1+nstep-1 + if(id.eq.nthreads) if2=nint(ntol/delf) + call msk40_freq_search(cdat,fc,if1,if2,delf,nframes,navmask,cb, & + cdat2(1,id),xm(id),bf(id),cs(1,id),xccs(1,id)) +! write(73,3002) id,if1,if2,nfreqs,nthreads,bf(id),xm(id) +!3002 format(5i5,2f10.3) + !$OMP END PARALLEL + + xmax=xm(1) + fest=fc+bf(1) + c=cs(1:NSPM,1) + xcc=xccs(0:NSPM-1,1) + if(nthreads.gt.1) then + do i=2,nthreads + if(xm(i).gt.xmax) then + xmax=xm(i) + fest=fc+bf(i) + c=cs(1:NSPM,i) + xcc=xccs(0:NSPM-1,i) + endif + enddo + endif + +! Find npeaks largest peaks + do ipk=1,npeaks + iloc=maxloc(xcc) + ic2=iloc(1) + npklocs(ipk)=ic2 + pkamps(ipk)=xcc(ic2-1) + xcc(max(0,ic2-7):min(NSPM-1,ic2+7))=0.0 + enddo + + nsuccess=0 + if( xmax .ge. 1.3 ) nsuccess=1 + + return +end subroutine msk40sync diff --git a/wsjtx_lib/lib/mskber.f90 b/wsjtx_lib/lib/mskber.f90 new file mode 100644 index 0000000..4b31127 --- /dev/null +++ b/wsjtx_lib/lib/mskber.f90 @@ -0,0 +1,146 @@ +program mskber + +! Generate an MSK waveform, pass it through an AWGN channel, apply coherent +! MSK receiver, and count number of errors at each Eb/No. + + parameter (MAXSYM=1000*1000) + parameter (NSPS=5) !Samples per symbol + real ct(-NSPS:NSPS*MAXSYM-1) !cos(pi*t/2T) + real st(-NSPS:NSPS*MAXSYM-1) !sin(pi*t/2T) + real r(0:MAXSYM-1) !Random numbers to set test bits + real xsym(0:MAXSYM-1) !Soft Rx symbols + + complex xt(-NSPS:NSPS*MAXSYM-1) !Complex baseband Tx waveform + complex nt(-NSPS:NSPS*MAXSYM-1) !Generated AWGN channel noise + complex yt(-NSPS:NSPS*MAXSYM-1) !Received signal, yt = xt + fac*nt + complex cwave(-NSPS:NSPS*MAXSYM-1) !Audio waveform, Tx real part + complex z + + integer sym0(0:MAXSYM-1) !Generated test bits + integer sym(0:MAXSYM-1) !Hard-copy received bits + integer sym1(0:7) + + character*12 arg + data sym1/1,1,0,0,0,1,1,1/ + + nargs=iargc() + if(nargs.ne.2) then + print*,'Usage: mskber nsym EbNo' + go to 999 + endif + call getarg(1,arg) + read(arg,*) nsym + call getarg(2,arg) + read(arg,*) EbNo + + pi=4.0*atan(1.0) + + do i=-NSPS,NSPS*nsym-1 !Define ct, st arrays + t=i*pi/(2.0*NSPS) + ct(i)=cos(t) + st(i)=sin(t) + enddo + fac=1.0/sqrt(float(NSPS)) + + do iEbNo=0,10 !Loop over a range of Eb/No + sym0=0 + call random_number(r) + where(r(0:nsym-1).gt.0.5) sym0(0:nsym-1)=1 !Generate random data bits + if(nsym.eq.8) sym0(0:nsym-1)=sym1 + call mskmod(sym0,nsym,NSPS,ct,st,xt,cwave) !Generate Tx waveform + + do i=-NSPS,NSPS*nsym-1 !Generate Gaussian noise + xx=0.707*gran() + yy=0.707*gran() + nt(i)=cmplx(xx,yy) + enddo + fac_noise=10.0**(-iEbNo/20.0) + if(EbNo.ne.0.0) fac_noise=10.0**(-EbNo/20.0) + yt=xt + fac_noise*nt !Rx signal, with noise + + call mskdemod(yt,nsym,NSPS,ct,st,xsym) !MSK demodulator + + sym=0 + where(xsym.gt.0.0) sym=1 + + if(nsym.le.160 .and. EbNo.ne.0.0) then + write(*,1012) sym0(0:nsym-1) + if(nsym.gt.50) write(*,1012) + write(*,1012) sym(0:nsym-1) +1012 format(50i1) + do i=-nsps,nsps*nsym-1 + phi=i*2.0*pi*1500/12000.0 + z=cwave(i)*cmplx(cos(phi),sin(phi)) !Mix back to baseband + write(51,1014) float(i)/nsps,xt(i),abs(xt(i)),cwave(i),z +1014 format(8f8.4) + enddo + endif + +! Count the hard errors + nerr=count(sym(0:nsym-1).ne.sym0(0:nsym-1)) + thber=0.5*erfc(10.0**(iEbNo/20.0)) + xEbNo=iEbNo + if(EbNo.ne.0.0) xEbNo=EbNo + write(*,1000) xEbNo,thber,float(nerr)/nsym +1000 format(f6.1,2f10.6) + if(EbNo.ne.0.0) exit + enddo + +999 end program mskber + +subroutine mskmod(sym,nsym,nsps,ct,st,xt,cwave) + +! Generate MSK Tx waveform at baseband. + + integer sym(0:nsym-1) !Hard-copy received bits + complex xt(-nsps:nsps*nsym-1) !Complex baseband Tx waveform + complex cwave(-nsps:nsps*nsym-1) !Audio waveform, fc=1500 Hz. + real ct(-nsps:nsps*nsym-1) !cos(pi*t/2T) + real st(-nsps:nsps*nsym-1) !sin(pi*t/2T) + real ai(-nsps:nsps*nsym-1) !Rectangular pulses for even symbols + real aq(-nsps:nsps*nsym-1) !Rectangular pulses for odd symbols + + ai=0. + aq=0. + fac=1.0/sqrt(float(nsps)) + do j=0,nsym-1,2 + ia=(j-1)*nsps + ib=ia+2*nsps-1 + ai(ia:ib)=2*sym(j)-1 !Even bits as rectangular pulses + aq(ia+nsps:ib+nsps)=2*sym(j+1)-1 !Odd bits as rectangular pulses + enddo + xt=fac*cmplx(ai*ct,aq*st) !Baseband Tx waveform + + twopi=8.0*atan(1.0) + do i=-nsps,nsps*nsym-1 + phi=i*twopi*1500/12000.0 + cwave(i)=xt(i)*cmplx(cos(phi),-sin(phi)) + enddo + + return +end subroutine mskmod + +subroutine mskdemod(yt,nsym,nsps,ct,st,xsym) + +! MSK demodulator +! Rx phase must be known and stable; symbol sync must be established. + + complex yt(-nsps:nsps*nsym-1) !Received signal + real ct(-nsps:nsps*nsym-1) !cos(pi*t/2T) + real st(-nsps:nsps*nsym-1) !sin(pi*t/2T) + real xe(-nsps:nsps*nsym-1) !Temp array for received even symbols + real xo(-nsps:nsps*nsym-1) !Temp array for received odd symbols + real xsym(0:nsym-1) !Soft Rx symbols + + iz=nsps*(nsym+1) + xe(-nsps:nsps*nsym-1)=real(yt)*ct !Apply matched filters + xo(-nsps:nsps*nsym-1)=aimag(yt)*st + do j=0,nsym-1,2 + ia=(j-1)*nsps + ib=ia+2*nsps-1 + xsym(j)=sum(xe(ia:ib)) !Integrate over 2 symbol lengths + xsym(j+1)=sum(xo(ia+nsps:ib+nsps)) + enddo + + return +end subroutine mskdemod diff --git a/wsjtx_lib/lib/mskdt.f90 b/wsjtx_lib/lib/mskdt.f90 new file mode 100644 index 0000000..bca8359 --- /dev/null +++ b/wsjtx_lib/lib/mskdt.f90 @@ -0,0 +1,78 @@ +subroutine mskdt(d,npts,ty,yellow,nyel) + + parameter (NFFT=1024,NH=NFFT/2) + real d(npts) + real x(0:NFFT-1) + real green(703) + real yellow(703) !703 = 30*12000/512 + real ty(703) + real y2(175) + real ty2(175) + integer indx(703) + logical ok + complex c(0:NH) + equivalence (x,c) + + df=12000.0/NFFT + i1=nint(300.0/df) + i2=nint(800.0/df) + i3=nint(2200.0/df) + i4=nint(2700.0/df) + nblks=npts/NH - 1 + + do j=1,nblks + ib=(j+1)*NH + ia=ib-NFFT+1 + x=d(ia:ib) + call four2a(x,NFFT,1,-1,0) !r2c FFT + sqlow=0. + do i=i1,i2 + sqlow=sqlow + real(c(i))**2 + aimag(c(i))**2 + enddo + sqmid=0. + do i=i2,i3 + sqmid=sqmid + real(c(i))**2 + aimag(c(i))**2 + enddo + sqhigh=0. + do i=i3,i4 + sqhigh=sqhigh + real(c(i))**2 + aimag(c(i))**2 + enddo + green(j)=db(sqlow+sqmid+sqhigh) + yellow(j)=db(sqmid/(sqlow+sqhigh)) + ty(j)=j*512.0/12000.0 + enddo + + npct=20 + call pctile(green,nblks,npct,base) + green(1:nblks)=green(1:nblks) - base - 0.3 + call pctile(yellow,nblks,npct,base) + yellow(1:nblks)=yellow(1:nblks) - base - 0.6 + call indexx(yellow,nblks,indx) + + do j=1,nblks/4 + k=indx(nblks+1-j) + ty(j)=ty(k) + yellow(j)=yellow(k) + if(yellow(j).lt.1.5) exit + enddo + nyel=j-1 + k=1 + y2(1)=yellow(1) + ty2(1)=ty(1) + do j=2,nyel + ok=.true. + do i=1,j-1 + if(abs(ty(i)-ty(j)).lt.0.117) ok=.false. + enddo + if(ok) then + k=k+1 + y2(k)=yellow(j) + ty2(k)=ty(j) + endif + enddo + nyel=k + yellow(1:nyel)=y2(1:nyel) + ty(1:nyel)=ty2(1:nyel) + + return +end subroutine mskdt diff --git a/wsjtx_lib/lib/mskrtd.f90 b/wsjtx_lib/lib/mskrtd.f90 new file mode 100644 index 0000000..b2a5cbb --- /dev/null +++ b/wsjtx_lib/lib/mskrtd.f90 @@ -0,0 +1,257 @@ +subroutine mskrtd(id2,nutc0,tsec,ntol,nrxfreq,ndepth,mycall,hiscall, & + bshmsg,btrain,pcoeffs,bswl,datadir,line) + +! Real-time decoder for MSK144. +! Analysis block size = NZ = 7168 samples, t_block = 0.597333 s +! Called from hspec() at half-block increments, about 0.3 s + + use packjt77 + + parameter (NZ=7168) !Block size + parameter (NSPM=864) !Number of samples per message frame + parameter (NFFT1=8192) !FFT size for making analytic signal + parameter (NPATTERNS=4) !Number of frame averaging patterns to try + parameter (NSHMEM=50) !Number of recent SWL messages to remember + + character*4 decsym !"&" for mskspd or "^" for long averages + character*37 msgreceived !Decoded message + character*37 msglast,msglastswl !Used for dupechecking + character*80 line !Formatted line with UTC dB T Freq Msg + character*12 mycall,hiscall + character*37 recent_shmsgs(NSHMEM) + character*(*) datadir + + complex cdat(NFFT1) !Analytic signal + complex c(NSPM) !Coherently averaged complex data + complex ct(NSPM) + + integer*2 id2(NZ) !Raw 16-bit data + integer iavmask(8) + integer iavpatterns(8,NPATTERNS) + integer npkloc(10) + integer nhasharray(MAXRECENT,MAXRECENT) + integer nsnrlast,nsnrlastswl + + real d(NFFT1) + real pow(8) + real softbits(144) + real xmc(NPATTERNS) + real*8 pcoeffs(5) + + logical*1 bshmsg,btrain,bswl + logical*1 first + logical*1 bshdecode + logical*1 seenb4 + logical*1 bflag + logical*1 bvar + + data first/.true./ + data iavpatterns/ & + 1,1,1,1,0,0,0,0, & + 0,0,1,1,1,1,0,0, & + 1,1,1,1,1,0,0,0, & + 1,1,1,1,1,1,1,0/ + data xmc/2.0,4.5,2.5,3.5/ !Used to set time at center of averaging mask + save first,tsec0,nutc00,pnoise,cdat,msglast,msglastswl, & + nsnrlast,nsnrlastswl,nhasharray,recent_shmsgs +! nsnrlast,nsnrlastswl,nhasharray,recent_shmsgs,mycall13 + + if(first) then + tsec0=tsec + nutc00=nutc0 + pnoise=-1.0 + do i=1,MAXRECENT + recent_calls(i)(1:13)=' ' + enddo + do i=1,nshmem + recent_shmsgs(i)(1:37)=' ' + enddo + msglast=' ' + msglastswl=' ' + nsnrlast=-99 + nsnrlastswl=-99 + mycall13=mycall//' ' + dxcall13=hiscall//' ' + first=.false. + endif + + fc=nrxfreq + +! Reset if mycall or dxcall changes + if(mycall13(1:12).ne.mycall .or. dxcall13(1:12).ne.hiscall) first=.true. + +! Dupe checking setup + if(nutc00.ne.nutc0 .or. tsec.lt.tsec0) then ! reset dupe checker + msglast=' ' + msglastswl=' ' + nsnrlast=-99 + nsnrlastswl=-99 + nutc00=nutc0 + endif + + tframe=float(NSPM)/12000.0 + line=char(0) + msgreceived=' ' + max_iterations=10 + niterations=0 + d(1:NZ)=id2 + rms=sqrt(sum(d(1:NZ)*d(1:NZ))/NZ) + if(rms.lt.1.0) go to 999 + fac=1.0/rms + d(1:NZ)=fac*d(1:NZ) + d(NZ+1:NFFT1)=0. + bvar=.true. + if( btrain ) bvar=.false. ! if training, turn off rx eq + call analytic(d,NZ,NFFT1,cdat,pcoeffs,bvar) + +! Calculate average power for each frame and for the entire block. +! If decode is successful, largest power will be taken as signal+noise. +! If no decode, entire-block average will be used to update noise estimate. + pmax=-99 + do i=1,8 + ib=(i-1)*NSPM+1 + ie=ib+NSPM-1 + pow(i)=real(dot_product(cdat(ib:ie),cdat(ib:ie)))*rms**2 + pmax=max(pmax,pow(i)) + enddo + pavg=sum(pow)/8.0 + +! Short ping decoder uses squared-signal spectrum to determine where to +! center a 3-frame analysis window and attempts to decode each of the +! 3 frames along with 2- and 3-frame averages. + np=8*NSPM + call msk144spd(cdat,np,ntol,ndecodesuccess,msgreceived,fc,fest,tdec,navg,ct, & + softbits) + bshdecode=.false. + if(ndecodesuccess.eq.0 .and. (bshmsg.or.bswl)) then + call msk40spd(cdat,np,ntol,mycall,hiscall,bswl,nhasharray, & + ndecodesuccess,msgreceived,fc,fest,tdec,navg) + if(ndecodesuccess .ge.1) bshdecode=.true. + endif + if( ndecodesuccess .ge. 1 ) then + tdec=tsec+tdec + ipk=0 + is=0 + goto 900 + endif + +! If short ping decoder doesn't find a decode, +! Fast - short ping decoder only. +! Normal - try 4-frame averages +! Deep - try 4-, 5- and 7-frame averages. + npat=NPATTERNS + if( ndepth .eq. 1 ) npat=0 + if( ndepth .eq. 2 ) npat=2 + do iavg=1,npat + iavmask=iavpatterns(1:8,iavg) + navg=sum(iavmask) + deltaf=10.0/real(navg) ! search increment for frequency sync + npeaks=2 + call msk144sync(cdat(1:8*NSPM),8,ntol,deltaf,iavmask,npeaks,fc, & + fest,npkloc,nsyncsuccess,xmax,c) + if( nsyncsuccess .eq. 0 ) cycle + + do ipk=1,npeaks + do is=1,3 + ic0=npkloc(ipk) + if(is.eq.2) ic0=max(1,ic0-1) + if(is.eq.3) ic0=min(NSPM,ic0+1) + ct=cshift(c,ic0-1) + call msk144decodeframe(ct,softbits,msgreceived,ndecodesuccess) + if(ndecodesuccess .gt. 0) then + tdec=tsec+xmc(iavg)*tframe + goto 900 + endif + enddo !Slicer dither + enddo !Peak loop + enddo + + + msgreceived=' ' + +! no decode - update noise level used for calculating displayed snr. + if( pnoise .lt. 0 ) then ! initialize noise level + pnoise=pavg + elseif( pavg .gt. pnoise ) then ! noise level is slow to rise + pnoise=0.9*pnoise+0.1*pavg + elseif( pavg .lt. pnoise ) then ! and quick to fall + pnoise=pavg + endif + go to 999 + +900 continue +! Successful decode - estimate snr + if( pnoise .gt. 0.0 ) then + snr0=10.0*log10(pmax/pnoise-1.0) + else + snr0=0.0 + endif + nsnr=nint(snr0) + + if(.not. bshdecode) then + call msk144signalquality(ct,snr0,fest,tdec,softbits,msgreceived,hiscall, & + btrain,datadir,ncorrected,eyeopening,pcoeffs) + endif + + decsym=' & ' + if( btrain ) decsym=' ^ ' + if( bshdecode ) then + ncorrected=0 + eyeopening=0.0 + endif + + if( nsnr .lt. -8 ) nsnr=-8 + if( nsnr .gt. 24 ) nsnr=24 + +! Dupe check. + bflag=ndecodesuccess.eq.1 .and. & + (msgreceived.ne.msglast .or. nsnr.gt.nsnrlast .or. tsec.lt.tsec0) + if(bflag) then + msglast=msgreceived + nsnrlast=nsnr + if(.not. bshdecode) then + call update_msk40_hasharray(nhasharray) + endif + write(line,1021) nutc0,nsnr,tdec,nint(fest),decsym,msgreceived,char(0) +1021 format(i6.6,i4,f5.1,i5,a4,a37,a1) + elseif(bswl .and. ndecodesuccess.ge.2) then + seenb4=.false. + do i=1,nshmem + if( msgreceived .eq. recent_shmsgs(i) ) then + seenb4=.true. + endif + enddo + call update_recent_shmsgs(msgreceived,recent_shmsgs,nshmem) + bflag=seenb4 .and. & + (msgreceived.ne.msglastswl .or. nsnr.gt.nsnrlastswl .or. tsec.lt.tsec0) & + .and. nsnr.gt.-6 + if(bflag) then + msglastswl=msgreceived + nsnrlastswl=nsnr + write(line,1021) nutc0,nsnr,tdec,nint(fest),decsym,msgreceived,char(0) + endif + endif +999 tsec0=tsec + + return +end subroutine mskrtd + +subroutine update_recent_shmsgs(message,msgs,nsize) + character*37 msgs(nsize) + character*37 message + logical*1 seen + + seen=.false. + do i=1,nsize + if( msgs(i) .eq. message ) seen=.true. + enddo + + if( .not. seen ) then + do i=nsize,2,-1 + msgs(i)=msgs(i-1) + enddo + msgs(1)=message + endif + + return +end subroutine update_recent_shmsgs diff --git a/wsjtx_lib/lib/nfft.dat b/wsjtx_lib/lib/nfft.dat new file mode 100644 index 0000000..6378e64 --- /dev/null +++ b/wsjtx_lib/lib/nfft.dat @@ -0,0 +1,2067 @@ + 8 2 2 2 + 9 3 3 + 10 2 5 + 12 2 2 3 + 14 2 7 + 15 3 5 + 16 2 2 2 2 + 18 2 3 3 + 20 2 2 5 + 21 3 7 + 24 2 2 2 3 + 25 5 5 + 27 3 3 3 + 28 2 2 7 + 30 2 3 5 + 32 2 2 2 2 2 + 35 5 7 + 36 2 2 3 3 + 40 2 2 2 5 + 42 2 3 7 + 45 3 3 5 + 48 2 2 2 2 3 + 49 7 7 + 50 2 5 5 + 54 2 3 3 3 + 56 2 2 2 7 + 60 2 2 3 5 + 63 3 3 7 + 64 2 2 2 2 2 2 + 70 2 5 7 + 72 2 2 2 3 3 + 75 3 5 5 + 80 2 2 2 2 5 + 81 3 3 3 3 + 84 2 2 3 7 + 90 2 3 3 5 + 96 2 2 2 2 2 3 + 98 2 7 7 + 100 2 2 5 5 + 105 3 5 7 + 108 2 2 3 3 3 + 112 2 2 2 2 7 + 120 2 2 2 3 5 + 125 5 5 5 + 126 2 3 3 7 + 128 2 2 2 2 2 2 2 + 135 3 3 3 5 + 140 2 2 5 7 + 144 2 2 2 2 3 3 + 147 3 7 7 + 150 2 3 5 5 + 160 2 2 2 2 2 5 + 162 2 3 3 3 3 + 168 2 2 2 3 7 + 175 5 5 7 + 180 2 2 3 3 5 + 189 3 3 3 7 + 192 2 2 2 2 2 2 3 + 196 2 2 7 7 + 200 2 2 2 5 5 + 210 2 3 5 7 + 216 2 2 2 3 3 3 + 224 2 2 2 2 2 7 + 225 3 3 5 5 + 240 2 2 2 2 3 5 + 243 3 3 3 3 3 + 245 5 7 7 + 250 2 5 5 5 + 252 2 2 3 3 7 + 256 2 2 2 2 2 2 2 2 + 270 2 3 3 3 5 + 280 2 2 2 5 7 + 288 2 2 2 2 2 3 3 + 294 2 3 7 7 + 300 2 2 3 5 5 + 315 3 3 5 7 + 320 2 2 2 2 2 2 5 + 324 2 2 3 3 3 3 + 336 2 2 2 2 3 7 + 343 7 7 7 + 350 2 5 5 7 + 360 2 2 2 3 3 5 + 375 3 5 5 5 + 378 2 3 3 3 7 + 384 2 2 2 2 2 2 2 3 + 392 2 2 2 7 7 + 400 2 2 2 2 5 5 + 405 3 3 3 3 5 + 420 2 2 3 5 7 + 432 2 2 2 2 3 3 3 + 441 3 3 7 7 + 448 2 2 2 2 2 2 7 + 450 2 3 3 5 5 + 480 2 2 2 2 2 3 5 + 486 2 3 3 3 3 3 + 490 2 5 7 7 + 500 2 2 5 5 5 + 504 2 2 2 3 3 7 + 512 2 2 2 2 2 2 2 2 2 + 525 3 5 5 7 + 540 2 2 3 3 3 5 + 560 2 2 2 2 5 7 + 567 3 3 3 3 7 + 576 2 2 2 2 2 2 3 3 + 588 2 2 3 7 7 + 600 2 2 2 3 5 5 + 625 5 5 5 5 + 630 2 3 3 5 7 + 640 2 2 2 2 2 2 2 5 + 648 2 2 2 3 3 3 3 + 672 2 2 2 2 2 3 7 + 675 3 3 3 5 5 + 686 2 7 7 7 + 700 2 2 5 5 7 + 720 2 2 2 2 3 3 5 + 729 3 3 3 3 3 3 + 735 3 5 7 7 + 750 2 3 5 5 5 + 756 2 2 3 3 3 7 + 768 2 2 2 2 2 2 2 2 3 + 784 2 2 2 2 7 7 + 800 2 2 2 2 2 5 5 + 810 2 3 3 3 3 5 + 840 2 2 2 3 5 7 + 864 2 2 2 2 2 3 3 3 + 875 5 5 5 7 + 882 2 3 3 7 7 + 896 2 2 2 2 2 2 2 7 + 900 2 2 3 3 5 5 + 945 3 3 3 5 7 + 960 2 2 2 2 2 2 3 5 + 972 2 2 3 3 3 3 3 + 980 2 2 5 7 7 + 1000 2 2 2 5 5 5 + 1008 2 2 2 2 3 3 7 + 1024 2 2 2 2 2 2 2 2 2 2 + 1029 3 7 7 7 + 1050 2 3 5 5 7 + 1080 2 2 2 3 3 3 5 + 1120 2 2 2 2 2 5 7 + 1125 3 3 5 5 5 + 1134 2 3 3 3 3 7 + 1152 2 2 2 2 2 2 2 3 3 + 1176 2 2 2 3 7 7 + 1200 2 2 2 2 3 5 5 + 1215 3 3 3 3 3 5 + 1225 5 5 7 7 + 1250 2 5 5 5 5 + 1260 2 2 3 3 5 7 + 1280 2 2 2 2 2 2 2 2 5 + 1296 2 2 2 2 3 3 3 3 + 1323 3 3 3 7 7 + 1344 2 2 2 2 2 2 3 7 + 1350 2 3 3 3 5 5 + 1372 2 2 7 7 7 + 1400 2 2 2 5 5 7 + 1440 2 2 2 2 2 3 3 5 + 1458 2 3 3 3 3 3 3 + 1470 2 3 5 7 7 + 1500 2 2 3 5 5 5 + 1512 2 2 2 3 3 3 7 + 1536 2 2 2 2 2 2 2 2 2 3 + 1568 2 2 2 2 2 7 7 + 1575 3 3 5 5 7 + 1600 2 2 2 2 2 2 5 5 + 1620 2 2 3 3 3 3 5 + 1680 2 2 2 2 3 5 7 + 1701 3 3 3 3 3 7 + 1715 5 7 7 7 + 1728 2 2 2 2 2 2 3 3 3 + 1750 2 5 5 5 7 + 1764 2 2 3 3 7 7 + 1792 2 2 2 2 2 2 2 2 7 + 1800 2 2 2 3 3 5 5 + 1875 3 5 5 5 5 + 1890 2 3 3 3 5 7 + 1920 2 2 2 2 2 2 2 3 5 + 1944 2 2 2 3 3 3 3 3 + 1960 2 2 2 5 7 7 + 2000 2 2 2 2 5 5 5 + 2016 2 2 2 2 2 3 3 7 + 2025 3 3 3 3 5 5 + 2048 2 2 2 2 2 2 2 2 2 2 2 + 2058 2 3 7 7 7 + 2100 2 2 3 5 5 7 + 2160 2 2 2 2 3 3 3 5 + 2187 3 3 3 3 3 3 3 + 2205 3 3 5 7 7 + 2240 2 2 2 2 2 2 5 7 + 2250 2 3 3 5 5 5 + 2268 2 2 3 3 3 3 7 + 2304 2 2 2 2 2 2 2 2 3 3 + 2352 2 2 2 2 3 7 7 + 2400 2 2 2 2 2 3 5 5 + 2401 7 7 7 7 + 2430 2 3 3 3 3 3 5 + 2450 2 5 5 7 7 + 2500 2 2 5 5 5 5 + 2520 2 2 2 3 3 5 7 + 2560 2 2 2 2 2 2 2 2 2 5 + 2592 2 2 2 2 2 3 3 3 3 + 2625 3 5 5 5 7 + 2646 2 3 3 3 7 7 + 2688 2 2 2 2 2 2 2 3 7 + 2700 2 2 3 3 3 5 5 + 2744 2 2 2 7 7 7 + 2800 2 2 2 2 5 5 7 + 2835 3 3 3 3 5 7 + 2880 2 2 2 2 2 2 3 3 5 + 2916 2 2 3 3 3 3 3 3 + 2940 2 2 3 5 7 7 + 3000 2 2 2 3 5 5 5 + 3024 2 2 2 2 3 3 3 7 + 3072 2 2 2 2 2 2 2 2 2 2 3 + 3087 3 3 7 7 7 + 3125 5 5 5 5 5 + 3136 2 2 2 2 2 2 7 7 + 3150 2 3 3 5 5 7 + 3200 2 2 2 2 2 2 2 5 5 + 3240 2 2 2 3 3 3 3 5 + 3360 2 2 2 2 2 3 5 7 + 3375 3 3 3 5 5 5 + 3402 2 3 3 3 3 3 7 + 3430 2 5 7 7 7 + 3456 2 2 2 2 2 2 2 3 3 3 + 3500 2 2 5 5 5 7 + 3528 2 2 2 3 3 7 7 + 3584 2 2 2 2 2 2 2 2 2 7 + 3600 2 2 2 2 3 3 5 5 + 3645 3 3 3 3 3 3 5 + 3675 3 5 5 7 7 + 3750 2 3 5 5 5 5 + 3780 2 2 3 3 3 5 7 + 3840 2 2 2 2 2 2 2 2 3 5 + 3888 2 2 2 2 3 3 3 3 3 + 3920 2 2 2 2 5 7 7 + 3969 3 3 3 3 7 7 + 4000 2 2 2 2 2 5 5 5 + 4032 2 2 2 2 2 2 3 3 7 + 4050 2 3 3 3 3 5 5 + 4096 2 2 2 2 2 2 2 2 2 2 2 2 + 4116 2 2 3 7 7 7 + 4200 2 2 2 3 5 5 7 + 4320 2 2 2 2 2 3 3 3 5 + 4374 2 3 3 3 3 3 3 3 + 4375 5 5 5 5 7 + 4410 2 3 3 5 7 7 + 4480 2 2 2 2 2 2 2 5 7 + 4500 2 2 3 3 5 5 5 + 4536 2 2 2 3 3 3 3 7 + 4608 2 2 2 2 2 2 2 2 2 3 3 + 4704 2 2 2 2 2 3 7 7 + 4725 3 3 3 5 5 7 + 4800 2 2 2 2 2 2 3 5 5 + 4802 2 7 7 7 7 + 4860 2 2 3 3 3 3 3 5 + 4900 2 2 5 5 7 7 + 5000 2 2 2 5 5 5 5 + 5040 2 2 2 2 3 3 5 7 + 5103 3 3 3 3 3 3 7 + 5120 2 2 2 2 2 2 2 2 2 2 5 + 5145 3 5 7 7 7 + 5184 2 2 2 2 2 2 3 3 3 3 + 5250 2 3 5 5 5 7 + 5292 2 2 3 3 3 7 7 + 5376 2 2 2 2 2 2 2 2 3 7 + 5400 2 2 2 3 3 3 5 5 + 5488 2 2 2 2 7 7 7 + 5600 2 2 2 2 2 5 5 7 + 5625 3 3 5 5 5 5 + 5670 2 3 3 3 3 5 7 + 5760 2 2 2 2 2 2 2 3 3 5 + 5832 2 2 2 3 3 3 3 3 3 + 5880 2 2 2 3 5 7 7 + 6000 2 2 2 2 3 5 5 5 + 6048 2 2 2 2 2 3 3 3 7 + 6075 3 3 3 3 3 5 5 + 6125 5 5 5 7 7 + 6144 2 2 2 2 2 2 2 2 2 2 2 3 + 6174 2 3 3 7 7 7 + 6250 2 5 5 5 5 5 + 6272 2 2 2 2 2 2 2 7 7 + 6300 2 2 3 3 5 5 7 + 6400 2 2 2 2 2 2 2 2 5 5 + 6480 2 2 2 2 3 3 3 3 5 + 6561 3 3 3 3 3 3 3 3 + 6615 3 3 3 5 7 7 + 6720 2 2 2 2 2 2 3 5 7 + 6750 2 3 3 3 5 5 5 + 6804 2 2 3 3 3 3 3 7 + 6860 2 2 5 7 7 7 + 6912 2 2 2 2 2 2 2 2 3 3 3 + 7000 2 2 2 5 5 5 7 + 7056 2 2 2 2 3 3 7 7 + 7168 2 2 2 2 2 2 2 2 2 2 7 + 7200 2 2 2 2 2 3 3 5 5 + 7203 3 7 7 7 7 + 7290 2 3 3 3 3 3 3 5 + 7350 2 3 5 5 7 7 + 7500 2 2 3 5 5 5 5 + 7560 2 2 2 3 3 3 5 7 + 7680 2 2 2 2 2 2 2 2 2 3 5 + 7776 2 2 2 2 2 3 3 3 3 3 + 7840 2 2 2 2 2 5 7 7 + 7875 3 3 5 5 5 7 + 7938 2 3 3 3 3 7 7 + 8000 2 2 2 2 2 2 5 5 5 + 8064 2 2 2 2 2 2 2 3 3 7 + 8100 2 2 3 3 3 3 5 5 + 8192 2 2 2 2 2 2 2 2 2 2 2 2 2 + 8232 2 2 2 3 7 7 7 + 8400 2 2 2 2 3 5 5 7 + 8505 3 3 3 3 3 5 7 + 8575 5 5 7 7 7 + 8640 2 2 2 2 2 2 3 3 3 5 + 8748 2 2 3 3 3 3 3 3 3 + 8750 2 5 5 5 5 7 + 8820 2 2 3 3 5 7 7 + 8960 2 2 2 2 2 2 2 2 5 7 + 9000 2 2 2 3 3 5 5 5 + 9072 2 2 2 2 3 3 3 3 7 + 9216 2 2 2 2 2 2 2 2 2 2 3 3 + 9261 3 3 3 7 7 7 + 9375 3 5 5 5 5 5 + 9408 2 2 2 2 2 2 3 7 7 + 9450 2 3 3 3 5 5 7 + 9600 2 2 2 2 2 2 2 3 5 5 + 9604 2 2 7 7 7 7 + 9720 2 2 2 3 3 3 3 3 5 + 9800 2 2 2 5 5 7 7 + 10000 2 2 2 2 5 5 5 5 + 10080 2 2 2 2 2 3 3 5 7 + 10125 3 3 3 3 5 5 5 + 10206 2 3 3 3 3 3 3 7 + 10240 2 2 2 2 2 2 2 2 2 2 2 5 + 10290 2 3 5 7 7 7 + 10368 2 2 2 2 2 2 2 3 3 3 3 + 10500 2 2 3 5 5 5 7 + 10584 2 2 2 3 3 3 7 7 + 10752 2 2 2 2 2 2 2 2 2 3 7 + 10800 2 2 2 2 3 3 3 5 5 + 10935 3 3 3 3 3 3 3 5 + 10976 2 2 2 2 2 7 7 7 + 11025 3 3 5 5 7 7 + 11200 2 2 2 2 2 2 5 5 7 + 11250 2 3 3 5 5 5 5 + 11340 2 2 3 3 3 3 5 7 + 11520 2 2 2 2 2 2 2 2 3 3 5 + 11664 2 2 2 2 3 3 3 3 3 3 + 11760 2 2 2 2 3 5 7 7 + 11907 3 3 3 3 3 7 7 + 12000 2 2 2 2 2 3 5 5 5 + 12005 5 7 7 7 7 + 12096 2 2 2 2 2 2 3 3 3 7 + 12150 2 3 3 3 3 3 5 5 + 12250 2 5 5 5 7 7 + 12288 2 2 2 2 2 2 2 2 2 2 2 2 3 + 12348 2 2 3 3 7 7 7 + 12500 2 2 5 5 5 5 5 + 12544 2 2 2 2 2 2 2 2 7 7 + 12600 2 2 2 3 3 5 5 7 + 12800 2 2 2 2 2 2 2 2 2 5 5 + 12960 2 2 2 2 2 3 3 3 3 5 + 13122 2 3 3 3 3 3 3 3 3 + 13125 3 5 5 5 5 7 + 13230 2 3 3 3 5 7 7 + 13440 2 2 2 2 2 2 2 3 5 7 + 13500 2 2 3 3 3 5 5 5 + 13608 2 2 2 3 3 3 3 3 7 + 13720 2 2 2 5 7 7 7 + 13824 2 2 2 2 2 2 2 2 2 3 3 3 + 14000 2 2 2 2 5 5 5 7 + 14112 2 2 2 2 2 3 3 7 7 + 14175 3 3 3 3 5 5 7 + 14336 2 2 2 2 2 2 2 2 2 2 2 7 + 14400 2 2 2 2 2 2 3 3 5 5 + 14406 2 3 7 7 7 7 + 14580 2 2 3 3 3 3 3 3 5 + 14700 2 2 3 5 5 7 7 + 15000 2 2 2 3 5 5 5 5 + 15120 2 2 2 2 3 3 3 5 7 + 15309 3 3 3 3 3 3 3 7 + 15360 2 2 2 2 2 2 2 2 2 2 3 5 + 15435 3 3 5 7 7 7 + 15552 2 2 2 2 2 2 3 3 3 3 3 + 15625 5 5 5 5 5 5 + 15680 2 2 2 2 2 2 5 7 7 + 15750 2 3 3 5 5 5 7 + 15876 2 2 3 3 3 3 7 7 + 16000 2 2 2 2 2 2 2 5 5 5 + 16128 2 2 2 2 2 2 2 2 3 3 7 + 16200 2 2 2 3 3 3 3 5 5 + 16384 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 16464 2 2 2 2 3 7 7 7 + 16800 2 2 2 2 2 3 5 5 7 + 16807 7 7 7 7 7 + 16875 3 3 3 5 5 5 5 + 17010 2 3 3 3 3 3 5 7 + 17150 2 5 5 7 7 7 + 17280 2 2 2 2 2 2 2 3 3 3 5 + 17496 2 2 2 3 3 3 3 3 3 3 + 17500 2 2 5 5 5 5 7 + 17640 2 2 2 3 3 5 7 7 + 17920 2 2 2 2 2 2 2 2 2 5 7 + 18000 2 2 2 2 3 3 5 5 5 + 18144 2 2 2 2 2 3 3 3 3 7 + 18225 3 3 3 3 3 3 5 5 + 18375 3 5 5 5 7 7 + 18432 2 2 2 2 2 2 2 2 2 2 2 3 3 + 18522 2 3 3 3 7 7 7 + 18750 2 3 5 5 5 5 5 + 18816 2 2 2 2 2 2 2 3 7 7 + 18900 2 2 3 3 3 5 5 7 + 19200 2 2 2 2 2 2 2 2 3 5 5 + 19208 2 2 2 7 7 7 7 + 19440 2 2 2 2 3 3 3 3 3 5 + 19600 2 2 2 2 5 5 7 7 + 19683 3 3 3 3 3 3 3 3 3 + 19845 3 3 3 3 5 7 7 + 20000 2 2 2 2 2 5 5 5 5 + 20160 2 2 2 2 2 2 3 3 5 7 + 20250 2 3 3 3 3 5 5 5 + 20412 2 2 3 3 3 3 3 3 7 + 20480 2 2 2 2 2 2 2 2 2 2 2 2 5 + 20580 2 2 3 5 7 7 7 + 20736 2 2 2 2 2 2 2 2 3 3 3 3 + 21000 2 2 2 3 5 5 5 7 + 21168 2 2 2 2 3 3 3 7 7 + 21504 2 2 2 2 2 2 2 2 2 2 3 7 + 21600 2 2 2 2 2 3 3 3 5 5 + 21609 3 3 7 7 7 7 + 21870 2 3 3 3 3 3 3 3 5 + 21875 5 5 5 5 5 7 + 21952 2 2 2 2 2 2 7 7 7 + 22050 2 3 3 5 5 7 7 + 22400 2 2 2 2 2 2 2 5 5 7 + 22500 2 2 3 3 5 5 5 5 + 22680 2 2 2 3 3 3 3 5 7 + 23040 2 2 2 2 2 2 2 2 2 3 3 5 + 23328 2 2 2 2 2 3 3 3 3 3 3 + 23520 2 2 2 2 2 3 5 7 7 + 23625 3 3 3 5 5 5 7 + 23814 2 3 3 3 3 3 7 7 + 24000 2 2 2 2 2 2 3 5 5 5 + 24010 2 5 7 7 7 7 + 24192 2 2 2 2 2 2 2 3 3 3 7 + 24300 2 2 3 3 3 3 3 5 5 + 24500 2 2 5 5 5 7 7 + 24576 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 24696 2 2 2 3 3 7 7 7 + 25000 2 2 2 5 5 5 5 5 + 25088 2 2 2 2 2 2 2 2 2 7 7 + 25200 2 2 2 2 3 3 5 5 7 + 25515 3 3 3 3 3 3 5 7 + 25600 2 2 2 2 2 2 2 2 2 2 5 5 + 25725 3 5 5 7 7 7 + 25920 2 2 2 2 2 2 3 3 3 3 5 + 26244 2 2 3 3 3 3 3 3 3 3 + 26250 2 3 5 5 5 5 7 + 26460 2 2 3 3 3 5 7 7 + 26880 2 2 2 2 2 2 2 2 3 5 7 + 27000 2 2 2 3 3 3 5 5 5 + 27216 2 2 2 2 3 3 3 3 3 7 + 27440 2 2 2 2 5 7 7 7 + 27648 2 2 2 2 2 2 2 2 2 2 3 3 3 + 27783 3 3 3 3 7 7 7 + 28000 2 2 2 2 2 5 5 5 7 + 28125 3 3 5 5 5 5 5 + 28224 2 2 2 2 2 2 3 3 7 7 + 28350 2 3 3 3 3 5 5 7 + 28672 2 2 2 2 2 2 2 2 2 2 2 2 7 + 28800 2 2 2 2 2 2 2 3 3 5 5 + 28812 2 2 3 7 7 7 7 + 29160 2 2 2 3 3 3 3 3 3 5 + 29400 2 2 2 3 5 5 7 7 + 30000 2 2 2 2 3 5 5 5 5 + 30240 2 2 2 2 2 3 3 3 5 7 + 30375 3 3 3 3 3 5 5 5 + 30618 2 3 3 3 3 3 3 3 7 + 30625 5 5 5 5 7 7 + 30720 2 2 2 2 2 2 2 2 2 2 2 3 5 + 30870 2 3 3 5 7 7 7 + 31104 2 2 2 2 2 2 2 3 3 3 3 3 + 31250 2 5 5 5 5 5 5 + 31360 2 2 2 2 2 2 2 5 7 7 + 31500 2 2 3 3 5 5 5 7 + 31752 2 2 2 3 3 3 3 7 7 + 32000 2 2 2 2 2 2 2 2 5 5 5 + 32256 2 2 2 2 2 2 2 2 2 3 3 7 + 32400 2 2 2 2 3 3 3 3 5 5 + 32768 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 32805 3 3 3 3 3 3 3 3 5 + 32928 2 2 2 2 2 3 7 7 7 + 33075 3 3 3 5 5 7 7 + 33600 2 2 2 2 2 2 3 5 5 7 + 33614 2 7 7 7 7 7 + 33750 2 3 3 3 5 5 5 5 + 34020 2 2 3 3 3 3 3 5 7 + 34300 2 2 5 5 7 7 7 + 34560 2 2 2 2 2 2 2 2 3 3 3 5 + 34992 2 2 2 2 3 3 3 3 3 3 3 + 35000 2 2 2 5 5 5 5 7 + 35280 2 2 2 2 3 3 5 7 7 + 35721 3 3 3 3 3 3 7 7 + 35840 2 2 2 2 2 2 2 2 2 2 5 7 + 36000 2 2 2 2 2 3 3 5 5 5 + 36015 3 5 7 7 7 7 + 36288 2 2 2 2 2 2 3 3 3 3 7 + 36450 2 3 3 3 3 3 3 5 5 + 36750 2 3 5 5 5 7 7 + 36864 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 37044 2 2 3 3 3 7 7 7 + 37500 2 2 3 5 5 5 5 5 + 37632 2 2 2 2 2 2 2 2 3 7 7 + 37800 2 2 2 3 3 3 5 5 7 + 38400 2 2 2 2 2 2 2 2 2 3 5 5 + 38416 2 2 2 2 7 7 7 7 + 38880 2 2 2 2 2 3 3 3 3 3 5 + 39200 2 2 2 2 2 5 5 7 7 + 39366 2 3 3 3 3 3 3 3 3 3 + 39375 3 3 5 5 5 5 7 + 39690 2 3 3 3 3 5 7 7 + 40000 2 2 2 2 2 2 5 5 5 5 + 40320 2 2 2 2 2 2 2 3 3 5 7 + 40500 2 2 3 3 3 3 5 5 5 + 40824 2 2 2 3 3 3 3 3 3 7 + 40960 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 41160 2 2 2 3 5 7 7 7 + 41472 2 2 2 2 2 2 2 2 2 3 3 3 3 + 42000 2 2 2 2 3 5 5 5 7 + 42336 2 2 2 2 2 3 3 3 7 7 + 42525 3 3 3 3 3 5 5 7 + 42875 5 5 5 7 7 7 + 43008 2 2 2 2 2 2 2 2 2 2 2 3 7 + 43200 2 2 2 2 2 2 3 3 3 5 5 + 43218 2 3 3 7 7 7 7 + 43740 2 2 3 3 3 3 3 3 3 5 + 43750 2 5 5 5 5 5 7 + 43904 2 2 2 2 2 2 2 7 7 7 + 44100 2 2 3 3 5 5 7 7 + 44800 2 2 2 2 2 2 2 2 5 5 7 + 45000 2 2 2 3 3 5 5 5 5 + 45360 2 2 2 2 3 3 3 3 5 7 + 45927 3 3 3 3 3 3 3 3 7 + 46080 2 2 2 2 2 2 2 2 2 2 3 3 5 + 46305 3 3 3 5 7 7 7 + 46656 2 2 2 2 2 2 3 3 3 3 3 3 + 46875 3 5 5 5 5 5 5 + 47040 2 2 2 2 2 2 3 5 7 7 + 47250 2 3 3 3 5 5 5 7 + 47628 2 2 3 3 3 3 3 7 7 + 48000 2 2 2 2 2 2 2 3 5 5 5 + 48020 2 2 5 7 7 7 7 + 48384 2 2 2 2 2 2 2 2 3 3 3 7 + 48600 2 2 2 3 3 3 3 3 5 5 + 49000 2 2 2 5 5 5 7 7 + 49152 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 49392 2 2 2 2 3 3 7 7 7 + 50000 2 2 2 2 5 5 5 5 5 + 50176 2 2 2 2 2 2 2 2 2 2 7 7 + 50400 2 2 2 2 2 3 3 5 5 7 + 50421 3 7 7 7 7 7 + 50625 3 3 3 3 5 5 5 5 + 51030 2 3 3 3 3 3 3 5 7 + 51200 2 2 2 2 2 2 2 2 2 2 2 5 5 + 51450 2 3 5 5 7 7 7 + 51840 2 2 2 2 2 2 2 3 3 3 3 5 + 52488 2 2 2 3 3 3 3 3 3 3 3 + 52500 2 2 3 5 5 5 5 7 + 52920 2 2 2 3 3 3 5 7 7 + 53760 2 2 2 2 2 2 2 2 2 3 5 7 + 54000 2 2 2 2 3 3 3 5 5 5 + 54432 2 2 2 2 2 3 3 3 3 3 7 + 54675 3 3 3 3 3 3 3 5 5 + 54880 2 2 2 2 2 5 7 7 7 + 55125 3 3 5 5 5 7 7 + 55296 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 55566 2 3 3 3 3 7 7 7 + 56000 2 2 2 2 2 2 5 5 5 7 + 56250 2 3 3 5 5 5 5 5 + 56448 2 2 2 2 2 2 2 3 3 7 7 + 56700 2 2 3 3 3 3 5 5 7 + 57344 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 57600 2 2 2 2 2 2 2 2 3 3 5 5 + 57624 2 2 2 3 7 7 7 7 + 58320 2 2 2 2 3 3 3 3 3 3 5 + 58800 2 2 2 2 3 5 5 7 7 + 59049 3 3 3 3 3 3 3 3 3 3 + 59535 3 3 3 3 3 5 7 7 + 60000 2 2 2 2 2 3 5 5 5 5 + 60025 5 5 7 7 7 7 + 60480 2 2 2 2 2 2 3 3 3 5 7 + 60750 2 3 3 3 3 3 5 5 5 + 61236 2 2 3 3 3 3 3 3 3 7 + 61250 2 5 5 5 5 7 7 + 61440 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 61740 2 2 3 3 5 7 7 7 + 62208 2 2 2 2 2 2 2 2 3 3 3 3 3 + 62500 2 2 5 5 5 5 5 5 + 62720 2 2 2 2 2 2 2 2 5 7 7 + 63000 2 2 2 3 3 5 5 5 7 + 63504 2 2 2 2 3 3 3 3 7 7 + 64000 2 2 2 2 2 2 2 2 2 5 5 5 + 64512 2 2 2 2 2 2 2 2 2 2 3 3 7 + 64800 2 2 2 2 2 3 3 3 3 5 5 + 64827 3 3 3 7 7 7 7 + 65536 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 65610 2 3 3 3 3 3 3 3 3 5 + 65625 3 5 5 5 5 5 7 + 65856 2 2 2 2 2 2 3 7 7 7 + 66150 2 3 3 3 5 5 7 7 + 67200 2 2 2 2 2 2 2 3 5 5 7 + 67228 2 2 7 7 7 7 7 + 67500 2 2 3 3 3 5 5 5 5 + 68040 2 2 2 3 3 3 3 3 5 7 + 68600 2 2 2 5 5 7 7 7 + 69120 2 2 2 2 2 2 2 2 2 3 3 3 5 + 69984 2 2 2 2 2 3 3 3 3 3 3 3 + 70000 2 2 2 2 5 5 5 5 7 + 70560 2 2 2 2 2 3 3 5 7 7 + 70875 3 3 3 3 5 5 5 7 + 71442 2 3 3 3 3 3 3 7 7 + 71680 2 2 2 2 2 2 2 2 2 2 2 5 7 + 72000 2 2 2 2 2 2 3 3 5 5 5 + 72030 2 3 5 7 7 7 7 + 72576 2 2 2 2 2 2 2 3 3 3 3 7 + 72900 2 2 3 3 3 3 3 3 5 5 + 73500 2 2 3 5 5 5 7 7 + 73728 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 74088 2 2 2 3 3 3 7 7 7 + 75000 2 2 2 3 5 5 5 5 5 + 75264 2 2 2 2 2 2 2 2 2 3 7 7 + 75600 2 2 2 2 3 3 3 5 5 7 + 76545 3 3 3 3 3 3 3 5 7 + 76800 2 2 2 2 2 2 2 2 2 2 3 5 5 + 76832 2 2 2 2 2 7 7 7 7 + 77175 3 3 5 5 7 7 7 + 77760 2 2 2 2 2 2 3 3 3 3 3 5 + 78125 5 5 5 5 5 5 5 + 78400 2 2 2 2 2 2 5 5 7 7 + 78732 2 2 3 3 3 3 3 3 3 3 3 + 78750 2 3 3 5 5 5 5 7 + 79380 2 2 3 3 3 3 5 7 7 + 80000 2 2 2 2 2 2 2 5 5 5 5 + 80640 2 2 2 2 2 2 2 2 3 3 5 7 + 81000 2 2 2 3 3 3 3 5 5 5 + 81648 2 2 2 2 3 3 3 3 3 3 7 + 81920 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 82320 2 2 2 2 3 5 7 7 7 + 82944 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 83349 3 3 3 3 3 7 7 7 + 84000 2 2 2 2 2 3 5 5 5 7 + 84035 5 7 7 7 7 7 + 84375 3 3 3 5 5 5 5 5 + 84672 2 2 2 2 2 2 3 3 3 7 7 + 85050 2 3 3 3 3 3 5 5 7 + 85750 2 5 5 5 7 7 7 + 86016 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 86400 2 2 2 2 2 2 2 3 3 3 5 5 + 86436 2 2 3 3 7 7 7 7 + 87480 2 2 2 3 3 3 3 3 3 3 5 + 87500 2 2 5 5 5 5 5 7 + 87808 2 2 2 2 2 2 2 2 7 7 7 + 88200 2 2 2 3 3 5 5 7 7 + 89600 2 2 2 2 2 2 2 2 2 5 5 7 + 90000 2 2 2 2 3 3 5 5 5 5 + 90720 2 2 2 2 2 3 3 3 3 5 7 + 91125 3 3 3 3 3 3 5 5 5 + 91854 2 3 3 3 3 3 3 3 3 7 + 91875 3 5 5 5 5 7 7 + 92160 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 92610 2 3 3 3 5 7 7 7 + 93312 2 2 2 2 2 2 2 3 3 3 3 3 3 + 93750 2 3 5 5 5 5 5 5 + 94080 2 2 2 2 2 2 2 3 5 7 7 + 94500 2 2 3 3 3 5 5 5 7 + 95256 2 2 2 3 3 3 3 3 7 7 + 96000 2 2 2 2 2 2 2 2 3 5 5 5 + 96040 2 2 2 5 7 7 7 7 + 96768 2 2 2 2 2 2 2 2 2 3 3 3 7 + 97200 2 2 2 2 3 3 3 3 3 5 5 + 98000 2 2 2 2 5 5 5 7 7 + 98304 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 98415 3 3 3 3 3 3 3 3 3 5 + 98784 2 2 2 2 2 3 3 7 7 7 + 99225 3 3 3 3 5 5 7 7 + 100000 2 2 2 2 2 5 5 5 5 5 + 100352 2 2 2 2 2 2 2 2 2 2 2 7 7 + 100800 2 2 2 2 2 2 3 3 5 5 7 + 100842 2 3 7 7 7 7 7 + 101250 2 3 3 3 3 5 5 5 5 + 102060 2 2 3 3 3 3 3 3 5 7 + 102400 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 102900 2 2 3 5 5 7 7 7 + 103680 2 2 2 2 2 2 2 2 3 3 3 3 5 + 104976 2 2 2 2 3 3 3 3 3 3 3 3 + 105000 2 2 2 3 5 5 5 5 7 + 105840 2 2 2 2 3 3 3 5 7 7 + 107163 3 3 3 3 3 3 3 7 7 + 107520 2 2 2 2 2 2 2 2 2 2 3 5 7 + 108000 2 2 2 2 2 3 3 3 5 5 5 + 108045 3 3 5 7 7 7 7 + 108864 2 2 2 2 2 2 3 3 3 3 3 7 + 109350 2 3 3 3 3 3 3 3 5 5 + 109375 5 5 5 5 5 5 7 + 109760 2 2 2 2 2 2 5 7 7 7 + 110250 2 3 3 5 5 5 7 7 + 110592 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 111132 2 2 3 3 3 3 7 7 7 + 112000 2 2 2 2 2 2 2 5 5 5 7 + 112500 2 2 3 3 5 5 5 5 5 + 112896 2 2 2 2 2 2 2 2 3 3 7 7 + 113400 2 2 2 3 3 3 3 5 5 7 + 114688 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 115200 2 2 2 2 2 2 2 2 2 3 3 5 5 + 115248 2 2 2 2 3 7 7 7 7 + 116640 2 2 2 2 2 3 3 3 3 3 3 5 + 117600 2 2 2 2 2 3 5 5 7 7 + 117649 7 7 7 7 7 7 + 118098 2 3 3 3 3 3 3 3 3 3 3 + 118125 3 3 3 5 5 5 5 7 + 119070 2 3 3 3 3 3 5 7 7 + 120000 2 2 2 2 2 2 3 5 5 5 5 + 120050 2 5 5 7 7 7 7 + 120960 2 2 2 2 2 2 2 3 3 3 5 7 + 121500 2 2 3 3 3 3 3 5 5 5 + 122472 2 2 2 3 3 3 3 3 3 3 7 + 122500 2 2 5 5 5 5 7 7 + 122880 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 123480 2 2 2 3 3 5 7 7 7 + 124416 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 125000 2 2 2 5 5 5 5 5 5 + 125440 2 2 2 2 2 2 2 2 2 5 7 7 + 126000 2 2 2 2 3 3 5 5 5 7 + 127008 2 2 2 2 2 3 3 3 3 7 7 + 127575 3 3 3 3 3 3 5 5 7 + 128000 2 2 2 2 2 2 2 2 2 2 5 5 5 + 128625 3 5 5 5 7 7 7 + 129024 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 129600 2 2 2 2 2 2 3 3 3 3 5 5 + 129654 2 3 3 3 7 7 7 7 + 131072 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 131220 2 2 3 3 3 3 3 3 3 3 5 + 131250 2 3 5 5 5 5 5 7 + 131712 2 2 2 2 2 2 2 3 7 7 7 + 132300 2 2 3 3 3 5 5 7 7 + 134400 2 2 2 2 2 2 2 2 3 5 5 7 + 134456 2 2 2 7 7 7 7 7 + 135000 2 2 2 3 3 3 5 5 5 5 + 136080 2 2 2 2 3 3 3 3 3 5 7 + 137200 2 2 2 2 5 5 7 7 7 + 137781 3 3 3 3 3 3 3 3 3 7 + 138240 2 2 2 2 2 2 2 2 2 2 3 3 3 5 + 138915 3 3 3 3 5 7 7 7 + 139968 2 2 2 2 2 2 3 3 3 3 3 3 3 + 140000 2 2 2 2 2 5 5 5 5 7 + 140625 3 3 5 5 5 5 5 5 + 141120 2 2 2 2 2 2 3 3 5 7 7 + 141750 2 3 3 3 3 5 5 5 7 + 142884 2 2 3 3 3 3 3 3 7 7 + 143360 2 2 2 2 2 2 2 2 2 2 2 2 5 7 + 144000 2 2 2 2 2 2 2 3 3 5 5 5 + 144060 2 2 3 5 7 7 7 7 + 145152 2 2 2 2 2 2 2 2 3 3 3 3 7 + 145800 2 2 2 3 3 3 3 3 3 5 5 + 147000 2 2 2 3 5 5 5 7 7 + 147456 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 148176 2 2 2 2 3 3 3 7 7 7 + 150000 2 2 2 2 3 5 5 5 5 5 + 150528 2 2 2 2 2 2 2 2 2 2 3 7 7 + 151200 2 2 2 2 2 3 3 3 5 5 7 + 151263 3 3 7 7 7 7 7 + 151875 3 3 3 3 3 5 5 5 5 + 153090 2 3 3 3 3 3 3 3 5 7 + 153125 5 5 5 5 5 7 7 + 153600 2 2 2 2 2 2 2 2 2 2 2 3 5 5 + 153664 2 2 2 2 2 2 7 7 7 7 + 154350 2 3 3 5 5 7 7 7 + 155520 2 2 2 2 2 2 2 3 3 3 3 3 5 + 156250 2 5 5 5 5 5 5 5 + 156800 2 2 2 2 2 2 2 5 5 7 7 + 157464 2 2 2 3 3 3 3 3 3 3 3 3 + 157500 2 2 3 3 5 5 5 5 7 + 158760 2 2 2 3 3 3 3 5 7 7 + 160000 2 2 2 2 2 2 2 2 5 5 5 5 + 161280 2 2 2 2 2 2 2 2 2 3 3 5 7 + 162000 2 2 2 2 3 3 3 3 5 5 5 + 163296 2 2 2 2 2 3 3 3 3 3 3 7 + 163840 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 164025 3 3 3 3 3 3 3 3 5 5 + 164640 2 2 2 2 2 3 5 7 7 7 + 165375 3 3 3 5 5 5 7 7 + 165888 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 166698 2 3 3 3 3 3 7 7 7 + 168000 2 2 2 2 2 2 3 5 5 5 7 + 168070 2 5 7 7 7 7 7 + 168750 2 3 3 3 5 5 5 5 5 + 169344 2 2 2 2 2 2 2 3 3 3 7 7 + 170100 2 2 3 3 3 3 3 5 5 7 + 171500 2 2 5 5 5 7 7 7 + 172032 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 172800 2 2 2 2 2 2 2 2 3 3 3 5 5 + 172872 2 2 2 3 3 7 7 7 7 + 174960 2 2 2 2 3 3 3 3 3 3 3 5 + 175000 2 2 2 5 5 5 5 5 7 + 175616 2 2 2 2 2 2 2 2 2 7 7 7 + 176400 2 2 2 2 3 3 5 5 7 7 + 177147 3 3 3 3 3 3 3 3 3 3 3 + 178605 3 3 3 3 3 3 5 7 7 + 179200 2 2 2 2 2 2 2 2 2 2 5 5 7 + 180000 2 2 2 2 2 3 3 5 5 5 5 + 180075 3 5 5 7 7 7 7 + 181440 2 2 2 2 2 2 3 3 3 3 5 7 + 182250 2 3 3 3 3 3 3 5 5 5 + 183708 2 2 3 3 3 3 3 3 3 3 7 + 183750 2 3 5 5 5 5 7 7 + 184320 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 185220 2 2 3 3 3 5 7 7 7 + 186624 2 2 2 2 2 2 2 2 3 3 3 3 3 3 + 187500 2 2 3 5 5 5 5 5 5 + 188160 2 2 2 2 2 2 2 2 3 5 7 7 + 189000 2 2 2 3 3 3 5 5 5 7 + 190512 2 2 2 2 3 3 3 3 3 7 7 + 192000 2 2 2 2 2 2 2 2 2 3 5 5 5 + 192080 2 2 2 2 5 7 7 7 7 + 193536 2 2 2 2 2 2 2 2 2 2 3 3 3 7 + 194400 2 2 2 2 2 3 3 3 3 3 5 5 + 194481 3 3 3 3 7 7 7 7 + 196000 2 2 2 2 2 5 5 5 7 7 + 196608 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 196830 2 3 3 3 3 3 3 3 3 3 5 + 196875 3 3 5 5 5 5 5 7 + 197568 2 2 2 2 2 2 3 3 7 7 7 + 198450 2 3 3 3 3 5 5 7 7 + 200000 2 2 2 2 2 2 5 5 5 5 5 + 200704 2 2 2 2 2 2 2 2 2 2 2 2 7 7 + 201600 2 2 2 2 2 2 2 3 3 5 5 7 + 201684 2 2 3 7 7 7 7 7 + 202500 2 2 3 3 3 3 5 5 5 5 + 204120 2 2 2 3 3 3 3 3 3 5 7 + 204800 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 205800 2 2 2 3 5 5 7 7 7 + 207360 2 2 2 2 2 2 2 2 2 3 3 3 3 5 + 209952 2 2 2 2 2 3 3 3 3 3 3 3 3 + 210000 2 2 2 2 3 5 5 5 5 7 + 211680 2 2 2 2 2 3 3 3 5 7 7 + 212625 3 3 3 3 3 5 5 5 7 + 214326 2 3 3 3 3 3 3 3 7 7 + 214375 5 5 5 5 7 7 7 + 215040 2 2 2 2 2 2 2 2 2 2 2 3 5 7 + 216000 2 2 2 2 2 2 3 3 3 5 5 5 + 216090 2 3 3 5 7 7 7 7 + 217728 2 2 2 2 2 2 2 3 3 3 3 3 7 + 218700 2 2 3 3 3 3 3 3 3 5 5 + 218750 2 5 5 5 5 5 5 7 + 219520 2 2 2 2 2 2 2 5 7 7 7 + 220500 2 2 3 3 5 5 5 7 7 + 221184 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 222264 2 2 2 3 3 3 3 7 7 7 + 224000 2 2 2 2 2 2 2 2 5 5 5 7 + 225000 2 2 2 3 3 5 5 5 5 5 + 225792 2 2 2 2 2 2 2 2 2 3 3 7 7 + 226800 2 2 2 2 3 3 3 3 5 5 7 + 229376 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 229635 3 3 3 3 3 3 3 3 5 7 + 230400 2 2 2 2 2 2 2 2 2 2 3 3 5 5 + 230496 2 2 2 2 2 3 7 7 7 7 + 231525 3 3 3 5 5 7 7 7 + 233280 2 2 2 2 2 2 3 3 3 3 3 3 5 + 234375 3 5 5 5 5 5 5 5 + 235200 2 2 2 2 2 2 3 5 5 7 7 + 235298 2 7 7 7 7 7 7 + 236196 2 2 3 3 3 3 3 3 3 3 3 3 + 236250 2 3 3 3 5 5 5 5 7 + 238140 2 2 3 3 3 3 3 5 7 7 + 240000 2 2 2 2 2 2 2 3 5 5 5 5 + 240100 2 2 5 5 7 7 7 7 + 241920 2 2 2 2 2 2 2 2 3 3 3 5 7 + 243000 2 2 2 3 3 3 3 3 5 5 5 + 244944 2 2 2 2 3 3 3 3 3 3 3 7 + 245000 2 2 2 5 5 5 5 7 7 + 245760 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 246960 2 2 2 2 3 3 5 7 7 7 + 248832 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 250000 2 2 2 2 5 5 5 5 5 5 + 250047 3 3 3 3 3 3 7 7 7 + 250880 2 2 2 2 2 2 2 2 2 2 5 7 7 + 252000 2 2 2 2 2 3 3 5 5 5 7 + 252105 3 5 7 7 7 7 7 + 253125 3 3 3 3 5 5 5 5 5 + 254016 2 2 2 2 2 2 3 3 3 3 7 7 + 255150 2 3 3 3 3 3 3 5 5 7 + 256000 2 2 2 2 2 2 2 2 2 2 2 5 5 5 + 257250 2 3 5 5 5 7 7 7 + 258048 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 259200 2 2 2 2 2 2 2 3 3 3 3 5 5 + 259308 2 2 3 3 3 7 7 7 7 + 262144 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 262440 2 2 2 3 3 3 3 3 3 3 3 5 + 262500 2 2 3 5 5 5 5 5 7 + 263424 2 2 2 2 2 2 2 2 3 7 7 7 + 264600 2 2 2 3 3 3 5 5 7 7 + 268800 2 2 2 2 2 2 2 2 2 3 5 5 7 + 268912 2 2 2 2 7 7 7 7 7 + 270000 2 2 2 2 3 3 3 5 5 5 5 + 272160 2 2 2 2 2 3 3 3 3 3 5 7 + 273375 3 3 3 3 3 3 3 5 5 5 + 274400 2 2 2 2 2 5 5 7 7 7 + 275562 2 3 3 3 3 3 3 3 3 3 7 + 275625 3 3 5 5 5 5 7 7 + 276480 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 + 277830 2 3 3 3 3 5 7 7 7 + 279936 2 2 2 2 2 2 2 3 3 3 3 3 3 3 + 280000 2 2 2 2 2 2 5 5 5 5 7 + 281250 2 3 3 5 5 5 5 5 5 + 282240 2 2 2 2 2 2 2 3 3 5 7 7 + 283500 2 2 3 3 3 3 5 5 5 7 + 285768 2 2 2 3 3 3 3 3 3 7 7 + 286720 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 + 288000 2 2 2 2 2 2 2 2 3 3 5 5 5 + 288120 2 2 2 3 5 7 7 7 7 + 290304 2 2 2 2 2 2 2 2 2 3 3 3 3 7 + 291600 2 2 2 2 3 3 3 3 3 3 5 5 + 294000 2 2 2 2 3 5 5 5 7 7 + 294912 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 295245 3 3 3 3 3 3 3 3 3 3 5 + 296352 2 2 2 2 2 3 3 3 7 7 7 + 297675 3 3 3 3 3 5 5 7 7 + 300000 2 2 2 2 2 3 5 5 5 5 5 + 300125 5 5 5 7 7 7 7 + 301056 2 2 2 2 2 2 2 2 2 2 2 3 7 7 + 302400 2 2 2 2 2 2 3 3 3 5 5 7 + 302526 2 3 3 7 7 7 7 7 + 303750 2 3 3 3 3 3 5 5 5 5 + 306180 2 2 3 3 3 3 3 3 3 5 7 + 306250 2 5 5 5 5 5 7 7 + 307200 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 + 307328 2 2 2 2 2 2 2 7 7 7 7 + 308700 2 2 3 3 5 5 7 7 7 + 311040 2 2 2 2 2 2 2 2 3 3 3 3 3 5 + 312500 2 2 5 5 5 5 5 5 5 + 313600 2 2 2 2 2 2 2 2 5 5 7 7 + 314928 2 2 2 2 3 3 3 3 3 3 3 3 3 + 315000 2 2 2 3 3 5 5 5 5 7 + 317520 2 2 2 2 3 3 3 3 5 7 7 + 320000 2 2 2 2 2 2 2 2 2 5 5 5 5 + 321489 3 3 3 3 3 3 3 3 7 7 + 322560 2 2 2 2 2 2 2 2 2 2 3 3 5 7 + 324000 2 2 2 2 2 3 3 3 3 5 5 5 + 324135 3 3 3 5 7 7 7 7 + 326592 2 2 2 2 2 2 3 3 3 3 3 3 7 + 327680 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 328050 2 3 3 3 3 3 3 3 3 5 5 + 328125 3 5 5 5 5 5 5 7 + 329280 2 2 2 2 2 2 3 5 7 7 7 + 330750 2 3 3 3 5 5 5 7 7 + 331776 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 333396 2 2 3 3 3 3 3 7 7 7 + 336000 2 2 2 2 2 2 2 3 5 5 5 7 + 336140 2 2 5 7 7 7 7 7 + 337500 2 2 3 3 3 5 5 5 5 5 + 338688 2 2 2 2 2 2 2 2 3 3 3 7 7 + 340200 2 2 2 3 3 3 3 3 5 5 7 + 343000 2 2 2 5 5 5 7 7 7 + 344064 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 345600 2 2 2 2 2 2 2 2 2 3 3 3 5 5 + 345744 2 2 2 2 3 3 7 7 7 7 + 349920 2 2 2 2 2 3 3 3 3 3 3 3 5 + 350000 2 2 2 2 5 5 5 5 5 7 + 351232 2 2 2 2 2 2 2 2 2 2 7 7 7 + 352800 2 2 2 2 2 3 3 5 5 7 7 + 352947 3 7 7 7 7 7 7 + 354294 2 3 3 3 3 3 3 3 3 3 3 3 + 354375 3 3 3 3 5 5 5 5 7 + 357210 2 3 3 3 3 3 3 5 7 7 + 358400 2 2 2 2 2 2 2 2 2 2 2 5 5 7 + 360000 2 2 2 2 2 2 3 3 5 5 5 5 + 360150 2 3 5 5 7 7 7 7 + 362880 2 2 2 2 2 2 2 3 3 3 3 5 7 + 364500 2 2 3 3 3 3 3 3 5 5 5 + 367416 2 2 2 3 3 3 3 3 3 3 3 7 + 367500 2 2 3 5 5 5 5 7 7 + 368640 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 370440 2 2 2 3 3 3 5 7 7 7 + 373248 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 + 375000 2 2 2 3 5 5 5 5 5 5 + 376320 2 2 2 2 2 2 2 2 2 3 5 7 7 + 378000 2 2 2 2 3 3 3 5 5 5 7 + 381024 2 2 2 2 2 3 3 3 3 3 7 7 + 382725 3 3 3 3 3 3 3 5 5 7 + 384000 2 2 2 2 2 2 2 2 2 2 3 5 5 5 + 384160 2 2 2 2 2 5 7 7 7 7 + 385875 3 3 5 5 5 7 7 7 + 387072 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 + 388800 2 2 2 2 2 2 3 3 3 3 3 5 5 + 388962 2 3 3 3 3 7 7 7 7 + 390625 5 5 5 5 5 5 5 5 + 392000 2 2 2 2 2 2 5 5 5 7 7 + 393216 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 393660 2 2 3 3 3 3 3 3 3 3 3 5 + 393750 2 3 3 5 5 5 5 5 7 + 395136 2 2 2 2 2 2 2 3 3 7 7 7 + 396900 2 2 3 3 3 3 5 5 7 7 + 400000 2 2 2 2 2 2 2 5 5 5 5 5 + 401408 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 + 403200 2 2 2 2 2 2 2 2 3 3 5 5 7 + 403368 2 2 2 3 7 7 7 7 7 + 405000 2 2 2 3 3 3 3 5 5 5 5 + 408240 2 2 2 2 3 3 3 3 3 3 5 7 + 409600 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 411600 2 2 2 2 3 5 5 7 7 7 + 413343 3 3 3 3 3 3 3 3 3 3 7 + 414720 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 + 416745 3 3 3 3 3 5 7 7 7 + 419904 2 2 2 2 2 2 3 3 3 3 3 3 3 3 + 420000 2 2 2 2 2 3 5 5 5 5 7 + 420175 5 5 7 7 7 7 7 + 421875 3 3 3 5 5 5 5 5 5 + 423360 2 2 2 2 2 2 3 3 3 5 7 7 + 425250 2 3 3 3 3 3 5 5 5 7 + 428652 2 2 3 3 3 3 3 3 3 7 7 + 428750 2 5 5 5 5 7 7 7 + 430080 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 + 432000 2 2 2 2 2 2 2 3 3 3 5 5 5 + 432180 2 2 3 3 5 7 7 7 7 + 435456 2 2 2 2 2 2 2 2 3 3 3 3 3 7 + 437400 2 2 2 3 3 3 3 3 3 3 5 5 + 437500 2 2 5 5 5 5 5 5 7 + 439040 2 2 2 2 2 2 2 2 5 7 7 7 + 441000 2 2 2 3 3 5 5 5 7 7 + 442368 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 444528 2 2 2 2 3 3 3 3 7 7 7 + 448000 2 2 2 2 2 2 2 2 2 5 5 5 7 + 450000 2 2 2 2 3 3 5 5 5 5 5 + 451584 2 2 2 2 2 2 2 2 2 2 3 3 7 7 + 453600 2 2 2 2 2 3 3 3 3 5 5 7 + 453789 3 3 3 7 7 7 7 7 + 455625 3 3 3 3 3 3 5 5 5 5 + 458752 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 459270 2 3 3 3 3 3 3 3 3 5 7 + 459375 3 5 5 5 5 5 7 7 + 460800 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 + 460992 2 2 2 2 2 2 3 7 7 7 7 + 463050 2 3 3 3 5 5 7 7 7 + 466560 2 2 2 2 2 2 2 3 3 3 3 3 3 5 + 468750 2 3 5 5 5 5 5 5 5 + 470400 2 2 2 2 2 2 2 3 5 5 7 7 + 470596 2 2 7 7 7 7 7 7 + 472392 2 2 2 3 3 3 3 3 3 3 3 3 3 + 472500 2 2 3 3 3 5 5 5 5 7 + 476280 2 2 2 3 3 3 3 3 5 7 7 + 480000 2 2 2 2 2 2 2 2 3 5 5 5 5 + 480200 2 2 2 5 5 7 7 7 7 + 483840 2 2 2 2 2 2 2 2 2 3 3 3 5 7 + 486000 2 2 2 2 3 3 3 3 3 5 5 5 + 489888 2 2 2 2 2 3 3 3 3 3 3 3 7 + 490000 2 2 2 2 5 5 5 5 7 7 + 491520 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 492075 3 3 3 3 3 3 3 3 3 5 5 + 493920 2 2 2 2 2 3 3 5 7 7 7 + 496125 3 3 3 3 5 5 5 7 7 + 497664 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 500000 2 2 2 2 2 5 5 5 5 5 5 + 500094 2 3 3 3 3 3 3 7 7 7 + 501760 2 2 2 2 2 2 2 2 2 2 2 5 7 7 + 504000 2 2 2 2 2 2 3 3 5 5 5 7 + 504210 2 3 5 7 7 7 7 7 + 506250 2 3 3 3 3 5 5 5 5 5 + 508032 2 2 2 2 2 2 2 3 3 3 3 7 7 + 510300 2 2 3 3 3 3 3 3 5 5 7 + 512000 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 + 514500 2 2 3 5 5 5 7 7 7 + 516096 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 518400 2 2 2 2 2 2 2 2 3 3 3 3 5 5 + 518616 2 2 2 3 3 3 7 7 7 7 + 524288 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 524880 2 2 2 2 3 3 3 3 3 3 3 3 5 + 525000 2 2 2 3 5 5 5 5 5 7 + 526848 2 2 2 2 2 2 2 2 2 3 7 7 7 + 529200 2 2 2 2 3 3 3 5 5 7 7 + 531441 3 3 3 3 3 3 3 3 3 3 3 3 + 535815 3 3 3 3 3 3 3 5 7 7 + 537600 2 2 2 2 2 2 2 2 2 2 3 5 5 7 + 537824 2 2 2 2 2 7 7 7 7 7 + 540000 2 2 2 2 2 3 3 3 5 5 5 5 + 540225 3 3 5 5 7 7 7 7 + 544320 2 2 2 2 2 2 3 3 3 3 3 5 7 + 546750 2 3 3 3 3 3 3 3 5 5 5 + 546875 5 5 5 5 5 5 5 7 + 548800 2 2 2 2 2 2 5 5 7 7 7 + 551124 2 2 3 3 3 3 3 3 3 3 3 7 + 551250 2 3 3 5 5 5 5 7 7 + 552960 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 + 555660 2 2 3 3 3 3 5 7 7 7 + 559872 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 + 560000 2 2 2 2 2 2 2 5 5 5 5 7 + 562500 2 2 3 3 5 5 5 5 5 5 + 564480 2 2 2 2 2 2 2 2 3 3 5 7 7 + 567000 2 2 2 3 3 3 3 5 5 5 7 + 571536 2 2 2 2 3 3 3 3 3 3 7 7 + 573440 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 + 576000 2 2 2 2 2 2 2 2 2 3 3 5 5 5 + 576240 2 2 2 2 3 5 7 7 7 7 + 580608 2 2 2 2 2 2 2 2 2 2 3 3 3 3 7 + 583200 2 2 2 2 2 3 3 3 3 3 3 5 5 + 583443 3 3 3 3 3 7 7 7 7 + 588000 2 2 2 2 2 3 5 5 5 7 7 + 588245 5 7 7 7 7 7 7 + 589824 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 590490 2 3 3 3 3 3 3 3 3 3 3 5 + 590625 3 3 3 5 5 5 5 5 7 + 592704 2 2 2 2 2 2 3 3 3 7 7 7 + 595350 2 3 3 3 3 3 5 5 7 7 + 600000 2 2 2 2 2 2 3 5 5 5 5 5 + 600250 2 5 5 5 7 7 7 7 + 602112 2 2 2 2 2 2 2 2 2 2 2 2 3 7 7 + 604800 2 2 2 2 2 2 2 3 3 3 5 5 7 + 605052 2 2 3 3 7 7 7 7 7 + 607500 2 2 3 3 3 3 3 5 5 5 5 + 612360 2 2 2 3 3 3 3 3 3 3 5 7 + 612500 2 2 5 5 5 5 5 7 7 + 614400 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 + 614656 2 2 2 2 2 2 2 2 7 7 7 7 + 617400 2 2 2 3 3 5 5 7 7 7 + 622080 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 + 625000 2 2 2 5 5 5 5 5 5 5 + 627200 2 2 2 2 2 2 2 2 2 5 5 7 7 + 629856 2 2 2 2 2 3 3 3 3 3 3 3 3 3 + 630000 2 2 2 2 3 3 5 5 5 5 7 + 635040 2 2 2 2 2 3 3 3 3 5 7 7 + 637875 3 3 3 3 3 3 5 5 5 7 + 640000 2 2 2 2 2 2 2 2 2 2 5 5 5 5 + 642978 2 3 3 3 3 3 3 3 3 7 7 + 643125 3 5 5 5 5 7 7 7 + 645120 2 2 2 2 2 2 2 2 2 2 2 3 3 5 7 + 648000 2 2 2 2 2 2 3 3 3 3 5 5 5 + 648270 2 3 3 3 5 7 7 7 7 + 653184 2 2 2 2 2 2 2 3 3 3 3 3 3 7 + 655360 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 656100 2 2 3 3 3 3 3 3 3 3 5 5 + 656250 2 3 5 5 5 5 5 5 7 + 658560 2 2 2 2 2 2 2 3 5 7 7 7 + 661500 2 2 3 3 3 5 5 5 7 7 + 663552 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 666792 2 2 2 3 3 3 3 3 7 7 7 + 672000 2 2 2 2 2 2 2 2 3 5 5 5 7 + 672280 2 2 2 5 7 7 7 7 7 + 675000 2 2 2 3 3 3 5 5 5 5 5 + 677376 2 2 2 2 2 2 2 2 2 3 3 3 7 7 + 680400 2 2 2 2 3 3 3 3 3 5 5 7 + 686000 2 2 2 2 5 5 5 7 7 7 + 688128 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 688905 3 3 3 3 3 3 3 3 3 5 7 + 691200 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 + 691488 2 2 2 2 2 3 3 7 7 7 7 + 694575 3 3 3 3 5 5 7 7 7 + 699840 2 2 2 2 2 2 3 3 3 3 3 3 3 5 + 700000 2 2 2 2 2 5 5 5 5 5 7 + 702464 2 2 2 2 2 2 2 2 2 2 2 7 7 7 + 703125 3 3 5 5 5 5 5 5 5 + 705600 2 2 2 2 2 2 3 3 5 5 7 7 + 705894 2 3 7 7 7 7 7 7 + 708588 2 2 3 3 3 3 3 3 3 3 3 3 3 + 708750 2 3 3 3 3 5 5 5 5 7 + 714420 2 2 3 3 3 3 3 3 5 7 7 + 716800 2 2 2 2 2 2 2 2 2 2 2 2 5 5 7 + 720000 2 2 2 2 2 2 2 3 3 5 5 5 5 + 720300 2 2 3 5 5 7 7 7 7 + 725760 2 2 2 2 2 2 2 2 3 3 3 3 5 7 + 729000 2 2 2 3 3 3 3 3 3 5 5 5 + 734832 2 2 2 2 3 3 3 3 3 3 3 3 7 + 735000 2 2 2 3 5 5 5 5 7 7 + 737280 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 740880 2 2 2 2 3 3 3 5 7 7 7 + 746496 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 + 750000 2 2 2 2 3 5 5 5 5 5 5 + 750141 3 3 3 3 3 3 3 7 7 7 + 752640 2 2 2 2 2 2 2 2 2 2 3 5 7 7 + 756000 2 2 2 2 2 3 3 3 5 5 5 7 + 756315 3 3 5 7 7 7 7 7 + 759375 3 3 3 3 3 5 5 5 5 5 + 762048 2 2 2 2 2 2 3 3 3 3 3 7 7 + 765450 2 3 3 3 3 3 3 3 5 5 7 + 765625 5 5 5 5 5 5 7 7 + 768000 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 + 768320 2 2 2 2 2 2 5 7 7 7 7 + 771750 2 3 3 5 5 5 7 7 7 + 774144 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 + 777600 2 2 2 2 2 2 2 3 3 3 3 3 5 5 + 777924 2 2 3 3 3 3 7 7 7 7 + 781250 2 5 5 5 5 5 5 5 5 + 784000 2 2 2 2 2 2 2 5 5 5 7 7 + 786432 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 787320 2 2 2 3 3 3 3 3 3 3 3 3 5 + 787500 2 2 3 3 5 5 5 5 5 7 + 790272 2 2 2 2 2 2 2 2 3 3 7 7 7 + 793800 2 2 2 3 3 3 3 5 5 7 7 + 800000 2 2 2 2 2 2 2 2 5 5 5 5 5 + 802816 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 + 806400 2 2 2 2 2 2 2 2 2 3 3 5 5 7 + 806736 2 2 2 2 3 7 7 7 7 7 + 810000 2 2 2 2 3 3 3 3 5 5 5 5 + 816480 2 2 2 2 2 3 3 3 3 3 3 5 7 + 819200 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 820125 3 3 3 3 3 3 3 3 5 5 5 + 823200 2 2 2 2 2 3 5 5 7 7 7 + 823543 7 7 7 7 7 7 7 + 826686 2 3 3 3 3 3 3 3 3 3 3 7 + 826875 3 3 3 5 5 5 5 7 7 + 829440 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 + 833490 2 3 3 3 3 3 5 7 7 7 + 839808 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 + 840000 2 2 2 2 2 2 3 5 5 5 5 7 + 840350 2 5 5 7 7 7 7 7 + 843750 2 3 3 3 5 5 5 5 5 5 + 846720 2 2 2 2 2 2 2 3 3 3 5 7 7 + 850500 2 2 3 3 3 3 3 5 5 5 7 + 857304 2 2 2 3 3 3 3 3 3 3 7 7 + 857500 2 2 5 5 5 5 7 7 7 + 860160 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 + 864000 2 2 2 2 2 2 2 2 3 3 3 5 5 5 + 864360 2 2 2 3 3 5 7 7 7 7 + 870912 2 2 2 2 2 2 2 2 2 3 3 3 3 3 7 + 874800 2 2 2 2 3 3 3 3 3 3 3 5 5 + 875000 2 2 2 5 5 5 5 5 5 7 + 878080 2 2 2 2 2 2 2 2 2 5 7 7 7 + 882000 2 2 2 2 3 3 5 5 5 7 7 + 884736 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 885735 3 3 3 3 3 3 3 3 3 3 3 5 + 889056 2 2 2 2 2 3 3 3 3 7 7 7 + 893025 3 3 3 3 3 3 5 5 7 7 + 896000 2 2 2 2 2 2 2 2 2 2 5 5 5 7 + 900000 2 2 2 2 2 3 3 5 5 5 5 5 + 900375 3 5 5 5 7 7 7 7 + 903168 2 2 2 2 2 2 2 2 2 2 2 3 3 7 7 + 907200 2 2 2 2 2 2 3 3 3 3 5 5 7 + 907578 2 3 3 3 7 7 7 7 7 + 911250 2 3 3 3 3 3 3 5 5 5 5 + 917504 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 918540 2 2 3 3 3 3 3 3 3 3 5 7 + 918750 2 3 5 5 5 5 5 7 7 + 921600 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 + 921984 2 2 2 2 2 2 2 3 7 7 7 7 + 926100 2 2 3 3 3 5 5 7 7 7 + 933120 2 2 2 2 2 2 2 2 3 3 3 3 3 3 5 + 937500 2 2 3 5 5 5 5 5 5 5 + 940800 2 2 2 2 2 2 2 2 3 5 5 7 7 + 941192 2 2 2 7 7 7 7 7 7 + 944784 2 2 2 2 3 3 3 3 3 3 3 3 3 3 + 945000 2 2 2 3 3 3 5 5 5 5 7 + 952560 2 2 2 2 3 3 3 3 3 5 7 7 + 960000 2 2 2 2 2 2 2 2 2 3 5 5 5 5 + 960400 2 2 2 2 5 5 7 7 7 7 + 964467 3 3 3 3 3 3 3 3 3 7 7 + 967680 2 2 2 2 2 2 2 2 2 2 3 3 3 5 7 + 972000 2 2 2 2 2 3 3 3 3 3 5 5 5 + 972405 3 3 3 3 5 7 7 7 7 + 979776 2 2 2 2 2 2 3 3 3 3 3 3 3 7 + 980000 2 2 2 2 2 5 5 5 5 7 7 + 983040 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 984150 2 3 3 3 3 3 3 3 3 3 5 5 + 984375 3 3 5 5 5 5 5 5 7 + 987840 2 2 2 2 2 2 3 3 5 7 7 7 + 992250 2 3 3 3 3 5 5 5 7 7 + 995328 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 1000000 2 2 2 2 2 2 5 5 5 5 5 5 + 1000188 2 2 3 3 3 3 3 3 7 7 7 + 1003520 2 2 2 2 2 2 2 2 2 2 2 2 5 7 7 + 1008000 2 2 2 2 2 2 2 3 3 5 5 5 7 + 1008420 2 2 3 5 7 7 7 7 7 + 1012500 2 2 3 3 3 3 5 5 5 5 5 + 1016064 2 2 2 2 2 2 2 2 3 3 3 3 7 7 + 1020600 2 2 2 3 3 3 3 3 3 5 5 7 + 1024000 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 + 1029000 2 2 2 3 5 5 5 7 7 7 + 1032192 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 1036800 2 2 2 2 2 2 2 2 2 3 3 3 3 5 5 + 1037232 2 2 2 2 3 3 3 7 7 7 7 + 1048576 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 1049760 2 2 2 2 2 3 3 3 3 3 3 3 3 5 + 1050000 2 2 2 2 3 5 5 5 5 5 7 + 1053696 2 2 2 2 2 2 2 2 2 2 3 7 7 7 + 1058400 2 2 2 2 2 3 3 3 5 5 7 7 + 1058841 3 3 7 7 7 7 7 7 + 1062882 2 3 3 3 3 3 3 3 3 3 3 3 3 + 1063125 3 3 3 3 3 5 5 5 5 7 + 1071630 2 3 3 3 3 3 3 3 5 7 7 + 1071875 5 5 5 5 5 7 7 7 + 1075200 2 2 2 2 2 2 2 2 2 2 2 3 5 5 7 + 1075648 2 2 2 2 2 2 7 7 7 7 7 + 1080000 2 2 2 2 2 2 3 3 3 5 5 5 5 + 1080450 2 3 3 5 5 7 7 7 7 + 1088640 2 2 2 2 2 2 2 3 3 3 3 3 5 7 + 1093500 2 2 3 3 3 3 3 3 3 5 5 5 + 1093750 2 5 5 5 5 5 5 5 7 + 1097600 2 2 2 2 2 2 2 5 5 7 7 7 + 1102248 2 2 2 3 3 3 3 3 3 3 3 3 7 + 1102500 2 2 3 3 5 5 5 5 7 7 + 1105920 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 + 1111320 2 2 2 3 3 3 3 5 7 7 7 + 1119744 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 + 1120000 2 2 2 2 2 2 2 2 5 5 5 5 7 + 1125000 2 2 2 3 3 5 5 5 5 5 5 + 1128960 2 2 2 2 2 2 2 2 2 3 3 5 7 7 + 1134000 2 2 2 2 3 3 3 3 5 5 5 7 + 1143072 2 2 2 2 2 3 3 3 3 3 3 7 7 + 1146880 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 + 1148175 3 3 3 3 3 3 3 3 5 5 7 + 1152000 2 2 2 2 2 2 2 2 2 2 3 3 5 5 5 + 1152480 2 2 2 2 2 3 5 7 7 7 7 + 1157625 3 3 3 5 5 5 7 7 7 + 1161216 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 7 + 1166400 2 2 2 2 2 2 3 3 3 3 3 3 5 5 + 1166886 2 3 3 3 3 3 7 7 7 7 + 1171875 3 5 5 5 5 5 5 5 5 + 1176000 2 2 2 2 2 2 3 5 5 5 7 7 + 1176490 2 5 7 7 7 7 7 7 + 1179648 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 1180980 2 2 3 3 3 3 3 3 3 3 3 3 5 + 1181250 2 3 3 3 5 5 5 5 5 7 + 1185408 2 2 2 2 2 2 2 3 3 3 7 7 7 + 1190700 2 2 3 3 3 3 3 5 5 7 7 + 1200000 2 2 2 2 2 2 2 3 5 5 5 5 5 + 1200500 2 2 5 5 5 7 7 7 7 + 1204224 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 7 + 1209600 2 2 2 2 2 2 2 2 3 3 3 5 5 7 + 1210104 2 2 2 3 3 7 7 7 7 7 + 1215000 2 2 2 3 3 3 3 3 5 5 5 5 + 1224720 2 2 2 2 3 3 3 3 3 3 3 5 7 + 1225000 2 2 2 5 5 5 5 5 7 7 + 1228800 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 + 1229312 2 2 2 2 2 2 2 2 2 7 7 7 7 + 1234800 2 2 2 2 3 3 5 5 7 7 7 + 1240029 3 3 3 3 3 3 3 3 3 3 3 7 + 1244160 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 + 1250000 2 2 2 2 5 5 5 5 5 5 5 + 1250235 3 3 3 3 3 3 5 7 7 7 + 1254400 2 2 2 2 2 2 2 2 2 2 5 5 7 7 + 1259712 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 + 1260000 2 2 2 2 2 3 3 5 5 5 5 7 + 1260525 3 5 5 7 7 7 7 7 + 1265625 3 3 3 3 5 5 5 5 5 5 + 1270080 2 2 2 2 2 2 3 3 3 3 5 7 7 + 1275750 2 3 3 3 3 3 3 5 5 5 7 + 1280000 2 2 2 2 2 2 2 2 2 2 2 5 5 5 5 + 1285956 2 2 3 3 3 3 3 3 3 3 7 7 + 1286250 2 3 5 5 5 5 7 7 7 + 1290240 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 7 + 1296000 2 2 2 2 2 2 2 3 3 3 3 5 5 5 + 1296540 2 2 3 3 3 5 7 7 7 7 + 1306368 2 2 2 2 2 2 2 2 3 3 3 3 3 3 7 + 1310720 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 1312200 2 2 2 3 3 3 3 3 3 3 3 5 5 + 1312500 2 2 3 5 5 5 5 5 5 7 + 1317120 2 2 2 2 2 2 2 2 3 5 7 7 7 + 1323000 2 2 2 3 3 3 5 5 5 7 7 + 1327104 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 1333584 2 2 2 2 3 3 3 3 3 7 7 7 + 1344000 2 2 2 2 2 2 2 2 2 3 5 5 5 7 + 1344560 2 2 2 2 5 7 7 7 7 7 + 1350000 2 2 2 2 3 3 3 5 5 5 5 5 + 1354752 2 2 2 2 2 2 2 2 2 2 3 3 3 7 7 + 1360800 2 2 2 2 2 3 3 3 3 3 5 5 7 + 1361367 3 3 3 3 7 7 7 7 7 + 1366875 3 3 3 3 3 3 3 5 5 5 5 + 1372000 2 2 2 2 2 5 5 5 7 7 7 + 1376256 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 1377810 2 3 3 3 3 3 3 3 3 3 5 7 + 1378125 3 3 5 5 5 5 5 7 7 + 1382400 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 + 1382976 2 2 2 2 2 2 3 3 7 7 7 7 + 1389150 2 3 3 3 3 5 5 7 7 7 + 1399680 2 2 2 2 2 2 2 3 3 3 3 3 3 3 5 + 1400000 2 2 2 2 2 2 5 5 5 5 5 7 + 1404928 2 2 2 2 2 2 2 2 2 2 2 2 7 7 7 + 1406250 2 3 3 5 5 5 5 5 5 5 + 1411200 2 2 2 2 2 2 2 3 3 5 5 7 7 + 1411788 2 2 3 7 7 7 7 7 7 + 1417176 2 2 2 3 3 3 3 3 3 3 3 3 3 3 + 1417500 2 2 3 3 3 3 5 5 5 5 7 + 1428840 2 2 2 3 3 3 3 3 3 5 7 7 + 1433600 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 7 + 1440000 2 2 2 2 2 2 2 2 3 3 5 5 5 5 + 1440600 2 2 2 3 5 5 7 7 7 7 + 1451520 2 2 2 2 2 2 2 2 2 3 3 3 3 5 7 + 1458000 2 2 2 2 3 3 3 3 3 3 5 5 5 + 1469664 2 2 2 2 2 3 3 3 3 3 3 3 3 7 + 1470000 2 2 2 2 3 5 5 5 5 7 7 + 1474560 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 1476225 3 3 3 3 3 3 3 3 3 3 5 5 + 1481760 2 2 2 2 2 3 3 3 5 7 7 7 + 1488375 3 3 3 3 3 5 5 5 7 7 + 1492992 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 + 1500000 2 2 2 2 2 3 5 5 5 5 5 5 + 1500282 2 3 3 3 3 3 3 3 7 7 7 + 1500625 5 5 5 5 7 7 7 7 + 1505280 2 2 2 2 2 2 2 2 2 2 2 3 5 7 7 + 1512000 2 2 2 2 2 2 3 3 3 5 5 5 7 + 1512630 2 3 3 5 7 7 7 7 7 + 1518750 2 3 3 3 3 3 5 5 5 5 5 + 1524096 2 2 2 2 2 2 2 3 3 3 3 3 7 7 + 1530900 2 2 3 3 3 3 3 3 3 5 5 7 + 1531250 2 5 5 5 5 5 5 7 7 + 1536000 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 + 1536640 2 2 2 2 2 2 2 5 7 7 7 7 + 1543500 2 2 3 3 5 5 5 7 7 7 + 1548288 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 + 1555200 2 2 2 2 2 2 2 2 3 3 3 3 3 5 5 + 1555848 2 2 2 3 3 3 3 7 7 7 7 + 1562500 2 2 5 5 5 5 5 5 5 5 + 1568000 2 2 2 2 2 2 2 2 5 5 5 7 7 + 1572864 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 1574640 2 2 2 2 3 3 3 3 3 3 3 3 3 5 + 1575000 2 2 2 3 3 5 5 5 5 5 7 + 1580544 2 2 2 2 2 2 2 2 2 3 3 7 7 7 + 1587600 2 2 2 2 3 3 3 3 5 5 7 7 + 1594323 3 3 3 3 3 3 3 3 3 3 3 3 3 + 1600000 2 2 2 2 2 2 2 2 2 5 5 5 5 5 + 1605632 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 + 1607445 3 3 3 3 3 3 3 3 5 7 7 + 1612800 2 2 2 2 2 2 2 2 2 2 3 3 5 5 7 + 1613472 2 2 2 2 2 3 7 7 7 7 7 + 1620000 2 2 2 2 2 3 3 3 3 5 5 5 5 + 1620675 3 3 3 5 5 7 7 7 7 + 1632960 2 2 2 2 2 2 3 3 3 3 3 3 5 7 + 1638400 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 1640250 2 3 3 3 3 3 3 3 3 5 5 5 + 1640625 3 5 5 5 5 5 5 5 7 + 1646400 2 2 2 2 2 2 3 5 5 7 7 7 + 1647086 2 7 7 7 7 7 7 7 + 1653372 2 2 3 3 3 3 3 3 3 3 3 3 7 + 1653750 2 3 3 3 5 5 5 5 7 7 + 1658880 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 + 1666980 2 2 3 3 3 3 3 5 7 7 7 + 1679616 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 + 1680000 2 2 2 2 2 2 2 3 5 5 5 5 7 + 1680700 2 2 5 5 7 7 7 7 7 + 1687500 2 2 3 3 3 5 5 5 5 5 5 + 1693440 2 2 2 2 2 2 2 2 3 3 3 5 7 7 + 1701000 2 2 2 3 3 3 3 3 5 5 5 7 + 1714608 2 2 2 2 3 3 3 3 3 3 3 7 7 + 1715000 2 2 2 5 5 5 5 7 7 7 + 1720320 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 + 1728000 2 2 2 2 2 2 2 2 2 3 3 3 5 5 5 + 1728720 2 2 2 2 3 3 5 7 7 7 7 + 1741824 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 7 + 1749600 2 2 2 2 2 3 3 3 3 3 3 3 5 5 + 1750000 2 2 2 2 5 5 5 5 5 5 7 + 1750329 3 3 3 3 3 3 7 7 7 7 + 1756160 2 2 2 2 2 2 2 2 2 2 5 7 7 7 + 1764000 2 2 2 2 2 3 3 5 5 5 7 7 + 1764735 3 5 7 7 7 7 7 7 + 1769472 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 1771470 2 3 3 3 3 3 3 3 3 3 3 3 5 + 1771875 3 3 3 3 5 5 5 5 5 7 + 1778112 2 2 2 2 2 2 3 3 3 3 7 7 7 + 1786050 2 3 3 3 3 3 3 5 5 7 7 + 1792000 2 2 2 2 2 2 2 2 2 2 2 5 5 5 7 + 1800000 2 2 2 2 2 2 3 3 5 5 5 5 5 + 1800750 2 3 5 5 5 7 7 7 7 + 1806336 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 7 + 1814400 2 2 2 2 2 2 2 3 3 3 3 5 5 7 + 1815156 2 2 3 3 3 7 7 7 7 7 + 1822500 2 2 3 3 3 3 3 3 5 5 5 5 + 1835008 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 1837080 2 2 2 3 3 3 3 3 3 3 3 5 7 + 1837500 2 2 3 5 5 5 5 5 7 7 + 1843200 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 + 1843968 2 2 2 2 2 2 2 2 3 7 7 7 7 + 1852200 2 2 2 3 3 3 5 5 7 7 7 + 1866240 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 5 + 1875000 2 2 2 3 5 5 5 5 5 5 5 + 1881600 2 2 2 2 2 2 2 2 2 3 5 5 7 7 + 1882384 2 2 2 2 7 7 7 7 7 7 + 1889568 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 + 1890000 2 2 2 2 3 3 3 5 5 5 5 7 + 1905120 2 2 2 2 2 3 3 3 3 3 5 7 7 + 1913625 3 3 3 3 3 3 3 5 5 5 7 + 1920000 2 2 2 2 2 2 2 2 2 2 3 5 5 5 5 + 1920800 2 2 2 2 2 5 5 7 7 7 7 + 1928934 2 3 3 3 3 3 3 3 3 3 7 7 + 1929375 3 3 5 5 5 5 7 7 7 + 1935360 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 7 + 1944000 2 2 2 2 2 2 3 3 3 3 3 5 5 5 + 1944810 2 3 3 3 3 5 7 7 7 7 + 1953125 5 5 5 5 5 5 5 5 5 + 1959552 2 2 2 2 2 2 2 3 3 3 3 3 3 3 7 + 1960000 2 2 2 2 2 2 5 5 5 5 7 7 + 1966080 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 1968300 2 2 3 3 3 3 3 3 3 3 3 5 5 + 1968750 2 3 3 5 5 5 5 5 5 7 + 1975680 2 2 2 2 2 2 2 3 3 5 7 7 7 + 1984500 2 2 3 3 3 3 5 5 5 7 7 + 1990656 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 2000000 2 2 2 2 2 2 2 5 5 5 5 5 5 + 2000376 2 2 2 3 3 3 3 3 3 7 7 7 + 2007040 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 7 + 2016000 2 2 2 2 2 2 2 2 3 3 5 5 5 7 + 2016840 2 2 2 3 5 7 7 7 7 7 + 2025000 2 2 2 3 3 3 3 5 5 5 5 5 + 2032128 2 2 2 2 2 2 2 2 2 3 3 3 3 7 7 + 2041200 2 2 2 2 3 3 3 3 3 3 5 5 7 + 2048000 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 + 2058000 2 2 2 2 3 5 5 5 7 7 7 + 2064384 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 2066715 3 3 3 3 3 3 3 3 3 3 5 7 + 2073600 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 5 + 2074464 2 2 2 2 2 3 3 3 7 7 7 7 + 2083725 3 3 3 3 3 5 5 7 7 7 + 2097152 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 2099520 2 2 2 2 2 2 3 3 3 3 3 3 3 3 5 + 2100000 2 2 2 2 2 3 5 5 5 5 5 7 + 2100875 5 5 5 7 7 7 7 7 + 2107392 2 2 2 2 2 2 2 2 2 2 2 3 7 7 7 + 2109375 3 3 3 5 5 5 5 5 5 5 + 2116800 2 2 2 2 2 2 3 3 3 5 5 7 7 + 2117682 2 3 3 7 7 7 7 7 7 + 2125764 2 2 3 3 3 3 3 3 3 3 3 3 3 3 + 2126250 2 3 3 3 3 3 5 5 5 5 7 + 2143260 2 2 3 3 3 3 3 3 3 5 7 7 + 2143750 2 5 5 5 5 5 7 7 7 + 2150400 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 7 + 2151296 2 2 2 2 2 2 2 7 7 7 7 7 + 2160000 2 2 2 2 2 2 2 3 3 3 5 5 5 5 + 2160900 2 2 3 3 5 5 7 7 7 7 + 2177280 2 2 2 2 2 2 2 2 3 3 3 3 3 5 7 + 2187000 2 2 2 3 3 3 3 3 3 3 5 5 5 + 2187500 2 2 5 5 5 5 5 5 5 7 + 2195200 2 2 2 2 2 2 2 2 5 5 7 7 7 + 2204496 2 2 2 2 3 3 3 3 3 3 3 3 3 7 + 2205000 2 2 2 3 3 5 5 5 5 7 7 + 2211840 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 + 2222640 2 2 2 2 3 3 3 3 5 7 7 7 + 2239488 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 + 2240000 2 2 2 2 2 2 2 2 2 5 5 5 5 7 + 2250000 2 2 2 2 3 3 5 5 5 5 5 5 + 2250423 3 3 3 3 3 3 3 3 7 7 7 + 2257920 2 2 2 2 2 2 2 2 2 2 3 3 5 7 7 + 2268000 2 2 2 2 2 3 3 3 3 5 5 5 7 + 2268945 3 3 3 5 7 7 7 7 7 + 2278125 3 3 3 3 3 3 5 5 5 5 5 + 2286144 2 2 2 2 2 2 3 3 3 3 3 3 7 7 + 2293760 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 + 2296350 2 3 3 3 3 3 3 3 3 5 5 7 + 2296875 3 5 5 5 5 5 5 7 7 + 2304000 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 5 + 2304960 2 2 2 2 2 2 3 5 7 7 7 7 + 2315250 2 3 3 3 5 5 5 7 7 7 + 2322432 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 7 + 2332800 2 2 2 2 2 2 2 3 3 3 3 3 3 5 5 + 2333772 2 2 3 3 3 3 3 7 7 7 7 + 2343750 2 3 5 5 5 5 5 5 5 5 + 2352000 2 2 2 2 2 2 2 3 5 5 5 7 7 + 2352980 2 2 5 7 7 7 7 7 7 + 2359296 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 2361960 2 2 2 3 3 3 3 3 3 3 3 3 3 5 + 2362500 2 2 3 3 3 5 5 5 5 5 7 + 2370816 2 2 2 2 2 2 2 2 3 3 3 7 7 7 + 2381400 2 2 2 3 3 3 3 3 5 5 7 7 + 2400000 2 2 2 2 2 2 2 2 3 5 5 5 5 5 + 2401000 2 2 2 5 5 5 7 7 7 7 + 2408448 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 7 + 2419200 2 2 2 2 2 2 2 2 2 3 3 3 5 5 7 + 2420208 2 2 2 2 3 3 7 7 7 7 7 + 2430000 2 2 2 2 3 3 3 3 3 5 5 5 5 + 2449440 2 2 2 2 2 3 3 3 3 3 3 3 5 7 + 2450000 2 2 2 2 5 5 5 5 5 7 7 + 2457600 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 + 2458624 2 2 2 2 2 2 2 2 2 2 7 7 7 7 + 2460375 3 3 3 3 3 3 3 3 3 5 5 5 + 2469600 2 2 2 2 2 3 3 5 5 7 7 7 + 2470629 3 7 7 7 7 7 7 7 + 2480058 2 3 3 3 3 3 3 3 3 3 3 3 7 + 2480625 3 3 3 3 5 5 5 5 7 7 + 2488320 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 + 2500000 2 2 2 2 2 5 5 5 5 5 5 5 + 2500470 2 3 3 3 3 3 3 5 7 7 7 + 2508800 2 2 2 2 2 2 2 2 2 2 2 5 5 7 7 + 2519424 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 + 2520000 2 2 2 2 2 2 3 3 5 5 5 5 7 + 2521050 2 3 5 5 7 7 7 7 7 + 2531250 2 3 3 3 3 5 5 5 5 5 5 + 2540160 2 2 2 2 2 2 2 3 3 3 3 5 7 7 + 2551500 2 2 3 3 3 3 3 3 5 5 5 7 + 2560000 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 5 + 2571912 2 2 2 3 3 3 3 3 3 3 3 7 7 + 2572500 2 2 3 5 5 5 5 7 7 7 + 2580480 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 7 + 2592000 2 2 2 2 2 2 2 2 3 3 3 3 5 5 5 + 2593080 2 2 2 3 3 3 5 7 7 7 7 + 2612736 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 7 + 2621440 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 2624400 2 2 2 2 3 3 3 3 3 3 3 3 5 5 + 2625000 2 2 2 3 5 5 5 5 5 5 7 + 2634240 2 2 2 2 2 2 2 2 2 3 5 7 7 7 + 2646000 2 2 2 2 3 3 3 5 5 5 7 7 + 2654208 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 2657205 3 3 3 3 3 3 3 3 3 3 3 3 5 + 2667168 2 2 2 2 2 3 3 3 3 3 7 7 7 + 2679075 3 3 3 3 3 3 3 5 5 7 7 + 2688000 2 2 2 2 2 2 2 2 2 2 3 5 5 5 7 + 2689120 2 2 2 2 2 5 7 7 7 7 7 + 2700000 2 2 2 2 2 3 3 3 5 5 5 5 5 + 2701125 3 3 5 5 5 7 7 7 7 + 2709504 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 7 + 2721600 2 2 2 2 2 2 3 3 3 3 3 5 5 7 + 2722734 2 3 3 3 3 7 7 7 7 7 + 2733750 2 3 3 3 3 3 3 3 5 5 5 5 + 2734375 5 5 5 5 5 5 5 5 7 + 2744000 2 2 2 2 2 2 5 5 5 7 7 7 + 2752512 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 2755620 2 2 3 3 3 3 3 3 3 3 3 5 7 + 2756250 2 3 3 5 5 5 5 5 7 7 + 2764800 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 + 2765952 2 2 2 2 2 2 2 3 3 7 7 7 7 + 2778300 2 2 3 3 3 3 5 5 7 7 7 + 2799360 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 5 + 2800000 2 2 2 2 2 2 2 5 5 5 5 5 7 + 2809856 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 7 + 2812500 2 2 3 3 5 5 5 5 5 5 5 + 2822400 2 2 2 2 2 2 2 2 3 3 5 5 7 7 + 2823576 2 2 2 3 7 7 7 7 7 7 + 2834352 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 + 2835000 2 2 2 3 3 3 3 5 5 5 5 7 + 2857680 2 2 2 2 3 3 3 3 3 3 5 7 7 + 2867200 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 7 + 2880000 2 2 2 2 2 2 2 2 2 3 3 5 5 5 5 + 2881200 2 2 2 2 3 5 5 7 7 7 7 + 2893401 3 3 3 3 3 3 3 3 3 3 7 7 + 2903040 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 7 + 2916000 2 2 2 2 2 3 3 3 3 3 3 5 5 5 + 2917215 3 3 3 3 3 5 7 7 7 7 + 2939328 2 2 2 2 2 2 3 3 3 3 3 3 3 3 7 + 2940000 2 2 2 2 2 3 5 5 5 5 7 7 + 2941225 5 5 7 7 7 7 7 7 + 2949120 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 2952450 2 3 3 3 3 3 3 3 3 3 3 5 5 + 2953125 3 3 3 5 5 5 5 5 5 7 + 2963520 2 2 2 2 2 2 3 3 3 5 7 7 7 + 2976750 2 3 3 3 3 3 5 5 5 7 7 + 2985984 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 + 3000000 2 2 2 2 2 2 3 5 5 5 5 5 5 + 3000564 2 2 3 3 3 3 3 3 3 7 7 7 + 3001250 2 5 5 5 5 7 7 7 7 + 3010560 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 7 + 3024000 2 2 2 2 2 2 2 3 3 3 5 5 5 7 + 3025260 2 2 3 3 5 7 7 7 7 7 + 3037500 2 2 3 3 3 3 3 5 5 5 5 5 + 3048192 2 2 2 2 2 2 2 2 3 3 3 3 3 7 7 + 3061800 2 2 2 3 3 3 3 3 3 3 5 5 7 + 3062500 2 2 5 5 5 5 5 5 7 7 + 3072000 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 + 3073280 2 2 2 2 2 2 2 2 5 7 7 7 7 + 3087000 2 2 2 3 3 5 5 5 7 7 7 + 3096576 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 + 3110400 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 5 + 3111696 2 2 2 2 3 3 3 3 7 7 7 7 + 3125000 2 2 2 5 5 5 5 5 5 5 5 + 3136000 2 2 2 2 2 2 2 2 2 5 5 5 7 7 + 3145728 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 3149280 2 2 2 2 2 3 3 3 3 3 3 3 3 3 5 + 3150000 2 2 2 2 3 3 5 5 5 5 5 7 + 3161088 2 2 2 2 2 2 2 2 2 2 3 3 7 7 7 + 3175200 2 2 2 2 2 3 3 3 3 5 5 7 7 + 3176523 3 3 3 7 7 7 7 7 7 + 3188646 2 3 3 3 3 3 3 3 3 3 3 3 3 3 + 3189375 3 3 3 3 3 3 5 5 5 5 7 + 3200000 2 2 2 2 2 2 2 2 2 2 5 5 5 5 5 + 3211264 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 + 3214890 2 3 3 3 3 3 3 3 3 5 7 7 + 3215625 3 5 5 5 5 5 7 7 7 + 3225600 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 7 + 3226944 2 2 2 2 2 2 3 7 7 7 7 7 + 3240000 2 2 2 2 2 2 3 3 3 3 5 5 5 5 + 3241350 2 3 3 3 5 5 7 7 7 7 + 3265920 2 2 2 2 2 2 2 3 3 3 3 3 3 5 7 + 3276800 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 3280500 2 2 3 3 3 3 3 3 3 3 5 5 5 + 3281250 2 3 5 5 5 5 5 5 5 7 + 3292800 2 2 2 2 2 2 2 3 5 5 7 7 7 + 3294172 2 2 7 7 7 7 7 7 7 + 3306744 2 2 2 3 3 3 3 3 3 3 3 3 3 7 + 3307500 2 2 3 3 3 5 5 5 5 7 7 + 3317760 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 + 3333960 2 2 2 3 3 3 3 3 5 7 7 7 + 3359232 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 + 3360000 2 2 2 2 2 2 2 2 3 5 5 5 5 7 + 3361400 2 2 2 5 5 7 7 7 7 7 + 3375000 2 2 2 3 3 3 5 5 5 5 5 5 + 3386880 2 2 2 2 2 2 2 2 2 3 3 3 5 7 7 + 3402000 2 2 2 2 3 3 3 3 3 5 5 5 7 + 3429216 2 2 2 2 2 3 3 3 3 3 3 3 7 7 + 3430000 2 2 2 2 5 5 5 5 7 7 7 + 3440640 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 + 3444525 3 3 3 3 3 3 3 3 3 5 5 7 + 3456000 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 5 + 3457440 2 2 2 2 2 3 3 5 7 7 7 7 + 3472875 3 3 3 3 5 5 5 7 7 7 + 3483648 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 7 + 3499200 2 2 2 2 2 2 3 3 3 3 3 3 3 5 5 + 3500000 2 2 2 2 2 5 5 5 5 5 5 7 + 3500658 2 3 3 3 3 3 3 7 7 7 7 + 3512320 2 2 2 2 2 2 2 2 2 2 2 5 7 7 7 + 3515625 3 3 5 5 5 5 5 5 5 5 + 3528000 2 2 2 2 2 2 3 3 5 5 5 7 7 + 3529470 2 3 5 7 7 7 7 7 7 + 3538944 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 3542940 2 2 3 3 3 3 3 3 3 3 3 3 3 5 + 3543750 2 3 3 3 3 5 5 5 5 5 7 + 3556224 2 2 2 2 2 2 2 3 3 3 3 7 7 7 + 3572100 2 2 3 3 3 3 3 3 5 5 7 7 + 3584000 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 7 + 3600000 2 2 2 2 2 2 2 3 3 5 5 5 5 5 + 3601500 2 2 3 5 5 5 7 7 7 7 + 3612672 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 7 + 3628800 2 2 2 2 2 2 2 2 3 3 3 3 5 5 7 + 3630312 2 2 2 3 3 3 7 7 7 7 7 + 3645000 2 2 2 3 3 3 3 3 3 5 5 5 5 + 3670016 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 3674160 2 2 2 2 3 3 3 3 3 3 3 3 5 7 + 3675000 2 2 2 3 5 5 5 5 5 7 7 + 3686400 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 + 3687936 2 2 2 2 2 2 2 2 2 3 7 7 7 7 + 3704400 2 2 2 2 3 3 3 5 5 7 7 7 + 3720087 3 3 3 3 3 3 3 3 3 3 3 3 7 + 3732480 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 5 + 3750000 2 2 2 2 3 5 5 5 5 5 5 5 + 3750705 3 3 3 3 3 3 3 5 7 7 7 + 3763200 2 2 2 2 2 2 2 2 2 2 3 5 5 7 7 + 3764768 2 2 2 2 2 7 7 7 7 7 7 + 3779136 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 + 3780000 2 2 2 2 2 3 3 3 5 5 5 5 7 + 3781575 3 3 5 5 7 7 7 7 7 + 3796875 3 3 3 3 3 5 5 5 5 5 5 + 3810240 2 2 2 2 2 2 3 3 3 3 3 5 7 7 + 3827250 2 3 3 3 3 3 3 3 5 5 5 7 + 3828125 5 5 5 5 5 5 5 7 7 + 3840000 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 5 + 3841600 2 2 2 2 2 2 5 5 7 7 7 7 + 3857868 2 2 3 3 3 3 3 3 3 3 3 7 7 + 3858750 2 3 3 5 5 5 5 7 7 7 + 3870720 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 7 + 3888000 2 2 2 2 2 2 2 3 3 3 3 3 5 5 5 + 3889620 2 2 3 3 3 3 5 7 7 7 7 + 3906250 2 5 5 5 5 5 5 5 5 5 + 3919104 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 7 + 3920000 2 2 2 2 2 2 2 5 5 5 5 7 7 + 3932160 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 3936600 2 2 2 3 3 3 3 3 3 3 3 3 5 5 + 3937500 2 2 3 3 5 5 5 5 5 5 7 + 3951360 2 2 2 2 2 2 2 2 3 3 5 7 7 7 + 3969000 2 2 2 3 3 3 3 5 5 5 7 7 + 3981312 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 4000000 2 2 2 2 2 2 2 2 5 5 5 5 5 5 + 4000752 2 2 2 2 3 3 3 3 3 3 7 7 7 + 4014080 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 7 + 4032000 2 2 2 2 2 2 2 2 2 3 3 5 5 5 7 + 4033680 2 2 2 2 3 5 7 7 7 7 7 + 4050000 2 2 2 2 3 3 3 3 5 5 5 5 5 + 4064256 2 2 2 2 2 2 2 2 2 2 3 3 3 3 7 7 + 4082400 2 2 2 2 2 3 3 3 3 3 3 5 5 7 + 4084101 3 3 3 3 3 7 7 7 7 7 + 4096000 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 + 4100625 3 3 3 3 3 3 3 3 5 5 5 5 + 4116000 2 2 2 2 2 3 5 5 5 7 7 7 + 4117715 5 7 7 7 7 7 7 7 + 4128768 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 4133430 2 3 3 3 3 3 3 3 3 3 3 5 7 + 4134375 3 3 3 5 5 5 5 5 7 7 + 4147200 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 5 + 4148928 2 2 2 2 2 2 3 3 3 7 7 7 7 + 4167450 2 3 3 3 3 3 5 5 7 7 7 + 4194304 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 + 4199040 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 5 + 4200000 2 2 2 2 2 2 3 5 5 5 5 5 7 + 4201750 2 5 5 5 7 7 7 7 7 + 4214784 2 2 2 2 2 2 2 2 2 2 2 2 3 7 7 7 + 4218750 2 3 3 3 5 5 5 5 5 5 5 + 4233600 2 2 2 2 2 2 2 3 3 3 5 5 7 7 + 4235364 2 2 3 3 7 7 7 7 7 7 + 4251528 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 + 4252500 2 2 3 3 3 3 3 5 5 5 5 7 + 4286520 2 2 2 3 3 3 3 3 3 3 5 7 7 + 4287500 2 2 5 5 5 5 5 7 7 7 + 4300800 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 7 + 4302592 2 2 2 2 2 2 2 2 7 7 7 7 7 + 4320000 2 2 2 2 2 2 2 2 3 3 3 5 5 5 5 + 4321800 2 2 2 3 3 5 5 7 7 7 7 + 4354560 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 7 + 4374000 2 2 2 2 3 3 3 3 3 3 3 5 5 5 + 4375000 2 2 2 5 5 5 5 5 5 5 7 + 4390400 2 2 2 2 2 2 2 2 2 5 5 7 7 7 + 4408992 2 2 2 2 2 3 3 3 3 3 3 3 3 3 7 + 4410000 2 2 2 2 3 3 5 5 5 5 7 7 + 4423680 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 + 4428675 3 3 3 3 3 3 3 3 3 3 3 5 5 + 4445280 2 2 2 2 2 3 3 3 3 5 7 7 7 + 4465125 3 3 3 3 3 3 5 5 5 7 7 + 4478976 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 + 4480000 2 2 2 2 2 2 2 2 2 2 5 5 5 5 7 + 4500000 2 2 2 2 2 3 3 5 5 5 5 5 5 + 4500846 2 3 3 3 3 3 3 3 3 7 7 7 + 4501875 3 5 5 5 5 7 7 7 7 + 4515840 2 2 2 2 2 2 2 2 2 2 2 3 3 5 7 7 + 4536000 2 2 2 2 2 2 3 3 3 3 5 5 5 7 + 4537890 2 3 3 3 5 7 7 7 7 7 + 4556250 2 3 3 3 3 3 3 5 5 5 5 5 + 4572288 2 2 2 2 2 2 2 3 3 3 3 3 3 7 7 + 4587520 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 + 4592700 2 2 3 3 3 3 3 3 3 3 5 5 7 + 4593750 2 3 5 5 5 5 5 5 7 7 + 4608000 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 5 + 4609920 2 2 2 2 2 2 2 3 5 7 7 7 7 + 4630500 2 2 3 3 3 5 5 5 7 7 7 + 4644864 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 7 + 4665600 2 2 2 2 2 2 2 2 3 3 3 3 3 3 5 5 + 4667544 2 2 2 3 3 3 3 3 7 7 7 7 + 4687500 2 2 3 5 5 5 5 5 5 5 5 + 4704000 2 2 2 2 2 2 2 2 3 5 5 5 7 7 + 4705960 2 2 2 5 7 7 7 7 7 7 + 4718592 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 + 4723920 2 2 2 2 3 3 3 3 3 3 3 3 3 3 5 + 4725000 2 2 2 3 3 3 5 5 5 5 5 7 + 4741632 2 2 2 2 2 2 2 2 2 3 3 3 7 7 7 + 4762800 2 2 2 2 3 3 3 3 3 5 5 7 7 + 4782969 3 3 3 3 3 3 3 3 3 3 3 3 3 3 + 4800000 2 2 2 2 2 2 2 2 2 3 5 5 5 5 5 + 4802000 2 2 2 2 5 5 5 7 7 7 7 + 4816896 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 7 + 4822335 3 3 3 3 3 3 3 3 3 5 7 7 + 4838400 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 7 + 4840416 2 2 2 2 2 3 3 7 7 7 7 7 + 4860000 2 2 2 2 2 3 3 3 3 3 5 5 5 5 + 4862025 3 3 3 3 5 5 7 7 7 7 + 4898880 2 2 2 2 2 2 3 3 3 3 3 3 3 5 7 + 4900000 2 2 2 2 2 5 5 5 5 5 7 7 + 4915200 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 + 4917248 2 2 2 2 2 2 2 2 2 2 2 7 7 7 7 + 4920750 2 3 3 3 3 3 3 3 3 3 5 5 5 + 4921875 3 3 5 5 5 5 5 5 5 7 + 4939200 2 2 2 2 2 2 3 3 5 5 7 7 7 + 4941258 2 3 7 7 7 7 7 7 7 + 4960116 2 2 3 3 3 3 3 3 3 3 3 3 3 7 + 4961250 2 3 3 3 3 5 5 5 5 7 7 + 4976640 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 + 5000000 2 2 2 2 2 2 5 5 5 5 5 5 5 + 5000940 2 2 3 3 3 3 3 3 5 7 7 7 + 5017600 2 2 2 2 2 2 2 2 2 2 2 2 5 5 7 7 + 5038848 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 + 5040000 2 2 2 2 2 2 2 3 3 5 5 5 5 7 + 5042100 2 2 3 5 5 7 7 7 7 7 + 5062500 2 2 3 3 3 3 5 5 5 5 5 5 + 5080320 2 2 2 2 2 2 2 2 3 3 3 3 5 7 7 + 5103000 2 2 2 3 3 3 3 3 3 5 5 5 7 + 5120000 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 5 + 5143824 2 2 2 2 3 3 3 3 3 3 3 3 7 7 + 5145000 2 2 2 3 5 5 5 5 7 7 7 + 5160960 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 7 + 5184000 2 2 2 2 2 2 2 2 2 3 3 3 3 5 5 5 + 5186160 2 2 2 2 3 3 3 5 7 7 7 7 + 5225472 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 7 + 5242880 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 + 5248800 2 2 2 2 2 3 3 3 3 3 3 3 3 5 5 + 5250000 2 2 2 2 3 5 5 5 5 5 5 7 + 5250987 3 3 3 3 3 3 3 7 7 7 7 + 5268480 2 2 2 2 2 2 2 2 2 2 3 5 7 7 7 + 5292000 2 2 2 2 2 3 3 3 5 5 5 7 7 + 5294205 3 3 5 7 7 7 7 7 7 + 5308416 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 + 5314410 2 3 3 3 3 3 3 3 3 3 3 3 3 5 + 5315625 3 3 3 3 3 5 5 5 5 5 7 + 5334336 2 2 2 2 2 2 3 3 3 3 3 7 7 7 + 5358150 2 3 3 3 3 3 3 3 5 5 7 7 + 5359375 5 5 5 5 5 5 7 7 7 + 5376000 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 7 + 5378240 2 2 2 2 2 2 5 7 7 7 7 7 + 5400000 2 2 2 2 2 2 3 3 3 5 5 5 5 5 + 5402250 2 3 3 5 5 5 7 7 7 7 + 5419008 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 7 + 5443200 2 2 2 2 2 2 2 3 3 3 3 3 5 5 7 + 5445468 2 2 3 3 3 3 7 7 7 7 7 + 5467500 2 2 3 3 3 3 3 3 3 5 5 5 5 + 5468750 2 5 5 5 5 5 5 5 5 7 + 5488000 2 2 2 2 2 2 2 5 5 5 7 7 7 + 5505024 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 7 + 5511240 2 2 2 3 3 3 3 3 3 3 3 3 5 7 + 5512500 2 2 3 3 5 5 5 5 5 7 7 + 5529600 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 + 5531904 2 2 2 2 2 2 2 2 3 3 7 7 7 7 + 5556600 2 2 2 3 3 3 3 5 5 7 7 7 + 5598720 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 5 + 5600000 2 2 2 2 2 2 2 2 5 5 5 5 5 7 + 5619712 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 7 + 5625000 2 2 2 3 3 5 5 5 5 5 5 5 + 5644800 2 2 2 2 2 2 2 2 2 3 3 5 5 7 7 + 5647152 2 2 2 2 3 7 7 7 7 7 7 + 5668704 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 + 5670000 2 2 2 2 3 3 3 3 5 5 5 5 7 + 5715360 2 2 2 2 2 3 3 3 3 3 3 5 7 7 + 5734400 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 7 + 5740875 3 3 3 3 3 3 3 3 5 5 5 7 + 5760000 2 2 2 2 2 2 2 2 2 2 3 3 5 5 5 5 + 5762400 2 2 2 2 2 3 5 5 7 7 7 7 + 5764801 7 7 7 7 7 7 7 7 + 5786802 2 3 3 3 3 3 3 3 3 3 3 7 7 + 5788125 3 3 3 5 5 5 5 7 7 7 + 5806080 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 7 + 5832000 2 2 2 2 2 2 3 3 3 3 3 3 5 5 5 + 5834430 2 3 3 3 3 3 5 7 7 7 7 + 5859375 3 5 5 5 5 5 5 5 5 5 + 5878656 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 7 + 5880000 2 2 2 2 2 2 3 5 5 5 5 7 7 + 5882450 2 5 5 7 7 7 7 7 7 + 5898240 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 + 5904900 2 2 3 3 3 3 3 3 3 3 3 3 5 5 + 5906250 2 3 3 3 5 5 5 5 5 5 7 + 5927040 2 2 2 2 2 2 2 3 3 3 5 7 7 7 + 5953500 2 2 3 3 3 3 3 5 5 5 7 7 + 5971968 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 + 6000000 2 2 2 2 2 2 2 3 5 5 5 5 5 5 + 6001128 2 2 2 3 3 3 3 3 3 3 7 7 7 + 6002500 2 2 5 5 5 5 7 7 7 7 + 6021120 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 7 + 6048000 2 2 2 2 2 2 2 2 3 3 3 5 5 5 7 + 6050520 2 2 2 3 3 5 7 7 7 7 7 + 6075000 2 2 2 3 3 3 3 3 5 5 5 5 5 + 6096384 2 2 2 2 2 2 2 2 2 3 3 3 3 3 7 7 + 6123600 2 2 2 2 3 3 3 3 3 3 3 5 5 7 + 6125000 2 2 2 5 5 5 5 5 5 7 7 + 6144000 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 + 6146560 2 2 2 2 2 2 2 2 2 5 7 7 7 7 + 6174000 2 2 2 2 3 3 5 5 5 7 7 7 + 6193152 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 7 + 6200145 3 3 3 3 3 3 3 3 3 3 3 5 7 + 6220800 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 5 + 6223392 2 2 2 2 2 3 3 3 3 7 7 7 7 + 6250000 2 2 2 2 5 5 5 5 5 5 5 5 + 6251175 3 3 3 3 3 3 5 5 7 7 7 + 6272000 2 2 2 2 2 2 2 2 2 2 5 5 5 7 7 + 6291456 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 + 6298560 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 5 + 6300000 2 2 2 2 2 3 3 5 5 5 5 5 7 + 6302625 3 5 5 5 7 7 7 7 7 + 6322176 2 2 2 2 2 2 2 2 2 2 2 3 3 7 7 7 + 6328125 3 3 3 3 5 5 5 5 5 5 5 + 6350400 2 2 2 2 2 2 3 3 3 3 5 5 7 7 + 6353046 2 3 3 3 7 7 7 7 7 7 + 6377292 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 + 6378750 2 3 3 3 3 3 3 5 5 5 5 7 + 6400000 2 2 2 2 2 2 2 2 2 2 2 5 5 5 5 5 + 6422528 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 7 + 6429780 2 2 3 3 3 3 3 3 3 3 5 7 7 + 6431250 2 3 5 5 5 5 5 7 7 7 + 6451200 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 7 + 6453888 2 2 2 2 2 2 2 3 7 7 7 7 7 + 6480000 2 2 2 2 2 2 2 3 3 3 3 5 5 5 5 + 6482700 2 2 3 3 3 5 5 7 7 7 7 + 6531840 2 2 2 2 2 2 2 2 3 3 3 3 3 3 5 7 + 6553600 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 + 6561000 2 2 2 3 3 3 3 3 3 3 3 5 5 5 + 6562500 2 2 3 5 5 5 5 5 5 5 7 + 6585600 2 2 2 2 2 2 2 2 3 5 5 7 7 7 + 6588344 2 2 2 7 7 7 7 7 7 7 + 6613488 2 2 2 2 3 3 3 3 3 3 3 3 3 3 7 + 6615000 2 2 2 3 3 3 5 5 5 5 7 7 + 6635520 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 + 6667920 2 2 2 2 3 3 3 3 3 5 7 7 7 + 6718464 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 + 6720000 2 2 2 2 2 2 2 2 2 3 5 5 5 5 7 + 6722800 2 2 2 2 5 5 7 7 7 7 7 + 6750000 2 2 2 2 3 3 3 5 5 5 5 5 5 + 6751269 3 3 3 3 3 3 3 3 3 7 7 7 + 6773760 2 2 2 2 2 2 2 2 2 2 3 3 3 5 7 7 + 6804000 2 2 2 2 2 3 3 3 3 3 5 5 5 7 + 6806835 3 3 3 3 5 7 7 7 7 7 + 6834375 3 3 3 3 3 3 3 5 5 5 5 5 + 6858432 2 2 2 2 2 2 3 3 3 3 3 3 3 7 7 + 6860000 2 2 2 2 2 5 5 5 5 7 7 7 + 6881280 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 7 + 6889050 2 3 3 3 3 3 3 3 3 3 5 5 7 + 6890625 3 3 5 5 5 5 5 5 7 7 + 6912000 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 5 5 + 6914880 2 2 2 2 2 2 3 3 5 7 7 7 7 + 6945750 2 3 3 3 3 5 5 5 7 7 7 + 6967296 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 7 + 6998400 2 2 2 2 2 2 2 3 3 3 3 3 3 3 5 5 + 7000000 2 2 2 2 2 2 5 5 5 5 5 5 7 + 7001316 2 2 3 3 3 3 3 3 7 7 7 7 + 7024640 2 2 2 2 2 2 2 2 2 2 2 2 5 7 7 7 + 7031250 2 3 3 5 5 5 5 5 5 5 5 + 7056000 2 2 2 2 2 2 2 3 3 5 5 5 7 7 + 7058940 2 2 3 5 7 7 7 7 7 7 + 7077888 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 + 7085880 2 2 2 3 3 3 3 3 3 3 3 3 3 3 5 + 7087500 2 2 3 3 3 3 5 5 5 5 5 7 + 7112448 2 2 2 2 2 2 2 2 3 3 3 3 7 7 7 + 7144200 2 2 2 3 3 3 3 3 3 5 5 7 7 + 7168000 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 7 + 7200000 2 2 2 2 2 2 2 2 3 3 5 5 5 5 5 + 7203000 2 2 2 3 5 5 5 7 7 7 7 + 7225344 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 7 + 7257600 2 2 2 2 2 2 2 2 2 3 3 3 3 5 5 7 + 7260624 2 2 2 2 3 3 3 7 7 7 7 7 + 7290000 2 2 2 2 3 3 3 3 3 3 5 5 5 5 + 7340032 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 7 + 7348320 2 2 2 2 2 3 3 3 3 3 3 3 3 5 7 + 7350000 2 2 2 2 3 5 5 5 5 5 7 7 + 7372800 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 5 5 + 7375872 2 2 2 2 2 2 2 2 2 2 3 7 7 7 7 + 7381125 3 3 3 3 3 3 3 3 3 3 5 5 5 + 7408800 2 2 2 2 2 3 3 3 5 5 7 7 7 + 7411887 3 3 7 7 7 7 7 7 7 + 7440174 2 3 3 3 3 3 3 3 3 3 3 3 3 7 + 7441875 3 3 3 3 3 5 5 5 5 7 7 + 7464960 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 5 + 7500000 2 2 2 2 2 3 5 5 5 5 5 5 5 + 7501410 2 3 3 3 3 3 3 3 5 7 7 7 + 7503125 5 5 5 5 5 7 7 7 7 + 7526400 2 2 2 2 2 2 2 2 2 2 2 3 5 5 7 7 + 7529536 2 2 2 2 2 2 7 7 7 7 7 7 + 7558272 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 + 7560000 2 2 2 2 2 2 3 3 3 5 5 5 5 7 + 7563150 2 3 3 5 5 7 7 7 7 7 + 7593750 2 3 3 3 3 3 5 5 5 5 5 5 + 7620480 2 2 2 2 2 2 2 3 3 3 3 3 5 7 7 + 7654500 2 2 3 3 3 3 3 3 3 5 5 5 7 + 7656250 2 5 5 5 5 5 5 5 7 7 + 7680000 2 2 2 2 2 2 2 2 2 2 2 2 3 5 5 5 5 + 7683200 2 2 2 2 2 2 2 5 5 7 7 7 7 + 7715736 2 2 2 3 3 3 3 3 3 3 3 3 7 7 + 7717500 2 2 3 3 5 5 5 5 7 7 7 + 7741440 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 5 7 + 7776000 2 2 2 2 2 2 2 2 3 3 3 3 3 5 5 5 + 7779240 2 2 2 3 3 3 3 5 7 7 7 7 + 7812500 2 2 5 5 5 5 5 5 5 5 5 + 7838208 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 7 + 7840000 2 2 2 2 2 2 2 2 5 5 5 5 7 7 + 7864320 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 5 + 7873200 2 2 2 2 3 3 3 3 3 3 3 3 3 5 5 + 7875000 2 2 2 3 3 5 5 5 5 5 5 7 + 7902720 2 2 2 2 2 2 2 2 2 3 3 5 7 7 7 + 7938000 2 2 2 2 3 3 3 3 5 5 5 7 7 + 7962624 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 + 7971615 3 3 3 3 3 3 3 3 3 3 3 3 3 5 + 8000000 2 2 2 2 2 2 2 2 2 5 5 5 5 5 5 + 8001504 2 2 2 2 2 3 3 3 3 3 3 7 7 7 + 8028160 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 7 7 + 8037225 3 3 3 3 3 3 3 3 5 5 7 7 + 8064000 2 2 2 2 2 2 2 2 2 2 3 3 5 5 5 7 + 8067360 2 2 2 2 2 3 5 7 7 7 7 7 + 8100000 2 2 2 2 2 3 3 3 3 5 5 5 5 5 + 8103375 3 3 3 5 5 5 7 7 7 7 + 8128512 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 7 7 + 8164800 2 2 2 2 2 2 3 3 3 3 3 3 5 5 7 + 8168202 2 3 3 3 3 3 7 7 7 7 7 + 8192000 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 5 5 5 + 8201250 2 3 3 3 3 3 3 3 3 5 5 5 5 + 8203125 3 5 5 5 5 5 5 5 5 7 + 8232000 2 2 2 2 2 2 3 5 5 5 7 7 7 + 8235430 2 5 7 7 7 7 7 7 7 + 8257536 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 7 + 8266860 2 2 3 3 3 3 3 3 3 3 3 3 5 7 + 8268750 2 3 3 3 5 5 5 5 5 7 7 + 8294400 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 5 5 + 8297856 2 2 2 2 2 2 2 3 3 3 7 7 7 7 + 8334900 2 2 3 3 3 3 3 5 5 7 7 7 + 8388608 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 diff --git a/wsjtx_lib/lib/nfft.out b/wsjtx_lib/lib/nfft.out new file mode 100644 index 0000000..0dd0ce6 --- /dev/null +++ b/wsjtx_lib/lib/nfft.out @@ -0,0 +1,1546 @@ + 8 0.0000002 0.00000003 51.20 768.0 1000000 0.0 + 9 0.0000002 0.00000008 46.08 730.4 1000000 0.0 + 10 0.0000002 0.00000011 60.95 1012.4 1000000 0.0 + 12 0.0000002 0.00000008 64.00 1147.2 1000000 0.0 + 14 0.0000001 0.00000018 99.56 1895.2 1000000 0.0 + 15 0.0000002 0.00000014 87.27 1704.8 1000000 0.0 + 16 0.0000002 0.00000014 97.52 1950.5 1000000 0.0 + 18 0.0000002 0.00000015 76.80 1601.3 1000000 0.0 + 20 0.0000002 0.00000017 116.36 2514.6 1000000 0.0 + 21 0.0000002 0.00000017 89.60 1967.8 1000000 0.0 + 24 0.0000001 0.00000015 161.68 3706.6 1000000 0.0 + 25 0.0000002 0.00000017 103.23 2396.8 1000000 0.0 + 27 0.0000002 0.00000014 144.00 3423.5 1000000 0.0 + 28 0.0000002 0.00000015 149.33 3589.5 1000000 0.0 + 30 0.0000002 0.00000013 153.60 3768.5 1000000 0.0 + 32 0.0000002 0.00000016 178.09 4452.2 1000000 0.0 + 35 0.0000003 0.00000018 128.00 3282.7 1000000 0.0 + 36 0.0000002 0.00000016 144.00 3722.3 1000000 0.0 + 40 0.0000002 0.00000015 189.63 5046.0 1000000 0.0 + 42 0.0000003 0.00000022 162.91 4392.3 1000000 0.0 + 45 0.0000004 0.00000016 128.00 3514.8 1000000 0.0 + 48 0.0000002 0.00000016 236.31 6598.8 1000000 0.0 + 49 0.0000003 0.00000019 152.98 4294.6 1000000 0.0 + 50 0.0000002 0.00000017 246.15 6946.3 1000000 0.0 + 54 0.0000002 0.00000020 230.40 6629.6 1000000 0.0 + 56 0.0000002 0.00000017 247.17 7177.1 1000000 0.0 + 60 0.0000002 0.00000018 256.00 7560.8 1000000 0.0 + 63 0.0000004 0.00000022 171.57 5127.7 1000000 0.0 + 64 0.0000002 0.00000017 341.33 10240.0 1000000 0.0 + 70 0.0000003 0.00000017 224.00 6864.8 1000000 0.0 + 72 0.0000002 0.00000017 341.33 10530.0 1000000 0.0 + 75 0.0000003 0.00000019 228.57 7118.6 1000000 0.0 + 80 0.0000002 0.00000016 393.85 12449.3 1000000 0.0 + 81 0.0000005 0.00000018 158.81 5034.1 980302 0.0 + 84 0.0000003 0.00000017 290.59 9287.9 1000000 0.0 + 90 0.0000003 0.00000017 261.82 8498.4 1000000 0.0 + 96 0.0000002 0.00000017 438.86 14449.3 1000000 0.0 + 98 0.0000004 0.00000019 266.89 8827.1 1000000 0.0 + 100 0.0000003 0.00000021 320.00 10630.2 1000000 0.0 + 105 0.0000005 0.00000021 227.80 7647.4 1000000 0.0 + 108 0.0000003 0.00000019 321.49 10858.1 1000000 0.0 + 112 0.0000003 0.00000018 409.60 13941.5 1000000 0.0 + 120 0.0000003 0.00000019 465.45 16074.2 1000000 0.0 + 125 0.0000006 0.00000020 215.68 7512.1 862738 0.0 + 126 0.0000004 0.00000020 282.95 9871.0 1000000 0.0 + 128 0.0000003 0.00000020 468.11 16384.0 1000000 0.0 + 135 0.0000006 0.00000021 222.32 7866.7 823422 0.0 + 140 0.0000003 0.00000019 437.07 15580.1 1000000 0.0 + 144 0.0000003 0.00000018 512.00 18355.0 1000000 0.0 + 147 0.0000010 0.00000021 152.23 5480.0 517788 0.0 + 150 0.0000005 0.00000019 320.00 11566.1 1000000 0.0 + 160 0.0000003 0.00000018 476.28 17436.4 1000000 0.0 + 162 0.0000007 0.00000021 248.49 9119.5 766951 0.0 + 168 0.0000004 0.00000019 477.87 17662.7 1000000 0.0 + 175 0.0000009 0.00000022 205.55 7657.9 587281 0.0 + 180 0.0000004 0.00000020 470.20 17613.5 1000000 0.0 + 189 0.0000012 0.00000022 152.31 5758.9 402928 0.0 + 192 0.0000003 0.00000021 646.74 24527.4 1000000 0.0 + 196 0.0000007 0.00000019 281.07 10701.4 717019 0.0 + 200 0.0000004 0.00000020 457.14 17471.7 1000000 0.0 + 210 0.0000006 0.00000021 339.65 13100.6 808684 0.0 + 216 0.0000005 0.00000020 445.94 17290.9 1000000 0.0 + 224 0.0000004 0.00000021 540.98 21118.2 1000000 0.0 + 225 0.0000011 0.00000024 201.03 7854.2 446741 0.0 + 240 0.0000003 0.00000019 853.33 33736.1 1000000 0.1 + 243 0.0000016 0.00000022 151.79 6014.3 312315 0.0 + 245 0.0000015 0.00000023 167.65 6652.8 342140 0.0 + 250 0.0000008 0.00000024 332.95 13261.0 665900 0.0 + 252 0.0000007 0.00000021 373.22 14886.3 740509 0.0 + 256 0.0000004 0.00000019 728.18 29127.1 1000000 0.0 + 270 0.0000008 0.00000022 322.93 13041.4 598027 0.0 + 280 0.0000005 0.00000020 578.06 23496.2 1000000 0.0 + 288 0.0000006 0.00000020 495.48 20240.2 860210 0.1 + 294 0.0000012 0.00000022 248.82 10201.3 423165 0.0 + 300 0.0000006 0.00000020 464.51 19111.9 774186 0.0 + 315 0.0000019 0.00000023 169.88 7049.5 269657 0.0 + 320 0.0000003 0.000000201024.00 42608.3 1000000 0.0 + 324 0.0000009 0.00000021 377.75 15752.1 582954 0.0 + 336 0.0000009 0.00000021 372.85 15645.6 554843 0.0 + 343 0.0000023 0.00000023 150.28 6328.3 219064 0.0 + 350 0.0000011 0.00000023 320.75 13553.4 458208 0.0 + 360 0.0000007 0.00000022 527.74 22407.3 732968 0.1 + 375 0.0000019 0.00000024 192.92 8248.1 257229 0.0 + 378 0.0000013 0.00000023 285.36 12216.7 377464 0.0 + 384 0.0000005 0.00000022 805.77 34587.5 1000000 0.1 + 392 0.0000010 0.00000024 409.69 17646.6 522559 0.0 + 400 0.0000005 0.00000021 729.04 31508.6 911300 0.0 + 405 0.0000023 0.00000023 175.76 7612.0 216988 0.0 + 420 0.0000011 0.00000022 398.06 17343.9 473878 0.0 + 432 0.0000009 0.00000022 463.56 20291.9 536523 0.1 + 441 0.0000029 0.00000024 151.23 6642.7 171467 0.0 + 448 0.0000007 0.00000021 613.30 27008.0 684492 0.0 + 450 0.0000015 0.00000022 305.81 13476.6 339787 0.0 + 480 0.0000008 0.00000021 589.46 26251.3 614022 0.1 + 486 0.0000018 0.00000024 263.15 11742.9 270733 0.0 + 490 0.0000017 0.00000023 283.60 12672.1 289387 0.0 + 500 0.0000012 0.00000024 426.57 19122.9 426575 0.0 + 504 0.0000013 0.00000022 399.80 17945.7 396629 0.1 + 512 0.0000005 0.00000022 961.52 43268.2 938980 0.0 + 525 0.0000027 0.00000023 194.17 8773.0 184928 0.0 + 540 0.0000012 0.00000022 458.43 20805.2 424468 0.1 + 560 0.0000012 0.00000022 486.46 22205.3 434343 0.1 + 567 0.0000035 0.00000025 163.76 7489.5 144405 0.0 + 576 0.0000012 0.00000022 500.04 22926.7 434063 0.1 + 588 0.0000014 0.00000024 410.30 18873.2 348895 0.0 + 600 0.0000012 0.00000022 505.51 23326.4 421260 0.1 + 625 0.0000036 0.00000026 171.64 7970.7 137312 0.0 + 630 0.0000020 0.00000022 308.54 14345.9 244874 0.0 + 640 0.0000007 0.00000020 894.82 41707.1 699075 0.1 + 648 0.0000015 0.00000023 425.03 19848.7 327958 0.1 + 672 0.0000014 0.00000023 489.27 22976.8 364039 0.1 + 675 0.0000035 0.00000024 195.05 9166.3 144484 0.0 + 686 0.0000025 0.00000023 274.30 12922.2 199924 0.0 + 700 0.0000017 0.00000024 420.54 19873.3 300389 0.0 + 720 0.0000012 0.00000023 599.40 28447.2 416251 0.1 + 729 0.0000048 0.00000024 150.48 7155.4 103213 0.0 + 735 0.0000041 0.00000024 180.62 8599.0 122871 0.0 + 750 0.0000024 0.00000025 306.71 14646.4 204471 0.0 + 756 0.0000019 0.00000024 403.45 19289.5 266833 0.0 + 768 0.0000009 0.00000022 868.76 41635.2 565599 0.1 + 784 0.0000018 0.00000024 427.41 20547.0 272581 0.0 + 800 0.0000013 0.00000022 592.60 28575.0 370378 0.1 + 810 0.0000030 0.00000024 270.48 13066.5 166962 0.0 + 840 0.0000018 0.00000023 465.39 22604.7 277019 0.1 + 864 0.0000017 0.00000023 498.16 24297.5 288287 0.1 + 875 0.0000053 0.00000025 165.78 8101.0 94732 0.0 + 882 0.0000034 0.00000024 259.19 12680.3 146932 0.0 + 896 0.0000017 0.00000023 529.41 25960.5 295429 0.1 + 900 0.0000021 0.00000023 435.99 21393.5 242216 0.1 + 945 0.0000059 0.00000024 161.31 7972.0 85348 0.0 + 960 0.0000018 0.00000022 539.97 26747.3 281236 0.1 + 972 0.0000024 0.00000024 404.45 20070.6 208052 0.0 + 980 0.0000026 0.00000024 371.13 18439.1 189354 0.0 + 1000 0.0000022 0.00000025 463.68 23104.6 231839 0.0 + 1008 0.0000021 0.00000023 474.10 23651.3 235170 0.1 + 1024 0.0000012 0.00000023 847.54 42376.9 413837 0.0 + 1029 0.0000077 0.00000026 133.62 6685.7 64927 0.0 + 1050 0.0000032 0.00000024 326.84 16401.2 155639 0.0 + 1080 0.0000024 0.00000023 456.54 23002.6 211363 0.1 + 1120 0.0000023 0.00000024 491.10 24872.6 219242 0.1 + 1125 0.0000069 0.00000026 162.30 8225.3 72135 0.0 + 1134 0.0000045 0.00000026 253.71 12872.2 111865 0.0 + 1152 0.0000022 0.00000024 516.81 26279.7 224311 0.1 + 1176 0.0000032 0.00000024 362.22 18472.7 154006 0.0 + 1200 0.0000021 0.00000023 580.19 29673.2 241745 0.1 + 1215 0.0000074 0.00000025 164.15 8410.2 67553 0.0 + 1225 0.0000072 0.00000026 169.83 8711.1 69319 0.0 + 1250 0.0000042 0.00000028 298.40 15349.0 119358 0.0 + 1260 0.0000033 0.00000024 381.43 19642.0 151360 0.1 + 1280 0.0000016 0.00000022 806.55 41625.8 315059 0.1 + 1296 0.0000027 0.00000023 487.92 25225.3 188242 0.1 + 1323 0.0000100 0.00000027 132.33 6860.9 50010 0.0 + 1344 0.0000028 0.00000025 473.87 24623.0 176291 0.1 + 1350 0.0000047 0.00000024 284.46 14790.1 105355 0.1 + 1372 0.0000050 0.00000026 275.29 14345.7 100326 0.0 + 1400 0.0000030 0.00000024 470.92 24608.3 168185 0.1 + 1440 0.0000030 0.00000022 487.29 25563.0 169199 0.2 + 1458 0.0000059 0.00000026 247.76 13019.2 84964 0.0 + 1470 0.0000044 0.00000026 331.91 17461.0 112894 0.0 + 1500 0.0000034 0.00000025 444.29 23437.8 148096 0.1 + 1512 0.0000039 0.00000026 390.46 20620.6 129120 0.1 + 1536 0.0000029 0.00000024 533.90 28256.5 173795 0.1 + 1568 0.0000039 0.00000025 405.36 21513.7 129259 0.0 + 1575 0.0000093 0.00000026 169.75 9014.5 53888 0.0 + 1600 0.0000030 0.00000024 540.70 28775.9 168970 0.1 + 1620 0.0000042 0.00000024 385.04 20525.8 118838 0.1 + 1680 0.0000030 0.00000024 563.58 30191.5 167731 0.1 + 1701 0.0000131 0.00000027 129.50 6948.9 38065 0.0 + 1715 0.0000131 0.00000027 131.06 7040.7 38211 0.0 + 1728 0.0000034 0.00000024 504.41 27124.6 145953 0.1 + 1750 0.0000067 0.00000027 259.41 13973.5 74118 0.0 + 1764 0.0000052 0.00000027 340.05 18336.6 96386 0.0 + 1792 0.0000037 0.00000026 481.92 26041.2 134463 0.1 + 1800 0.0000038 0.00000024 477.93 25841.3 132759 0.2 + 1875 0.0000126 0.00000027 149.01 8100.7 39736 0.0 + 1890 0.0000072 0.00000025 260.93 14200.0 69029 0.1 + 1920 0.0000035 0.00000024 553.23 30170.2 144071 0.2 + 1944 0.0000052 0.00000026 375.94 20535.5 96693 0.1 + 1960 0.0000052 0.00000025 379.85 20771.5 96901 0.1 + 2000 0.0000036 0.00000026 561.23 30771.5 140307 0.1 + 2016 0.0000045 0.00000025 448.89 24638.0 111332 0.2 + 2025 0.0000132 0.00000027 153.18 8412.1 37821 0.0 + 2048 0.0000029 0.00000024 713.17 39224.4 174114 0.1 + 2058 0.0000089 0.00000027 230.78 12701.0 56069 0.0 + 2100 0.0000047 0.00000025 449.06 24779.3 106918 0.1 + 2160 0.0000044 0.00000025 489.70 27121.5 113356 0.2 + 2187 0.0000181 0.00000028 120.79 6700.6 27615 0.0 + 2205 0.0000158 0.00000027 139.16 7727.8 31555 0.0 + 2240 0.0000042 0.00000025 539.63 30028.7 120454 0.1 + 2250 0.0000074 0.00000026 304.11 16932.4 67580 0.1 + 2268 0.0000059 0.00000027 382.09 21296.4 84236 0.1 + 2304 0.0000047 0.00000026 494.26 27604.4 107262 0.2 + 2352 0.0000067 0.00000027 353.04 19769.7 75051 0.1 + 2400 0.0000044 0.00000025 545.60 30632.3 113667 0.2 + 2401 0.0000186 0.00000027 129.23 7256.0 26912 0.0 + 2430 0.0000097 0.00000026 249.48 14029.1 51333 0.1 + 2450 0.0000095 0.00000026 256.73 14451.8 52393 0.0 + 2500 0.0000065 0.00000028 383.67 21653.5 76733 0.0 + 2520 0.0000067 0.00000026 377.82 21345.3 74964 0.2 + 2560 0.0000046 0.00000024 553.95 31358.8 108193 0.1 + 2592 0.0000059 0.00000026 436.68 24759.4 84236 0.2 + 2625 0.0000181 0.00000027 144.81 8223.9 27583 0.0 + 2646 0.0000123 0.00000027 214.37 12186.7 40509 0.0 + 2688 0.0000049 0.00000027 543.09 30935.5 101022 0.2 + 2700 0.0000063 0.00000025 429.38 24472.0 79515 0.2 + 2744 0.0000081 0.00000027 338.95 19357.5 61762 0.0 + 2800 0.0000059 0.00000025 477.71 27351.7 85305 0.1 + 2835 0.0000217 0.00000027 130.74 7497.6 23059 0.0 + 2880 0.0000053 0.00000024 538.84 30961.5 93549 0.3 + 2916 0.0000078 0.00000028 374.01 21524.0 64131 0.1 + 2940 0.0000083 0.00000027 356.16 20517.5 60571 0.1 + 3000 0.0000066 0.00000026 451.60 26081.7 75267 0.1 + 3024 0.0000072 0.00000027 420.31 24298.4 69495 0.2 + 3072 0.0000057 0.00000026 540.29 31296.3 87938 0.1 + 3087 0.0000236 0.00000028 130.84 7583.4 21192 0.0 + 3125 0.0000229 0.00000030 136.51 7923.9 21841 0.0 + 3136 0.0000078 0.00000027 402.13 23353.1 64115 0.1 + 3150 0.0000110 0.00000026 285.70 16601.1 45350 0.1 + 3200 0.0000058 0.00000025 555.42 32336.4 86785 0.2 + 3240 0.0000088 0.00000025 367.55 21431.2 56720 0.2 + 3360 0.0000076 0.00000025 444.14 26013.7 66092 0.2 + 3375 0.0000221 0.00000028 152.71 8949.0 22623 0.0 + 3402 0.0000154 0.00000028 220.94 12960.5 32472 0.0 + 3430 0.0000158 0.00000027 217.14 12750.4 31653 0.0 + 3456 0.0000080 0.00000027 430.06 25276.4 62219 0.2 + 3500 0.0000096 0.00000027 364.72 21469.6 52103 0.1 + 3528 0.0000095 0.00000027 370.67 21840.8 52532 0.1 + 3584 0.0000074 0.00000027 483.27 28530.5 67420 0.1 + 3600 0.0000075 0.00000025 477.71 28218.0 66349 0.3 + 3645 0.0000281 0.00000028 129.51 7661.9 17766 0.0 + 3675 0.0000273 0.00000028 134.51 7965.5 18301 0.0 + 3750 0.0000135 0.00000028 276.95 16440.4 36926 0.1 + 3780 0.0000099 0.00000026 380.25 22595.0 50298 0.2 + 3840 0.0000077 0.00000025 496.09 29534.4 64595 0.3 + 3888 0.0000103 0.00000027 378.60 22573.5 48688 0.2 + 3920 0.0000096 0.00000027 408.82 24400.0 52146 0.1 + 3969 0.0000319 0.00000029 124.45 7438.8 15678 0.0 + 4000 0.0000085 0.00000026 472.65 28278.0 59081 0.1 + 4032 0.0000100 0.00000027 402.14 24082.9 49869 0.2 + 4050 0.0000153 0.00000027 265.12 15885.7 32731 0.1 + 4096 0.0000059 0.00000027 696.50 41790.0 85022 0.1 + 4116 0.0000124 0.00000028 332.84 19982.4 40433 0.0 + 4200 0.0000117 0.00000026 359.28 21621.6 42771 0.2 + 4320 0.0000101 0.00000026 426.70 25766.1 49387 0.3 + 4374 0.0000218 0.00000029 200.70 12136.9 22942 0.0 + 4375 0.0000322 0.00000030 136.01 8225.2 15544 0.0 + 4410 0.0000176 0.00000027 250.61 15170.2 28414 0.1 + 4480 0.0000101 0.00000027 443.07 26870.7 49450 0.2 + 4500 0.0000099 0.00000027 453.25 27502.5 50361 0.2 + 4536 0.0000132 0.00000028 343.51 20863.5 37865 0.2 + 4608 0.0000087 0.00000026 530.82 32300.4 57598 0.3 + 4704 0.0000133 0.00000028 354.07 21597.7 37635 0.1 + 4725 0.0000342 0.00000028 138.26 8438.3 14631 0.1 + 4800 0.0000090 0.00000025 533.64 32628.6 55587 0.3 + 4802 0.0000229 0.00000028 209.42 12805.7 21806 0.0 + 4860 0.0000132 0.00000027 367.40 22497.1 37798 0.2 + 4900 0.0000142 0.00000028 346.18 21218.1 35324 0.1 + 5000 0.0000113 0.00000028 444.29 27296.5 44429 0.1 + 5040 0.0000128 0.00000027 394.86 24282.6 39173 0.3 + 5103 0.0000446 0.00000030 114.34 7041.6 11203 0.0 + 5120 0.0000098 0.00000026 521.01 32099.3 50880 0.2 + 5145 0.0000399 0.00000029 128.91 7946.8 12528 0.0 + 5184 0.0000123 0.00000027 420.36 25935.9 40544 0.3 + 5250 0.0000234 0.00000028 224.25 13856.4 21357 0.1 + 5292 0.0000168 0.00000028 315.03 19484.1 29765 0.1 + 5376 0.0000108 0.00000027 497.46 30823.6 46267 0.3 + 5400 0.0000141 0.00000027 383.92 23800.5 35548 0.3 + 5488 0.0000161 0.00000029 340.78 21166.1 31048 0.1 + 5600 0.0000135 0.00000026 415.84 25888.9 37129 0.2 + 5625 0.0000446 0.00000030 126.08 7853.2 11207 0.0 + 5670 0.0000248 0.00000028 228.69 14258.1 20167 0.1 + 5760 0.0000125 0.00000026 460.40 28756.0 39965 0.4 + 5832 0.0000191 0.00000028 305.47 19106.7 26189 0.1 + 5880 0.0000163 0.00000028 361.47 22630.7 30737 0.2 + 6000 0.0000131 0.00000027 457.74 28724.9 38145 0.3 + 6048 0.0000167 0.00000027 361.79 22724.6 29910 0.3 + 6075 0.0000448 0.00000029 135.70 8528.1 11169 0.1 + 6125 0.0000463 0.00000029 132.42 8329.7 10810 0.0 + 6144 0.0000125 0.00000028 491.26 30912.6 39979 0.2 + 6174 0.0000292 0.00000029 211.40 13309.6 17120 0.0 + 6250 0.0000274 0.00000031 228.40 14400.2 18272 0.0 + 6272 0.0000184 0.00000028 340.39 21469.9 27136 0.1 + 6300 0.0000172 0.00000027 366.74 23143.1 29106 0.3 + 6400 0.0000129 0.00000026 496.93 31415.8 38823 0.3 + 6480 0.0000158 0.00000027 408.85 25883.8 31547 0.4 + 6561 0.0000586 0.00000030 111.94 7097.1 8531 0.0 + 6615 0.0000478 0.00000029 138.25 8773.2 10450 0.0 + 6720 0.0000155 0.00000027 434.02 27591.1 32293 0.4 + 6750 0.0000256 0.00000028 263.76 16776.2 19538 0.1 + 6804 0.0000209 0.00000029 324.96 20687.2 23880 0.1 + 6860 0.0000216 0.00000028 317.04 20201.9 23108 0.1 + 6912 0.0000170 0.00000028 405.55 25864.0 29337 0.4 + 7000 0.0000181 0.00000029 387.18 24727.8 27656 0.2 + 7056 0.0000192 0.00000028 367.93 23519.1 26072 0.2 + 7168 0.0000158 0.00000028 452.40 28970.3 31557 0.2 + 7200 0.0000178 0.00000027 404.34 25905.5 28079 0.5 + 7203 0.0000697 0.00000031 103.28 6617.1 7169 0.0 + 7290 0.0000343 0.00000029 212.69 13646.1 14588 0.1 + 7350 0.0000319 0.00000029 230.38 14794.4 15672 0.1 + 7500 0.0000187 0.00000029 400.26 25762.1 26684 0.2 + 7560 0.0000189 0.00000028 400.11 25775.1 26462 0.4 + 7680 0.0000160 0.00000026 479.51 30944.8 31218 0.4 + 7776 0.0000210 0.00000028 370.78 23961.0 23841 0.3 + 7840 0.0000201 0.00000028 389.41 25188.5 24835 0.2 + 7875 0.0000617 0.00000030 127.73 8266.2 8110 0.1 + 7938 0.0000401 0.00000029 197.75 12808.9 12456 0.1 + 8000 0.0000165 0.00000027 484.90 31435.3 30306 0.3 + 8064 0.0000204 0.00000030 396.22 25709.1 24567 0.4 + 8100 0.0000207 0.00000028 390.87 25374.9 24128 0.3 + 8192 0.0000183 0.00000028 447.63 29095.8 27321 0.1 + 8232 0.0000275 0.00000029 299.20 19458.5 18173 0.1 + 8400 0.0000208 0.00000028 404.48 26364.2 24076 0.4 + 8505 0.0000675 0.00000029 125.91 8218.1 7402 0.1 + 8575 0.0000720 0.00000030 119.18 7785.7 6949 0.0 + 8640 0.0000180 0.00000026 479.09 31324.7 27725 0.6 + 8748 0.0000294 0.00000029 297.17 19456.8 16985 0.1 + 8750 0.0000399 0.00000031 219.43 14367.4 12539 0.1 + 8820 0.0000254 0.00000029 347.21 22753.5 19683 0.2 + 8960 0.0000202 0.00000027 443.13 29089.6 24728 0.4 + 9000 0.0000225 0.00000028 399.20 26219.1 22178 0.4 + 9072 0.0000254 0.00000029 357.49 23500.1 19703 0.3 + 9216 0.0000189 0.00000028 486.48 32034.2 26393 0.4 + 9261 0.0000938 0.00000031 98.72 6504.3 5330 0.0 + 9375 0.0000768 0.00000031 122.01 8049.1 6507 0.0 + 9408 0.0000244 0.00000030 385.24 25425.1 20474 0.3 + 9450 0.0000376 0.00000028 251.50 16606.8 13307 0.2 + 9600 0.0000218 0.00000027 439.93 29098.7 22913 0.6 + 9604 0.0000400 0.00000030 240.27 15893.4 12509 0.0 + 9720 0.0000255 0.00000028 380.44 25198.0 19570 0.4 + 9800 0.0000262 0.00000029 374.30 24813.5 19097 0.2 + 10000 0.0000258 0.00000029 388.34 25800.8 19417 0.2 + 10080 0.0000274 0.00000028 367.68 24449.1 18238 0.6 + 10125 0.0000802 0.00000031 126.32 8403.8 6238 0.1 + 10206 0.0000559 0.00000030 182.54 12154.8 8943 0.1 + 10240 0.0000236 0.00000027 433.52 28876.7 21168 0.3 + 10290 0.0000438 0.00000029 234.71 15642.5 11405 0.1 + 10368 0.0000267 0.00000028 387.80 25866.3 18702 0.5 + 10500 0.0000294 0.00000029 356.64 23820.4 16983 0.3 + 10584 0.0000328 0.00000030 322.81 21579.3 15250 0.2 + 10752 0.0000254 0.00000029 423.48 28356.8 19693 0.4 + 10800 0.0000276 0.00000027 391.18 26206.3 18110 0.6 + 10935 0.0000901 0.00000030 121.40 8143.9 5551 0.1 + 10976 0.0000352 0.00000030 311.98 20937.2 14212 0.1 + 11025 0.0000889 0.00000030 123.99 8324.8 5623 0.1 + 11200 0.0000295 0.00000027 380.04 25559.9 16966 0.4 + 11250 0.0000508 0.00000030 221.33 14893.1 9837 0.2 + 11340 0.0000364 0.00000029 311.85 21001.7 13750 0.4 + 11520 0.0000272 0.00000028 423.22 28550.2 18369 0.7 + 11664 0.0000359 0.00000030 324.89 21945.9 13927 0.3 + 11760 0.0000305 0.00000028 385.78 26081.5 16402 0.4 + 11907 0.0001183 0.00000032 100.69 6816.2 4228 0.0 + 12000 0.0000272 0.00000028 440.40 29838.7 18350 0.5 + 12005 0.0001191 0.00000031 100.82 6831.1 4199 0.0 + 12096 0.0000323 0.00000028 374.71 25409.5 15489 0.6 + 12150 0.0000573 0.00000029 212.19 14395.5 8732 0.2 + 12250 0.0000613 0.00000030 199.87 13571.7 8158 0.1 + 12288 0.0000282 0.00000029 435.14 29557.0 17706 0.4 + 12348 0.0000440 0.00000031 280.32 19050.8 11351 0.1 + 12500 0.0000423 0.00000032 295.23 20089.5 11809 0.1 + 12544 0.0000339 0.00000030 370.15 25197.3 14754 0.3 + 12600 0.0000383 0.00000028 329.09 22412.7 13059 0.6 + 12800 0.0000295 0.00000027 433.92 29601.7 16950 0.4 + 12960 0.0000346 0.00000028 374.49 25581.1 14448 0.7 + 13122 0.0000741 0.00000031 177.20 12120.2 6752 0.1 + 13125 0.0001062 0.00000031 123.59 8453.2 4708 0.1 + 13230 0.0000636 0.00000030 208.08 14244.8 7864 0.2 + 13440 0.0000314 0.00000028 428.14 29358.4 15928 0.8 + 13500 0.0000377 0.00000029 357.99 24559.5 13259 0.4 + 13608 0.0000466 0.00000030 291.86 20039.7 10724 0.4 + 13720 0.0000454 0.00000029 302.25 20770.7 11015 0.2 + 13824 0.0000348 0.00000030 397.41 27331.8 14374 0.6 + 14000 0.0000372 0.00000029 375.98 25892.4 13428 0.4 + 14112 0.0000433 0.00000029 325.56 22438.9 11535 0.5 + 14175 0.0001199 0.00000031 118.25 8153.8 4171 0.1 + 14336 0.0000383 0.00000030 374.63 25863.1 13066 0.3 + 14400 0.0000336 0.00000027 429.15 29640.8 14901 0.9 + 14406 0.0000829 0.00000031 173.82 12006.3 6033 0.0 + 14580 0.0000465 0.00000029 313.64 21691.2 10756 0.4 + 14700 0.0000424 0.00000029 347.04 24021.1 11804 0.4 + 15000 0.0000424 0.00000030 353.61 24527.6 11787 0.4 + 15120 0.0000415 0.00000028 364.12 25277.5 12041 0.8 + 15309 0.0001515 0.00000032 101.07 7025.4 3301 0.1 + 15360 0.0000350 0.00000028 439.11 30533.4 14294 0.7 + 15435 0.0001558 0.00000031 99.06 6891.7 3209 0.1 + 15552 0.0000445 0.00000029 349.24 24315.2 11228 0.6 + 15625 0.0001372 0.00000034 113.88 7932.3 3644 0.0 + 15680 0.0000387 0.00000029 405.01 28222.7 12915 0.4 + 15750 0.0000694 0.00000030 227.05 15829.0 7208 0.3 + 15876 0.0000592 0.00000031 268.24 18715.9 8448 0.2 + 16000 0.0000388 0.00000028 412.45 28800.8 12889 0.5 + 16128 0.0000411 0.00000030 392.62 27438.8 12172 0.7 + 16200 0.0000461 0.00000028 351.77 24595.0 10857 0.7 + 16384 0.0000455 0.00000029 360.22 25215.3 10993 0.3 + 16464 0.0000542 0.00000031 303.56 21260.1 9219 0.2 + 16800 0.0000485 0.00000028 346.72 24333.0 10319 0.9 + 16807 0.0001743 0.00000032 96.44 6768.4 2869 0.0 + 16875 0.0001448 0.00000032 116.54 8182.5 3453 0.1 + 17010 0.0000840 0.00000030 202.52 14231.3 5953 0.3 + 17150 0.0000919 0.00000031 186.59 13122.9 5440 0.1 + 17280 0.0000379 0.00000027 455.67 32072.2 13185 1.0 + 17496 0.0000633 0.00000031 276.51 19486.5 7902 0.3 + 17500 0.0000579 0.00000031 302.08 21289.5 8631 0.2 + 17640 0.0000559 0.00000029 315.72 22268.7 8949 0.5 + 17920 0.0000448 0.00000028 400.01 28259.3 11161 0.6 + 18000 0.0000458 0.00000029 392.98 27775.0 10916 0.8 + 18144 0.0000529 0.00000030 343.25 24280.0 9459 0.7 + 18225 0.0001575 0.00000032 115.73 8189.9 3175 0.1 + 18375 0.0001619 0.00000031 113.48 8037.8 3088 0.1 + 18432 0.0000451 0.00000029 408.75 28959.6 11088 0.6 + 18522 0.0001088 0.00000032 170.22 12065.8 4595 0.1 + 18750 0.0000867 0.00000032 216.38 15356.8 5770 0.2 + 18816 0.0000505 0.00000031 372.74 26464.3 9905 0.5 + 18900 0.0000578 0.00000029 326.97 23224.8 8650 0.7 + 19200 0.0000456 0.00000028 421.06 29955.6 10965 1.0 + 19208 0.0000736 0.00000031 261.00 18569.3 6794 0.1 + 19440 0.0000577 0.00000029 337.09 24012.1 8670 0.8 + 19600 0.0000529 0.00000029 370.24 26395.7 9445 0.5 + 19683 0.0002074 0.00000032 94.91 6769.4 2411 0.0 + 19845 0.0001979 0.00000031 100.30 7159.4 2527 0.1 + 20000 0.0000547 0.00000030 365.92 26140.8 9148 0.5 + 20160 0.0000535 0.00000028 376.95 26950.6 9349 1.2 + 20250 0.0001029 0.00000030 196.79 14076.0 4859 0.4 + 20412 0.0000805 0.00000031 253.56 18151.1 6211 0.3 + 20480 0.0000516 0.00000029 397.07 28433.8 9694 0.5 + 20580 0.0000760 0.00000031 270.83 19403.8 6580 0.3 + 20736 0.0000604 0.00000031 343.14 24602.8 8274 0.9 + 21000 0.0000636 0.00000030 330.33 23714.6 7865 0.7 + 21168 0.0000701 0.00000031 301.81 21684.7 7129 0.5 + 21504 0.0000597 0.00000030 360.19 25920.0 8375 0.7 + 21600 0.0000565 0.00000028 382.32 27524.6 8850 1.2 + 21609 0.0002164 0.00000032 99.88 7190.8 2311 0.0 + 21870 0.0001233 0.00000031 177.41 12788.3 4056 0.3 + 21875 0.0002032 0.00000033 107.67 7761.3 2461 0.1 + 21952 0.0000757 0.00000032 290.03 20914.1 6606 0.3 + 22050 0.0001093 0.00000030 201.71 14552.1 4574 0.4 + 22400 0.0000564 0.00000029 396.97 28683.7 8861 0.8 + 22500 0.0000699 0.00000031 322.02 23278.2 7156 0.6 + 22680 0.0000814 0.00000030 278.47 20145.7 6139 0.9 + 23040 0.0000606 0.00000029 379.93 27529.4 8245 1.2 + 23328 0.0000875 0.00000031 266.55 19337.6 5713 0.7 + 23520 0.0000743 0.00000030 316.53 22982.8 6729 0.8 + 23625 0.0002339 0.00000032 101.02 7338.1 2138 0.2 + 23814 0.0001577 0.00000032 150.98 10975.9 3170 0.2 + 24000 0.0000668 0.00000029 359.14 26128.5 7482 1.2 + 24010 0.0001425 0.00000031 168.45 12256.2 3508 0.1 + 24192 0.0000742 0.00000030 325.91 23730.2 6736 1.1 + 24300 0.0000797 0.00000030 304.77 22200.5 6271 0.7 + 24500 0.0000825 0.00000031 296.99 21651.2 6061 0.3 + 24576 0.0000649 0.00000030 378.96 27635.7 7710 0.6 + 24696 0.0000931 0.00000031 265.38 19362.3 5373 0.4 + 25000 0.0000772 0.00000033 323.90 23660.3 6478 0.4 + 25088 0.0000835 0.00000031 300.50 21958.9 5989 0.5 + 25200 0.0000689 0.00000029 365.80 26742.3 7258 1.4 + 25515 0.0002475 0.00000031 103.08 7545.0 2020 0.2 + 25600 0.0000713 0.00000027 359.22 26301.8 7016 0.8 + 25725 0.0002516 0.00000031 102.23 7488.9 1987 0.1 + 25920 0.0000849 0.00000028 305.34 22384.0 5890 1.4 + 26244 0.0001096 0.00000032 239.45 17575.3 4562 0.3 + 26250 0.0001374 0.00000032 191.10 14026.8 3640 0.4 + 26460 0.0000987 0.00000031 267.99 19685.7 5064 0.6 + 26880 0.0000784 0.00000029 342.77 25218.3 6376 1.4 + 27000 0.0000840 0.00000029 321.41 23656.7 5952 1.1 + 27216 0.0000975 0.00000031 279.24 20568.8 5130 0.9 + 27440 0.0001013 0.00000030 270.83 19965.8 4935 0.4 + 27648 0.0000705 0.00000030 392.05 28923.2 7090 1.0 + 27783 0.0002907 0.00000032 95.57 7054.2 1720 0.1 + 28000 0.0000893 0.00000030 313.43 23151.9 5597 0.9 + 28125 0.0002769 0.00000034 101.59 7507.1 1806 0.2 + 28224 0.0000984 0.00000030 286.76 21197.9 5080 1.0 + 28350 0.0001497 0.00000030 189.32 14001.3 3339 0.6 + 28672 0.0000857 0.00000031 334.37 24755.9 5831 0.5 + 28800 0.0000829 0.00000029 347.27 25721.9 6029 1.7 + 28812 0.0001276 0.00000032 225.89 16731.8 3920 0.2 + 29160 0.0001102 0.00000031 264.60 19622.2 4537 0.9 + 29400 0.0001008 0.00000030 291.77 21654.2 4962 0.9 + 30000 0.0000835 0.00000031 359.22 26712.8 5987 1.0 + 30240 0.0000988 0.00000030 306.15 22783.9 5062 1.7 + 30375 0.0002852 0.00000032 106.49 7928.9 1753 0.2 + 30618 0.0001878 0.00000032 163.01 12146.0 2662 0.3 + 30625 0.0003047 0.00000033 100.51 7489.3 1641 0.1 + 30720 0.0000844 0.00000029 363.91 27123.8 5923 1.2 + 30870 0.0001949 0.00000031 158.36 11809.1 2565 0.3 + 31104 0.0000896 0.00000030 347.31 25917.5 5583 1.2 + 31250 0.0001815 0.00000035 172.19 12855.1 2755 0.2 + 31360 0.0001111 0.00000030 282.18 21073.9 4499 0.8 + 31500 0.0000978 0.00000030 322.06 24062.5 5112 1.0 + 31752 0.0001141 0.00000032 278.27 20807.4 4382 0.6 + 32000 0.0000862 0.00000029 371.20 27776.5 5800 1.0 + 32256 0.0000918 0.00000031 351.46 26319.7 5448 1.4 + 32400 0.0000946 0.00000030 342.53 25662.1 5286 1.6 + 32768 0.0000959 0.00000029 341.70 25627.9 5214 0.5 + 32805 0.0003406 0.00000032 96.32 7224.4 1468 0.2 + 32928 0.0001104 0.00000032 298.13 22370.2 4527 0.5 + 33075 0.0003220 0.00000032 102.73 7711.7 1553 0.2 + 33600 0.0001107 0.00000029 303.48 22815.5 4516 1.8 + 33614 0.0001914 0.00000032 175.60 13202.3 2612 0.0 + 33750 0.0001693 0.00000031 199.40 14997.1 2954 0.5 + 34020 0.0001344 0.00000031 253.11 19051.6 3720 1.0 + 34300 0.0001505 0.00000031 227.89 17166.8 3322 0.4 + 34560 0.0001178 0.00000030 293.35 22113.6 4244 1.9 + 34992 0.0001258 0.00000031 278.26 21001.0 3976 0.9 + 35000 0.0001276 0.00000032 274.19 20694.6 3917 0.7 + 35280 0.0001219 0.00000031 289.51 21867.3 4103 1.3 + 35721 0.0003934 0.00000033 90.80 6866.7 1271 0.1 + 35840 0.0001169 0.00000029 306.50 23185.9 4276 1.1 + 36000 0.0000960 0.00000029 375.05 28383.1 5209 1.7 + 36015 0.0003631 0.00000032 99.19 7506.5 1377 0.1 + 36288 0.0001219 0.00000031 297.71 22547.1 4102 1.5 + 36450 0.0002147 0.00000031 169.78 12864.2 2329 0.6 + 36750 0.0002094 0.00000031 175.52 13309.1 2388 0.4 + 36864 0.0001286 0.00000030 286.58 21737.0 3887 1.4 + 37044 0.0001786 0.00000032 207.37 15736.4 2799 0.4 + 37500 0.0001390 0.00000033 269.85 20501.3 3598 0.7 + 37632 0.0001412 0.00000032 266.59 20260.0 3542 1.0 + 37800 0.0001342 0.00000030 281.76 21422.4 3727 1.7 + 38400 0.0001153 0.00000029 333.16 25368.0 4338 1.8 + 38416 0.0001544 0.00000032 248.78 18944.0 3238 0.2 + 38880 0.0001337 0.00000030 290.82 22170.5 3740 1.8 + 39200 0.0001433 0.00000030 273.46 20863.0 3488 1.1 + 39366 0.0002812 0.00000033 139.99 10684.2 1778 0.2 + 39375 0.0004006 0.00000033 98.28 7501.2 1248 0.3 + 39690 0.0002349 0.00000032 169.00 12908.6 2129 0.5 + 40000 0.0001257 0.00000031 318.32 24331.9 3979 1.1 + 40320 0.0001305 0.00000031 308.93 23632.1 3831 2.4 + 40500 0.0001572 0.00000030 257.66 19718.3 3181 1.2 + 40824 0.0001836 0.00000032 222.41 17033.3 2724 1.0 + 40960 0.0001444 0.00000030 283.69 21733.3 3463 0.9 + 41160 0.0001686 0.00000031 244.16 18713.7 2966 0.8 + 41472 0.0001338 0.00000032 309.96 23773.8 3737 1.6 + 42000 0.0001414 0.00000030 297.02 22808.6 3536 1.7 + 42336 0.0001521 0.00000031 278.40 21394.6 3288 1.2 + 42525 0.0004352 0.00000032 97.72 7512.9 1149 0.4 + 42875 0.0004533 0.00000032 94.58 7277.1 1103 0.1 + 43008 0.0001397 0.00000031 307.85 23692.7 3579 1.3 + 43200 0.0001386 0.00000029 311.73 24001.3 3608 2.5 + 43218 0.0002734 0.00000033 158.09 12172.5 1829 0.2 + 43740 0.0001801 0.00000032 242.84 18719.3 2776 1.0 + 43750 0.0002565 0.00000034 170.54 13145.9 1949 0.3 + 43904 0.0001640 0.00000033 267.73 20644.5 3049 0.6 + 44100 0.0001684 0.00000031 261.95 20207.8 2970 1.2 + 44800 0.0001340 0.00000030 334.39 25833.4 3732 1.6 + 45000 0.0001526 0.00000031 294.93 22794.6 3277 1.5 + 45360 0.0001649 0.00000031 275.06 21274.9 3032 2.2 + 45927 0.0005208 0.00000033 88.18 6828.2 960 0.2 + 46080 0.0001412 0.00000029 326.34 25277.9 3541 2.3 + 46305 0.0004562 0.00000032 101.50 7865.7 1096 0.2 + 46656 0.0001729 0.00000031 269.86 20927.2 2892 1.6 + 46875 0.0004873 0.00000035 96.19 7462.5 1026 0.2 + 47040 0.0001553 0.00000030 302.84 23503.1 3219 1.6 + 47250 0.0002550 0.00000031 185.31 14387.8 1961 1.0 + 47628 0.0002223 0.00000033 214.23 16645.2 2249 0.7 + 48000 0.0001499 0.00000029 320.26 24901.1 3336 2.2 + 48020 0.0002190 0.00000032 219.26 17048.9 2283 0.4 + 48384 0.0001638 0.00000032 295.43 22988.0 3053 2.2 + 48600 0.0001913 0.00000030 254.08 19778.5 2614 1.9 + 49000 0.0001825 0.00000032 268.52 20918.4 2740 0.9 + 49152 0.0001710 0.00000031 287.44 22398.8 2924 1.1 + 49392 0.0002032 0.00000032 243.11 18952.6 2461 0.9 + 50000 0.0001707 0.00000033 292.90 22860.3 2929 0.9 + 50176 0.0001932 0.00000032 259.71 20276.6 2588 1.0 + 50400 0.0001728 0.00000030 291.72 22784.6 2894 2.9 + 50421 0.0006211 0.00000034 81.18 6340.7 805 0.1 + 50625 0.0005382 0.00000034 94.06 7349.7 929 0.3 + 51030 0.0003058 0.00000032 166.87 13048.3 1635 0.8 + 51200 0.0001645 0.00000028 311.19 24341.3 3039 1.4 + 51450 0.0003025 0.00000032 170.09 13310.6 1653 0.5 + 51840 0.0001724 0.00000030 300.78 23553.4 2901 2.8 + 52488 0.0002327 0.00000032 225.59 17686.2 2149 0.9 + 52500 0.0001996 0.00000032 263.02 20621.2 2505 1.2 + 52920 0.0002064 0.00000031 256.45 20120.5 2423 1.5 + 53760 0.0001695 0.00000030 317.18 24921.5 2950 2.6 + 54000 0.0001765 0.00000030 305.96 24049.8 2833 2.4 + 54432 0.0002042 0.00000032 266.50 20963.0 2448 1.9 + 54675 0.0005855 0.00000033 93.38 7348.7 854 0.4 + 54880 0.0002320 0.00000031 236.53 18619.9 2155 1.0 + 55125 0.0006090 0.00000033 90.52 7128.3 821 0.4 + 55296 0.0001832 0.00000031 301.81 23774.6 2729 1.9 + 55566 0.0003852 0.00000033 144.25 11368.2 1298 0.4 + 56000 0.0001928 0.00000030 290.53 22912.7 2594 1.9 + 56250 0.0003463 0.00000033 162.45 12817.0 1444 0.8 + 56448 0.0002130 0.00000033 264.97 20912.0 2347 2.1 + 56700 0.0002266 0.00000031 250.27 19760.4 2207 2.0 + 57344 0.0002083 0.00000031 275.25 21755.0 2400 1.0 + 57600 0.0001936 0.00000030 297.45 23518.8 2582 3.3 + 57624 0.0002451 0.00000032 235.11 18590.3 2040 0.5 + 58320 0.0002113 0.00000031 275.97 21845.4 2366 2.3 + 58800 0.0002016 0.00000031 291.65 23103.7 2480 2.0 + 59049 0.0006702 0.00000034 88.10 6981.8 746 0.1 + 59535 0.0006477 0.00000033 91.92 7290.1 772 0.3 + 60000 0.0002087 0.00000031 287.52 22818.6 2396 2.1 + 60025 0.0006242 0.00000033 96.16 7631.9 801 0.1 + 60480 0.0001962 0.00000031 308.33 24487.6 2549 3.6 + 60750 0.0003455 0.00000031 175.81 13968.7 1447 1.0 + 61236 0.0002616 0.00000033 234.04 18608.9 1911 1.0 + 61250 0.0003660 0.00000033 167.34 13305.2 1366 0.5 + 61440 0.0002035 0.00000031 301.92 24012.7 2457 2.3 + 61740 0.0002830 0.00000032 218.19 17361.2 1767 1.1 + 62208 0.0002234 0.00000032 278.44 22170.8 2238 2.4 + 62500 0.0002622 0.00000035 238.38 18988.4 1907 0.6 + 62720 0.0002109 0.00000031 297.42 23699.2 2371 1.6 + 63000 0.0002270 0.00000031 277.58 22127.2 2203 2.7 + 63504 0.0002682 0.00000032 236.74 18885.6 1864 1.6 + 64000 0.0002108 0.00000030 303.62 24237.3 2372 1.8 + 64512 0.0002236 0.00000032 288.50 23047.0 2236 2.6 + 64800 0.0002272 0.00000030 285.25 22796.7 2201 3.4 + 64827 0.0007764 0.00000034 83.50 6673.2 644 0.1 + 65536 0.0002420 0.00000030 270.79 21663.6 2066 1.1 + 65610 0.0004198 0.00000033 156.28 12503.9 1191 0.8 + 65625 0.0007321 0.00000034 89.64 7172.4 683 0.4 + 65856 0.0002538 0.00000033 259.47 20766.9 1970 1.2 + 66150 0.0003937 0.00000032 168.02 13453.0 1270 1.1 + 67200 0.0002390 0.00000031 281.16 22544.0 2092 3.6 + 67228 0.0003521 0.00000034 190.93 15309.3 1420 0.2 + 67500 0.0002573 0.00000032 262.30 21040.3 1943 1.8 + 68040 0.0002719 0.00000032 250.25 20087.8 1839 2.6 + 68600 0.0002825 0.00000032 242.84 19507.6 1770 1.0 + 69120 0.0002535 0.00000031 272.61 21913.4 1972 3.6 + 69984 0.0002955 0.00000032 236.83 19058.2 1692 2.1 + 70000 0.0002608 0.00000032 268.38 21598.0 1917 1.7 + 70560 0.0002518 0.00000031 280.26 22570.5 1986 2.6 + 70875 0.0007728 0.00000034 91.71 7388.8 647 0.7 + 71442 0.0004836 0.00000034 147.74 11911.3 1034 0.6 + 71680 0.0002611 0.00000031 274.53 22140.2 1915 2.1 + 72000 0.0002371 0.00000031 303.70 24501.8 2109 3.7 + 72030 0.0004730 0.00000032 152.27 12285.5 1057 0.5 + 72576 0.0002746 0.00000032 264.32 21340.3 1821 3.2 + 72900 0.0003010 0.00000032 242.17 19559.9 1661 2.1 + 73500 0.0002952 0.00000032 249.02 20127.5 1694 1.5 + 73728 0.0002459 0.00000033 299.78 24236.9 2033 2.4 + 74088 0.0003406 0.00000033 217.52 17594.2 1468 1.0 + 75000 0.0002815 0.00000034 266.40 21571.2 1776 1.9 + 75264 0.0003071 0.00000033 245.06 19849.4 1628 2.0 + 75600 0.0002843 0.00000031 265.96 21550.9 1759 4.0 + 76545 0.0008278 0.00000033 92.47 7500.9 604 0.5 + 76800 0.0002579 0.00000030 297.83 24167.2 1939 3.3 + 76832 0.0003425 0.00000034 224.35 18205.3 1460 0.7 + 77175 0.0008772 0.00000033 87.98 7142.1 570 0.4 + 77760 0.0002851 0.00000031 272.78 22159.1 1754 4.0 + 78125 0.0008929 0.00000037 87.50 7110.9 560 0.2 + 78400 0.0002887 0.00000031 271.58 22077.3 1732 2.6 + 78732 0.0003876 0.00000034 203.13 16519.1 1290 1.0 + 78750 0.0004845 0.00000033 162.54 13218.6 1032 1.5 + 79380 0.0003794 0.00000032 209.25 17028.9 1318 1.8 + 80000 0.0002595 0.00000032 308.32 25109.1 1927 2.3 + 80640 0.0002695 0.00000032 299.17 24381.5 1855 4.9 + 81000 0.0002902 0.00000031 279.13 22756.6 1723 3.1 + 81648 0.0003487 0.00000033 234.17 19104.6 1434 2.5 + 81920 0.0002927 0.00000031 279.84 22837.5 1708 1.8 + 82320 0.0003546 0.00000032 232.14 18953.2 1410 2.0 + 82944 0.0002941 0.00000033 282.01 23040.0 1700 3.3 + 83349 0.0010776 0.00000035 77.35 6322.0 464 0.2 + 84000 0.0002761 0.00000031 304.25 24884.6 1811 3.9 + 84035 0.0010799 0.00000034 77.82 6364.9 463 0.1 + 84375 0.0009542 0.00000035 88.43 7235.2 524 0.6 + 84672 0.0003272 0.00000032 258.76 21178.8 1528 2.7 + 85050 0.0005371 0.00000032 158.36 12966.8 931 1.8 + 85750 0.0005794 0.00000033 148.00 12127.4 863 0.5 + 86016 0.0003270 0.00000032 263.04 21558.9 1529 2.6 + 86400 0.0003056 0.00000030 282.70 23179.7 1636 5.1 + 86436 0.0004230 0.00000034 204.33 16754.8 1182 0.8 + 87480 0.0003959 0.00000032 220.97 18138.3 1263 2.7 + 87500 0.0003906 0.00000034 224.00 18387.0 1280 1.2 + 87808 0.0003658 0.00000034 240.07 19712.0 1367 1.2 + 88200 0.0003559 0.00000032 247.84 20358.4 1405 3.3 + 89600 0.0003139 0.00000030 285.47 23481.3 1593 3.1 + 90000 0.0003228 0.00000032 278.82 22943.6 1549 3.8 + 90720 0.0003501 0.00000031 259.10 21335.5 1428 5.0 + 91125 0.0010163 0.00000034 89.67 7386.6 492 0.6 + 91854 0.0006935 0.00000034 132.45 10918.8 721 0.8 + 91875 0.0010246 0.00000034 89.67 7392.1 488 0.5 + 92160 0.0003119 0.00000031 295.46 24363.8 1603 4.3 + 92610 0.0006135 0.00000033 150.95 12452.9 815 1.0 + 93312 0.0003674 0.00000032 254.00 20967.0 1361 3.6 + 93750 0.0006075 0.00000036 154.31 12743.5 823 1.0 + 94080 0.0003762 0.00000032 250.06 20657.3 1329 3.3 + 94500 0.0003925 0.00000032 240.79 19898.6 1274 3.3 + 95256 0.0004717 0.00000033 201.94 16700.2 1060 1.9 + 96000 0.0003344 0.00000031 287.04 23753.6 1495 4.2 + 96040 0.0004405 0.00000032 218.01 18041.9 1135 1.0 + 96768 0.0003720 0.00000033 260.11 21540.2 1344 4.2 + 97200 0.0003776 0.00000031 257.39 21322.7 1324 4.5 + 98000 0.0003858 0.00000032 254.02 21058.6 1296 2.1 + 98304 0.0003660 0.00000032 268.57 22270.8 1366 2.2 + 98415 0.0010823 0.00000034 90.94 7541.5 462 0.5 + 98784 0.0004003 0.00000033 246.76 20471.4 1249 2.0 + 99225 0.0011111 0.00000034 89.30 7411.4 450 0.7 + 100000 0.0003320 0.00000034 301.20 25014.1 1506 2.1 + 100352 0.0003808 0.00000033 263.52 21891.9 1313 2.2 + 100800 0.0003429 0.00000031 293.93 24427.5 1458 6.3 + 100842 0.0007576 0.00000034 133.11 11062.7 660 0.3 + 101250 0.0005741 0.00000032 176.38 14663.6 871 1.7 + 102060 0.0004831 0.00000033 211.26 17576.2 1035 2.9 + 102400 0.0003608 0.00000031 283.85 23622.0 1386 3.0 + 102900 0.0004634 0.00000032 222.06 18487.3 1079 1.8 + 103680 0.0003956 0.00000031 262.10 21835.5 1264 5.6 + 104976 0.0004263 0.00000033 246.27 20538.9 1173 2.7 + 105000 0.0004132 0.00000033 254.10 21192.0 1210 3.4 + 105840 0.0004006 0.00000032 264.18 22047.6 1248 3.5 + 107163 0.0014368 0.00000035 74.59 6231.4 348 0.4 + 107520 0.0003840 0.00000031 279.98 23398.4 1302 5.2 + 108000 0.0004019 0.00000031 268.70 22464.6 1244 5.5 + 108045 0.0012690 0.00000034 85.14 7118.2 394 0.4 + 108864 0.0004448 0.00000032 244.73 20474.0 1124 4.7 + 109350 0.0007174 0.00000033 152.43 12757.6 697 1.9 + 109375 0.0012346 0.00000037 88.59 7414.8 405 0.4 + 109760 0.0004244 0.00000033 258.59 21649.5 1178 2.0 + 110250 0.0007215 0.00000033 152.81 12797.9 693 1.7 + 110592 0.0003900 0.00000033 283.56 23754.9 1282 3.6 + 111132 0.0005814 0.00000034 191.15 16020.0 860 1.2 + 112000 0.0004263 0.00000031 262.75 22035.9 1173 3.8 + 112500 0.0004348 0.00000034 258.75 21708.6 1150 2.7 + 112896 0.0004333 0.00000033 260.56 21867.4 1154 4.6 + 113400 0.0004690 0.00000032 241.77 20297.8 1066 5.2 + 114688 0.0004708 0.00000032 243.60 20471.1 1062 2.0 + 115200 0.0003639 0.00000030 316.57 26613.7 1374 6.7 + 115248 0.0005507 0.00000034 209.29 17595.4 908 1.4 + 116640 0.0004570 0.00000032 255.21 21478.0 1094 5.3 + 117600 0.0004798 0.00000032 245.08 20639.9 1042 4.3 + 117649 0.0015432 0.00000035 76.24 6420.7 324 0.1 + 118098 0.0008913 0.00000035 132.51 11163.4 561 0.8 + 118125 0.0013889 0.00000034 85.05 7165.4 360 1.1 + 119070 0.0008052 0.00000033 147.88 12467.8 621 1.6 + 120000 0.0004550 0.00000032 263.76 22251.7 1099 4.7 + 120050 0.0008772 0.00000033 136.86 11546.1 570 0.7 + 120960 0.0004216 0.00000031 286.92 24221.8 1186 7.7 + 121500 0.0005176 0.00000032 234.74 19824.3 966 3.6 + 122472 0.0006173 0.00000034 198.40 16767.3 810 2.9 + 122500 0.0005727 0.00000034 213.88 18075.9 873 1.6 + 122880 0.0004325 0.00000032 284.10 24016.1 1156 4.4 + 123480 0.0005525 0.00000033 223.50 18901.2 905 2.8 + 124416 0.0004822 0.00000032 258.04 21836.3 1037 4.7 + 125000 0.0005263 0.00000036 237.50 20106.2 950 1.9 + 125440 0.0005035 0.00000032 249.12 21096.6 993 3.0 + 126000 0.0005102 0.00000032 246.96 20921.3 980 6.4 + 127008 0.0005727 0.00000034 221.76 18798.9 873 4.1 + 127575 0.0014706 0.00000035 86.75 7356.9 340 1.2 + 128000 0.0004270 0.00000031 299.78 25429.7 1171 3.5 + 128625 0.0014706 0.00000034 87.46 7422.6 340 0.6 + 129024 0.0004785 0.00000033 269.66 22890.5 1045 5.0 + 129600 0.0004604 0.00000031 281.49 23903.8 1086 7.9 + 129654 0.0009881 0.00000035 131.21 11142.5 506 0.7 + 131072 0.0004850 0.00000031 270.27 22973.0 1031 2.1 + 131220 0.0005945 0.00000033 220.71 18762.3 841 3.0 + 131250 0.0008945 0.00000035 146.74 12474.1 559 1.9 + 131712 0.0005371 0.00000034 245.25 20854.7 931 2.5 + 132300 0.0005974 0.00000032 221.47 18839.9 837 3.7 + 134400 0.0005051 0.00000031 266.11 22667.7 990 7.4 + 134456 0.0007184 0.00000034 187.16 15943.2 696 0.6 + 135000 0.0005531 0.00000032 244.08 20798.8 904 5.0 + 136080 0.0005599 0.00000032 243.04 20724.0 893 6.5 + 137200 0.0005325 0.00000032 257.66 21986.2 939 2.4 + 137781 0.0018587 0.00000035 74.13 6327.4 269 0.5 + 138240 0.0004965 0.00000032 278.42 23772.2 1007 7.1 + 138915 0.0016611 0.00000034 83.63 7143.3 301 0.6 + 139968 0.0005794 0.00000033 241.58 20649.1 863 4.8 + 140000 0.0005394 0.00000033 259.56 22186.0 927 3.8 + 140625 0.0016393 0.00000037 85.78 7334.9 305 0.8 + 141120 0.0005005 0.00000032 281.96 24116.6 999 5.8 + 141750 0.0009208 0.00000032 153.94 13171.9 543 3.1 + 142884 0.0007440 0.00000035 192.04 16442.6 672 2.1 + 143360 0.0005701 0.00000032 251.45 21536.1 877 4.1 + 144000 0.0005365 0.00000031 268.42 22997.5 932 7.8 + 144060 0.0007564 0.00000034 190.45 16317.8 661 2.0 + 145152 0.0006010 0.00000033 241.53 20708.1 832 6.6 + 145800 0.0006579 0.00000032 221.62 19007.6 760 5.8 + 147000 0.0005767 0.00000033 254.90 21877.2 867 3.7 + 147456 0.0005441 0.00000031 271.02 23267.3 919 4.9 + 148176 0.0006831 0.00000034 216.93 18631.0 732 2.6 + 150000 0.0005308 0.00000034 282.60 24296.0 942 4.7 + 150528 0.0005889 0.00000034 255.60 21980.9 849 3.9 + 151200 0.0005695 0.00000032 265.51 22841.7 878 9.1 + 151263 0.0019305 0.00000036 78.35 6741.1 259 0.3 + 151875 0.0017668 0.00000035 85.96 7398.1 283 1.1 + 153090 0.0010823 0.00000034 141.46 12182.1 462 2.5 + 153125 0.0017921 0.00000036 85.44 7358.6 279 0.5 + 153600 0.0005441 0.00000031 282.32 24319.9 919 6.5 + 153664 0.0007728 0.00000034 198.84 17129.6 647 1.9 + 154350 0.0009901 0.00000033 155.89 13434.8 505 2.1 + 155520 0.0006519 0.00000031 238.57 20572.6 767 8.3 + 156250 0.0011547 0.00000038 135.31 11673.1 433 0.9 + 156800 0.0005959 0.00000032 263.11 22704.5 839 5.5 + 157464 0.0007987 0.00000035 197.14 17018.2 626 3.0 + 157500 0.0006720 0.00000033 234.36 20231.1 744 5.0 + 158760 0.0007610 0.00000033 208.61 18020.3 657 4.7 + 160000 0.0005952 0.00000032 268.80 23234.7 840 4.7 + 161280 0.0006024 0.00000032 267.72 23157.1 830 9.5 + 162000 0.0006112 0.00000033 265.03 22932.7 818 7.5 + 163296 0.0007364 0.00000034 221.76 19200.9 679 5.9 + 163840 0.0005995 0.00000032 273.29 23669.1 834 3.6 + 164025 0.0019455 0.00000035 84.31 7302.6 257 1.1 + 164640 0.0007519 0.00000033 218.97 18972.7 665 4.2 + 165375 0.0019455 0.00000034 85.00 7367.8 257 1.2 + 165888 0.0006596 0.00000034 251.49 21803.7 758 6.6 + 166698 0.0012346 0.00000035 135.03 11711.3 405 1.0 + 168000 0.0006105 0.00000032 275.18 23883.4 819 8.6 + 168070 0.0013477 0.00000034 124.71 10823.8 371 0.7 + 168750 0.0011312 0.00000034 149.17 12951.8 442 2.8 + 169344 0.0007184 0.00000035 235.73 20472.4 696 5.7 + 170100 0.0007987 0.00000033 212.97 18502.4 626 6.1 + 171500 0.0009009 0.00000034 190.36 16550.2 555 1.9 + 172032 0.0007052 0.00000034 243.94 21213.5 709 5.2 + 172800 0.0006313 0.00000031 273.72 23811.5 792 10.5 + 172872 0.0008850 0.00000035 195.35 16994.4 565 2.3 + 174960 0.0008197 0.00000033 213.45 18588.0 610 7.1 + 175000 0.0007874 0.00000035 222.25 19354.6 635 3.4 + 175616 0.0007407 0.00000035 237.08 20652.3 675 2.4 + 176400 0.0006993 0.00000032 252.25 21981.9 715 8.1 + 177147 0.0024752 0.00000036 71.57 6238.7 202 0.4 + 178605 0.0022727 0.00000035 78.59 6855.2 220 1.0 + 179200 0.0006916 0.00000031 259.12 22610.1 723 6.1 + 180000 0.0007072 0.00000033 254.52 22216.6 707 8.8 + 180075 0.0022831 0.00000034 78.87 6884.9 219 0.8 + 181440 0.0007924 0.00000032 228.98 20000.2 631 11.4 + 182250 0.0012107 0.00000033 150.54 13153.7 413 3.4 + 183708 0.0010246 0.00000035 179.30 15677.1 488 3.2 + 183750 0.0012723 0.00000034 144.43 12628.3 393 2.4 + 184320 0.0007194 0.00000033 256.20 22407.5 695 8.7 + 185220 0.0008757 0.00000034 211.52 18506.9 571 3.5 + 186624 0.0007849 0.00000033 237.76 20815.5 637 7.8 + 187500 0.0008183 0.00000036 229.12 20067.4 611 3.5 + 188160 0.0007396 0.00000033 254.39 22286.8 676 6.5 + 189000 0.0008052 0.00000033 234.74 20572.5 621 8.8 + 190512 0.0008897 0.00000035 214.14 18779.2 562 4.7 + 192000 0.0007321 0.00000031 262.27 23015.3 683 8.3 + 192080 0.0008183 0.00000034 234.72 20598.4 611 2.5 + 193536 0.0007440 0.00000034 260.11 22840.8 672 8.3 + 194400 0.0007911 0.00000032 245.72 21585.0 632 10.3 + 194481 0.0026455 0.00000036 73.51 6457.9 189 0.5 + 196000 0.0008651 0.00000033 226.58 19916.6 578 4.7 + 196608 0.0008000 0.00000033 245.76 21608.4 625 4.6 + 196830 0.0014451 0.00000035 136.21 11977.0 346 2.5 + 196875 0.0024272 0.00000036 81.11 7132.6 206 1.6 + 197568 0.0009025 0.00000036 218.91 19254.9 554 4.6 + 198450 0.0013193 0.00000034 150.43 13236.2 379 3.5 + 200000 0.0006897 0.00000035 290.00 25534.0 725 4.8 + 200704 0.0008117 0.00000034 247.27 21777.7 616 4.5 + 201600 0.0008347 0.00000032 241.52 21279.0 599 13.2 + 201684 0.0011086 0.00000035 181.92 16028.6 451 1.3 + 202500 0.0008897 0.00000033 227.61 20061.0 562 5.9 + 204120 0.0010246 0.00000034 199.22 17570.4 488 8.0 + 204800 0.0008091 0.00000031 253.13 22331.2 618 6.0 + 205800 0.0009346 0.00000033 220.21 19434.2 535 4.9 + 207360 0.0008993 0.00000033 230.58 20362.6 556 11.8 + 209952 0.0010730 0.00000034 195.68 17297.4 466 7.1 + 210000 0.0008834 0.00000033 237.72 21014.5 566 8.4 + 211680 0.0010163 0.00000033 208.29 18425.1 492 8.2 + 212625 0.0026882 0.00000035 79.10 6999.2 186 2.2 + 214326 0.0018868 0.00000036 113.59 10058.3 265 1.8 + 214375 0.0026596 0.00000036 80.61 7137.5 188 0.6 + 215040 0.0008264 0.00000032 260.20 23046.1 605 10.3 + 216000 0.0008547 0.00000032 252.72 22391.8 585 11.9 + 216090 0.0015723 0.00000034 137.43 12177.5 318 2.2 + 217728 0.0009398 0.00000035 231.66 20539.4 532 10.0 + 218700 0.0010753 0.00000033 203.39 18039.4 465 6.3 + 218750 0.0015480 0.00000038 141.31 12533.7 323 1.8 + 219520 0.0010040 0.00000034 218.64 19397.9 498 4.2 + 220500 0.0010142 0.00000033 217.41 19295.9 493 5.8 + 221184 0.0008726 0.00000034 253.48 22502.3 573 7.5 + 222264 0.0011521 0.00000035 192.93 17133.6 434 3.4 + 224000 0.0008772 0.00000032 255.36 22692.7 570 7.7 + 225000 0.0009980 0.00000034 225.45 20042.0 501 7.4 + 225792 0.0009242 0.00000034 244.31 21724.5 541 9.3 + 226800 0.0009579 0.00000033 236.78 21062.8 522 12.9 + 229376 0.0009158 0.00000033 250.48 22301.8 546 4.0 + 229635 0.0029586 0.00000035 77.62 6911.4 169 1.6 + 230400 0.0008547 0.00000031 269.57 24010.1 585 13.1 + 230496 0.0011364 0.00000036 202.84 18067.0 440 3.4 + 231525 0.0028571 0.00000035 81.03 7220.4 175 1.4 + 233280 0.0010352 0.00000033 225.35 20091.7 483 11.8 + 234375 0.0029762 0.00000038 78.75 7023.9 168 1.1 + 235200 0.0010309 0.00000032 228.14 20354.5 485 10.0 + 235298 0.0020243 0.00000035 116.24 10370.8 247 0.4 + 236196 0.0013369 0.00000036 176.67 15767.9 374 3.2 + 236250 0.0015723 0.00000034 150.26 13410.2 318 5.1 + 238140 0.0012690 0.00000034 187.65 16758.9 394 5.2 + 240000 0.0009328 0.00000033 257.28 22991.4 536 10.3 + 240100 0.0012255 0.00000034 195.92 17508.8 408 2.5 + 241920 0.0009980 0.00000034 242.40 21676.0 501 15.7 + 243000 0.0011038 0.00000033 220.16 19693.8 453 9.7 + 244944 0.0012165 0.00000035 201.34 18022.4 411 7.6 + 245000 0.0011416 0.00000035 214.62 19211.1 438 4.8 + 245760 0.0009940 0.00000032 247.23 22136.0 503 8.9 + 246960 0.0011416 0.00000034 216.34 19377.2 438 6.7 + 248832 0.0010040 0.00000034 247.84 22212.1 498 9.7 + 250000 0.0009921 0.00000037 252.00 22593.8 504 4.9 + 250047 0.0032895 0.00000036 76.01 6815.4 152 0.7 + 250880 0.0010593 0.00000033 236.83 21239.7 472 6.0 + 252000 0.0010417 0.00000032 241.92 21703.9 480 14.5 + 252105 0.0031056 0.00000035 81.18 7283.1 161 0.7 + 253125 0.0030303 0.00000037 83.53 7496.7 165 1.8 + 254016 0.0011494 0.00000034 220.99 19839.2 435 9.7 + 255150 0.0018315 0.00000034 139.31 12510.9 273 5.6 + 256000 0.0010163 0.00000031 251.90 22628.3 492 7.0 + 257250 0.0018450 0.00000034 139.43 12529.7 271 2.8 + 258048 0.0010482 0.00000034 246.18 22128.0 477 9.7 + 259200 0.0011013 0.00000032 235.35 21162.7 454 16.6 + 259308 0.0014663 0.00000035 176.85 15902.4 341 2.5 + 262144 0.0011442 0.00000032 229.11 20620.2 437 4.6 + 262440 0.0013850 0.00000034 189.48 17054.9 361 8.6 + 262500 0.0013193 0.00000035 198.97 17909.7 379 6.7 + 263424 0.0012019 0.00000035 219.17 19732.9 416 5.1 + 264600 0.0012953 0.00000033 204.27 18398.1 386 9.8 + 268800 0.0010776 0.00000032 249.45 22495.3 464 14.6 + 268912 0.0014409 0.00000035 186.62 16830.6 347 1.8 + 270000 0.0010730 0.00000033 251.64 22701.2 466 12.0 + 272160 0.0012690 0.00000034 214.46 19359.6 394 15.2 + 273375 0.0034247 0.00000035 79.83 7208.5 146 2.0 + 274400 0.0012107 0.00000033 226.65 20473.6 413 5.5 + 275562 0.0021930 0.00000036 125.66 11354.3 228 2.6 + 275625 0.0033784 0.00000036 81.58 7372.2 148 1.9 + 276480 0.0011261 0.00000033 245.51 22190.6 444 14.2 + 277830 0.0021645 0.00000035 128.36 11606.0 231 3.2 + 279936 0.0013514 0.00000036 207.15 18741.9 370 11.2 + 280000 0.0012469 0.00000034 224.56 20317.1 401 8.7 + 281250 0.0020000 0.00000036 140.62 12727.6 250 4.3 + 282240 0.0013587 0.00000034 207.73 18806.3 368 12.3 + 283500 0.0013699 0.00000034 206.95 18742.9 365 10.5 + 285768 0.0044248 0.00000035 64.58 5852.7 113 0.3 + 286720 0.0011287 0.00000032 254.03 23027.3 443 8.1 + 288000 0.0011962 0.00000032 240.77 21832.5 418 16.0 + 288120 0.0014327 0.00000034 201.11 18236.8 349 5.4 + 290304 0.0013123 0.00000035 221.21 20071.9 381 13.3 + 291600 0.0038760 0.00000032 75.23 6828.7 129 0.6 + 294000 0.0011905 0.00000033 246.96 22430.7 420 9.1 + 294912 0.0033333 0.00000034 88.47 8037.8 150 0.9 + 295245 0.0039370 0.00000036 74.99 6813.6 127 1.5 + 296352 0.0013850 0.00000035 213.97 19446.3 361 6.0 + 297675 0.0037879 0.00000035 78.59 7144.8 132 2.4 + 300000 0.0012887 0.00000034 232.80 21178.5 388 10.7 + 300125 0.0037594 0.00000036 79.83 7262.9 133 0.8 + 301056 0.0014045 0.00000036 214.35 19505.7 356 7.9 + 302400 0.0013477 0.00000032 224.38 20425.5 371 20.9 + 302526 0.0025253 0.00000036 119.80 10905.8 198 1.6 + 303750 0.0020408 0.00000034 148.84 13553.5 245 5.4 + 306180 0.0016026 0.00000035 191.06 17409.1 312 9.1 + 306250 0.0023474 0.00000037 130.46 11888.0 213 2.4 + 307200 0.0011338 0.00000033 270.95 24695.5 441 13.4 + 307328 0.0040000 0.00000035 76.83 7003.0 125 0.7 + 308700 0.0016667 0.00000034 185.22 16888.2 300 7.0 + 311040 0.0013587 0.00000033 228.93 20885.7 368 17.3 + 312500 0.0015385 0.00000039 203.12 18538.7 325 3.4 + 313600 0.0037037 0.00000032 84.67 7729.9 135 1.1 + 314928 0.0016779 0.00000035 187.70 17141.1 298 8.2 + 315000 0.0015576 0.00000034 202.23 18468.6 321 13.3 + 317520 0.0015625 0.00000034 203.21 18570.1 320 11.5 + 320000 0.0036496 0.00000032 87.68 8017.3 137 0.8 + 321489 0.0042373 0.00000036 75.87 6940.1 118 1.1 + 322560 0.0012853 0.00000033 250.95 22961.1 389 19.4 + 324000 0.0013812 0.00000033 234.58 21470.3 362 17.2 + 324135 0.0040000 0.00000035 81.03 7417.1 125 1.4 + 326592 0.0016393 0.00000035 199.22 18245.8 305 13.9 + 327680 0.0014368 0.00000032 228.07 20893.0 348 7.5 + 328050 0.0024390 0.00000035 134.50 12322.6 205 5.8 + 328125 0.0043103 0.00000037 76.12 6974.5 116 2.1 + 329280 0.0016181 0.00000034 203.50 18649.3 309 9.4 + 330750 0.0023474 0.00000034 140.90 12917.2 213 5.6 + 331776 0.0037594 0.00000034 88.25 8092.7 133 1.4 + 333396 0.0020080 0.00000036 166.03 15230.8 249 3.6 + 336000 0.0015528 0.00000033 216.38 19862.0 322 18.6 + 336140 0.0017921 0.00000035 187.57 17217.4 279 2.6 + 337500 0.0015106 0.00000035 223.43 20515.5 331 9.5 + 338688 0.0014409 0.00000035 235.05 21588.8 347 12.2 + 340200 0.0017857 0.00000033 190.51 17504.3 280 16.5 + 343000 0.0018657 0.00000035 183.85 16902.8 268 5.0 + 344064 0.0015152 0.00000035 227.08 20882.8 330 10.4 + 345600 0.0014577 0.00000033 237.08 21810.0 343 20.6 + 345744 0.0048544 0.00000035 71.22 6552.3 103 0.4 + 349920 0.0016835 0.00000034 207.85 19139.8 297 16.1 + 350000 0.0015106 0.00000036 231.70 21336.1 331 8.4 + 351232 0.0017921 0.00000035 195.99 18052.5 279 4.8 + 352800 0.0045045 0.00000032 78.32 7216.7 111 0.9 + 352947 0.0054945 0.00000037 64.24 5919.1 91 0.5 + 354294 0.0030488 0.00000037 116.21 10711.3 164 2.5 + 354375 0.0043860 0.00000036 80.80 7447.5 114 3.6 + 357210 0.0027933 0.00000035 127.88 11794.7 179 4.9 + 358400 0.0015480 0.00000032 231.53 21359.7 323 12.3 + 360000 0.0042373 0.00000032 84.96 7840.8 118 1.3 + 360150 0.0028090 0.00000035 128.21 11833.0 178 3.8 + 362880 0.0016447 0.00000034 220.63 20374.3 304 24.0 + 364500 0.0017857 0.00000034 204.12 18856.2 280 11.3 + 367416 0.0021008 0.00000036 174.89 16166.0 238 9.2 + 367500 0.0018382 0.00000035 199.92 18480.0 272 8.1 + 368640 0.0017065 0.00000033 216.02 19973.3 293 17.3 + 370440 0.0020000 0.00000035 185.22 17131.8 250 9.2 + 373248 0.0047170 0.00000033 79.13 7323.3 106 1.1 + 375000 0.0019084 0.00000037 196.50 18192.5 262 9.9 + 376320 0.0017065 0.00000034 220.52 20422.2 293 13.1 + 378000 0.0015480 0.00000033 244.19 22621.6 323 21.7 + 381024 0.0019841 0.00000035 192.04 17801.3 252 11.4 + 382725 0.0049020 0.00000036 78.08 7240.0 102 3.7 + 384000 0.0016835 0.00000032 228.10 21156.8 297 17.3 + 384160 0.0019608 0.00000035 195.92 18173.0 255 6.2 + 385875 0.0051546 0.00000036 74.86 6946.2 97 2.3 + 387072 0.0017606 0.00000034 219.86 20405.2 284 16.9 + 388800 0.0017544 0.00000033 221.62 20575.6 285 23.5 + 388962 0.0034247 0.00000036 113.58 10545.2 146 2.3 + 390625 0.0053763 0.00000041 72.66 6748.1 93 0.9 + 392000 0.0018587 0.00000034 210.90 19592.8 269 10.8 + 393216 0.0018450 0.00000034 213.12 19804.4 271 9.4 + 393660 0.0024155 0.00000035 162.98 15145.8 207 9.5 + 393750 0.0029240 0.00000036 134.66 12514.8 171 7.9 + 395136 0.0019685 0.00000037 200.73 18659.8 254 10.0 + 396900 0.0071429 0.00000034 55.57 5167.2 70 0.2 + 400000 0.0017730 0.00000035 225.60 20991.7 282 10.8 + 401408 0.0048544 0.00000035 82.69 7696.3 103 1.0 + 403200 0.0019305 0.00000034 208.86 19445.8 259 27.4 + 403368 0.0023697 0.00000036 170.22 15849.1 211 4.0 + 405000 0.0058824 0.00000033 68.85 6412.5 85 0.5 + 408240 0.0020921 0.00000035 195.14 18186.0 239 20.1 + 409600 0.0046729 0.00000031 87.65 8171.1 107 1.5 + 411600 0.0019531 0.00000034 210.74 19652.4 256 11.5 + 413343 0.0058824 0.00000037 70.27 6555.0 85 1.6 + 414720 0.0020833 0.00000034 199.07 18574.6 240 23.0 + 416745 0.0053763 0.00000036 77.51 7235.5 93 2.0 + 419904 0.0053191 0.00000034 78.94 7373.1 94 1.4 + 420000 0.0020243 0.00000034 207.48 19378.7 247 19.5 + 420175 0.0053763 0.00000036 78.15 7299.7 93 1.0 + 421875 0.0055556 0.00000038 75.94 7095.0 90 3.0 + 423360 0.0021459 0.00000034 197.29 18437.9 233 17.9 + 425250 0.0034965 0.00000034 121.62 11370.4 143 10.1 + 428652 0.0027174 0.00000036 157.74 14756.5 184 6.7 + 428750 0.0035971 0.00000036 119.19 11150.3 139 3.0 + 430080 0.0020408 0.00000034 210.74 19719.1 245 21.2 + 432000 0.0018519 0.00000033 233.28 21835.8 270 26.2 + 432180 0.0025510 0.00000035 169.41 15858.3 196 7.8 + 435456 0.0022321 0.00000035 195.08 18271.8 224 21.1 + 437400 0.0023474 0.00000034 186.33 17458.0 213 18.5 + 437500 0.0026596 0.00000038 164.50 15412.8 188 6.4 + 439040 0.0021834 0.00000034 201.08 18845.2 229 8.8 + 441000 0.0024390 0.00000034 180.81 16951.3 205 15.4 + 442368 0.0021097 0.00000035 209.68 19662.9 237 15.7 + 444528 0.0024631 0.00000036 180.48 16930.6 203 8.8 + 448000 0.0021834 0.00000034 205.18 19259.7 229 16.3 + 450000 0.0021739 0.00000035 207.00 19436.9 230 18.9 + 451584 0.0056818 0.00000034 79.48 7464.9 88 1.6 + 453600 0.0022222 0.00000034 204.12 19178.2 225 29.8 + 453789 0.0071429 0.00000037 63.53 5969.2 70 1.1 + 455625 0.0062500 0.00000037 72.90 6851.7 80 3.6 + 458752 0.0021645 0.00000035 211.94 19930.5 231 8.6 + 459270 0.0039683 0.00000036 115.74 10884.4 126 8.2 + 459375 0.0064103 0.00000037 71.66 6739.6 78 2.6 + 460800 0.0054945 0.00000032 83.87 7889.1 91 1.4 + 460992 0.0025773 0.00000037 178.86 16826.2 194 8.8 + 463050 0.0034014 0.00000035 136.14 12811.0 147 6.8 + 466560 0.0025510 0.00000034 182.89 17220.8 196 26.9 + 468750 0.0041322 0.00000039 113.44 10684.9 121 5.7 + 470400 0.0023585 0.00000034 199.45 18791.7 212 21.5 + 470596 0.0092593 0.00000036 50.82 4788.7 54 0.0 + 472392 0.0078125 0.00000036 60.47 5698.8 64 0.5 + 472500 0.0026178 0.00000034 180.49 17011.6 191 17.4 + 476280 0.0029070 0.00000035 163.84 15451.3 172 14.5 + 480000 0.0022124 0.00000034 216.96 20473.1 226 22.2 + 480200 0.0074627 0.00000034 64.35 6072.2 67 0.3 + 483840 0.0023041 0.00000034 209.99 19827.1 217 33.2 + 486000 0.0025510 0.00000033 190.51 17994.4 196 24.6 + 489888 0.0027933 0.00000035 175.38 16575.2 179 19.5 + 490000 0.0067568 0.00000034 72.52 6854.0 74 0.8 + 491520 0.0024272 0.00000034 202.51 19143.8 206 18.9 + 492075 0.0067568 0.00000036 72.83 6885.3 74 3.8 + 493920 0.0029586 0.00000035 166.94 15787.9 169 16.3 + 496125 0.0070423 0.00000036 70.45 6664.7 71 4.1 + 497664 0.0027473 0.00000035 181.15 17141.1 182 20.0 + 500000 0.0062500 0.00000036 80.00 7572.6 80 0.9 + 500094 0.0045045 0.00000037 111.02 10509.1 111 3.5 + 501760 0.0026882 0.00000035 186.65 17673.1 186 13.0 + 504000 0.0028409 0.00000034 177.41 16803.3 176 35.1 + 504210 0.0049020 0.00000036 102.86 9742.6 102 4.6 + 506250 0.0043860 0.00000035 115.42 10936.2 114 10.0 + 508032 0.0068493 0.00000035 74.17 7029.6 73 1.3 + 510300 0.0033784 0.00000035 151.05 14320.2 148 21.4 + 512000 0.0028902 0.00000032 177.15 16799.1 173 16.2 + 514500 0.0034722 0.00000035 148.18 14056.6 144 10.4 + 516096 0.0026738 0.00000036 193.02 18315.0 187 22.2 + 518400 0.0064103 0.00000032 80.87 7676.1 78 2.0 + 518616 0.0034014 0.00000036 152.47 14473.0 147 7.6 + 524288 0.0065789 0.00000034 79.69 7570.7 76 1.3 + 524880 0.0030120 0.00000035 174.26 16556.1 166 30.2 + 525000 0.0029940 0.00000037 175.35 16660.0 167 25.0 + 526848 0.0028571 0.00000037 184.40 17524.2 175 14.6 + 529200 0.0029762 0.00000034 177.81 16904.0 168 35.0 + 531441 0.0083333 0.00000037 63.77 6064.7 60 1.4 + 535815 0.0079365 0.00000036 67.51 6424.3 63 3.3 + 537600 0.0028736 0.00000032 187.08 17806.9 174 40.5 + 537824 0.0034722 0.00000037 154.89 14743.3 144 7.3 + 540000 0.0027174 0.00000033 198.72 18920.7 184 38.1 + 540225 0.0080645 0.00000036 66.99 6378.3 62 3.2 + 544320 0.0031646 0.00000035 172.01 16387.0 158 46.7 + 546750 0.0048544 0.00000035 112.63 10734.0 103 13.6 + 546875 0.0080645 0.00000040 67.81 6462.8 62 2.0 + 548800 0.0031447 0.00000035 174.52 16636.8 159 18.4 + 551124 0.0040323 0.00000037 136.68 13033.7 124 13.5 + 551250 0.0047619 0.00000035 115.76 11039.3 105 13.0 + 552960 0.0028409 0.00000034 194.64 18565.7 176 39.2 + 555660 0.0038760 0.00000036 143.36 13679.3 129 14.5 + 559872 0.0032468 0.00000035 172.44 16463.5 154 32.8 + 560000 0.0030675 0.00000035 182.56 17430.0 163 28.6 + 562500 0.0101562 0.00000036 55.38 5289.6 50 0.1 + 564480 0.0031847 0.00000036 177.25 16932.9 157 40.6 + 567000 0.0036232 0.00000034 156.49 14955.1 138 38.5 + 571536 0.0086207 0.00000035 66.30 6339.6 58 1.0 + 573440 0.0032258 0.00000034 177.77 17002.7 155 24.9 + 576000 0.0029586 0.00000033 194.69 18627.5 169 44.6 + 576240 0.0039370 0.00000035 146.36 14004.4 127 19.0 + 580608 0.0034965 0.00000036 166.05 15897.3 143 37.0 + 583200 0.0078125 0.00000033 74.65 7149.1 64 1.3 + 583443 0.0102041 0.00000038 57.18 5475.9 49 1.6 + 588000 0.0034247 0.00000034 171.70 16453.2 146 33.3 + 588245 0.0102041 0.00000037 57.65 5524.4 49 1.0 + 589824 0.0072464 0.00000036 81.40 7801.7 69 2.1 + 590490 0.0058140 0.00000036 101.56 9735.7 86 10.9 + 590625 0.0090909 0.00000037 64.97 6227.9 55 6.2 + 592704 0.0039683 0.00000035 149.36 14321.5 126 20.2 + 595350 0.0054348 0.00000035 109.54 10507.2 92 15.8 + 600000 0.0033784 0.00000036 177.60 17044.8 148 35.0 + 600250 0.0058140 0.00000036 103.24 9908.9 86 5.4 + 602112 0.0033557 0.00000038 179.43 17224.9 149 27.3 + 604800 0.0031447 0.00000034 192.33 18469.2 159 60.8 + 605052 0.0051020 0.00000037 118.59 11388.6 98 8.2 + 607500 0.0039370 0.00000035 154.30 14822.9 127 25.8 + 612360 0.0043478 0.00000036 140.84 13537.8 115 37.2 + 612500 0.0048077 0.00000038 127.40 12245.9 104 14.2 + 614400 0.0038760 0.00000032 158.52 15240.3 129 41.0 + 614656 0.0086207 0.00000035 71.30 6855.3 58 1.9 + 617400 0.0049020 0.00000035 125.95 12113.7 102 33.9 + 622080 0.0038462 0.00000034 161.74 15564.9 130 52.0 + 625000 0.0042017 0.00000040 148.75 14319.8 119 15.7 + 627200 0.0075758 0.00000032 82.79 7972.1 66 1.6 + 629856 0.0044248 0.00000036 142.35 13711.4 113 31.6 + 630000 0.0038462 0.00000034 163.80 15778.0 130 44.8 + 635040 0.0040650 0.00000035 156.22 15056.8 123 42.4 + 637875 0.0098039 0.00000037 65.06 6273.0 51 6.9 + 640000 0.0078125 0.00000033 81.92 7900.2 64 2.1 + 642978 0.0071429 0.00000037 90.02 8684.1 70 7.9 + 643125 0.0104167 0.00000037 61.74 5956.3 48 3.3 + 645120 0.0038760 0.00000034 166.44 16060.9 129 54.2 + 648000 0.0038760 0.00000033 167.18 16138.0 129 54.4 + 648270 0.0066667 0.00000036 97.24 9386.7 75 10.0 + 653184 0.0040650 0.00000035 160.68 15519.7 123 45.2 + 655360 0.0039370 0.00000033 166.46 16081.8 127 24.7 + 656100 0.0123857 0.00000034 52.97 5118.1 41 0.2 + 656250 0.0065789 0.00000038 99.75 9637.8 76 14.5 + 658560 0.0041667 0.00000036 158.05 15275.1 120 29.4 + 661500 0.0045045 0.00000035 146.85 14197.3 111 24.0 + 663552 0.0083333 0.00000034 79.63 7699.8 60 1.9 + 666792 0.0051020 0.00000037 130.69 12642.3 98 14.8 + 672000 0.0038462 0.00000034 174.72 16911.2 130 55.8 + 672280 0.0049020 0.00000035 137.15 13274.8 102 12.2 + 675000 0.0045045 0.00000036 149.85 14508.9 111 37.3 + 677376 0.0042735 0.00000037 158.51 15351.0 117 43.4 + 680400 0.0045455 0.00000035 149.69 14501.8 110 56.6 + 686000 0.0044643 0.00000036 153.66 14896.1 112 18.5 + 688128 0.0046729 0.00000036 147.26 14278.5 107 32.0 + 688905 0.0111111 0.00000037 62.00 6012.3 45 5.9 + 691200 0.0040984 0.00000032 168.65 16358.3 122 64.1 + 691488 0.0100000 0.00000036 69.15 6707.2 50 1.2 + 694575 0.0121951 0.00000036 56.96 5526.3 41 5.5 + 699840 0.0045455 0.00000035 153.96 14947.4 110 55.2 + 700000 0.0039370 0.00000037 177.80 17261.7 127 31.8 + 702464 0.0050000 0.00000037 140.49 13643.3 100 22.4 + 703125 0.0113636 0.00000040 61.87 6009.1 44 5.0 + 705600 0.0089286 0.00000033 79.03 7676.9 56 2.3 + 705894 0.0078125 0.00000038 90.35 8777.5 64 3.8 + 708588 0.0064935 0.00000037 109.12 10603.8 77 14.4 + 708750 0.0063291 0.00000035 111.98 10881.9 79 22.8 + 714420 0.0056818 0.00000036 125.74 12225.8 88 25.6 + 716800 0.0044643 0.00000034 160.56 15615.7 112 38.3 + 720000 0.0089286 0.00000033 80.64 7845.3 56 1.8 + 720300 0.0055556 0.00000035 129.65 12614.2 90 18.8 + 725760 0.0045455 0.00000035 159.67 15542.9 110 71.2 + 729000 0.0049020 0.00000035 148.72 14481.6 102 45.8 + 734832 0.0056180 0.00000036 130.80 12744.5 89 35.9 + 735000 0.0050000 0.00000036 147.00 14323.2 100 34.6 + 737280 0.0044643 0.00000034 165.15 16095.5 112 52.3 + 740880 0.0052632 0.00000035 140.77 13724.0 95 32.9 + 746496 0.0095814 0.00000034 77.91 7600.2 53 2.7 + 750000 0.0045872 0.00000038 163.50 15954.8 109 37.7 + 750141 0.0135135 0.00000038 55.51 5416.9 37 2.3 + 752640 0.0045455 0.00000034 165.58 16162.0 110 39.9 + 756000 0.0052632 0.00000034 143.64 14025.0 95 71.9 + 756315 0.0125000 0.00000037 60.51 5907.9 40 3.7 + 759375 0.0123857 0.00000038 61.31 5988.4 41 6.4 + 762048 0.0053191 0.00000036 143.27 13996.7 94 46.2 + 765450 0.0080645 0.00000036 94.92 9276.1 62 25.5 + 765625 0.0125000 0.00000039 61.25 5986.0 40 2.8 + 768000 0.0046296 0.00000034 165.89 16216.2 108 53.1 + 768320 0.0053191 0.00000036 144.44 14120.4 94 24.4 + 771750 0.0074627 0.00000036 103.41 10112.8 67 15.4 + 774144 0.0053191 0.00000038 145.54 14235.4 94 52.1 + 777600 0.0049020 0.00000034 158.63 15520.9 102 75.2 + 777924 0.0151515 0.00000038 51.34 5023.7 33 0.2 + 781250 0.0083333 0.00000042 93.75 9176.0 60 8.0 + 784000 0.0049505 0.00000035 158.37 15504.6 101 44.4 + 786432 0.0056180 0.00000034 139.98 13708.0 89 32.7 + 787320 0.0063291 0.00000036 124.40 12182.5 79 53.6 + 787500 0.0052083 0.00000037 151.20 14807.7 96 48.4 + 790272 0.0057471 0.00000037 137.51 13470.2 87 38.7 + 793800 0.0121951 0.00000034 65.09 6378.5 41 0.8 + 800000 0.0046296 0.00000036 172.80 16942.7 108 38.2 + 802816 0.0105794 0.00000036 75.88 7442.3 48 2.7 + 806400 0.0051546 0.00000035 156.44 15347.8 97 96.8 + 806736 0.0060241 0.00000037 133.92 13138.5 83 21.2 + 810000 0.0115412 0.00000034 70.18 6887.6 44 1.4 + 816480 0.0054945 0.00000036 148.60 14591.8 91 87.4 + 819200 0.0100000 0.00000032 81.92 8046.1 50 2.0 + 820125 0.0130208 0.00000037 62.99 6186.9 39 11.8 + 823200 0.0056818 0.00000035 144.88 14235.4 88 48.5 + 823543 0.0156250 0.00000038 52.71 5178.8 32 0.5 + 826686 0.0092593 0.00000038 89.28 8775.1 54 17.1 + 826875 0.0137247 0.00000037 60.25 5921.5 37 12.4 + 829440 0.0043860 0.00000035 189.11 18591.4 114 84.1 + 833490 0.0094340 0.00000037 88.35 8688.7 53 19.6 + 839808 0.0108696 0.00000035 77.26 7602.5 46 2.1 + 840000 0.0050505 0.00000036 166.32 16365.9 99 80.7 + 840350 0.0094340 0.00000036 89.08 8765.5 53 8.5 + 843750 0.0090909 0.00000037 92.81 9135.7 55 30.3 + 846720 0.0058140 0.00000035 145.64 14339.0 86 94.6 + 850500 0.0065789 0.00000035 129.28 12732.4 76 64.3 + 857304 0.0081967 0.00000037 104.59 10307.2 61 29.9 + 857500 0.0064935 0.00000038 132.05 13013.9 77 16.3 + 860160 0.0056180 0.00000035 153.11 15092.1 89 78.0 + 864000 0.0050505 0.00000034 171.07 16868.3 99 100.0 + 864360 0.0067568 0.00000036 127.93 12614.2 74 41.7 + 870912 0.0061728 0.00000038 141.09 13919.8 81 79.8 + 874800 0.0066667 0.00000036 131.22 12950.5 75 62.6 + 875000 0.0064935 0.00000039 134.75 13299.1 77 29.9 + 878080 0.0059524 0.00000036 147.52 14562.9 84 32.2 + 882000 0.0063291 0.00000036 139.36 13761.7 79 80.4 + 884736 0.0059524 0.00000034 148.64 14681.4 84 47.3 + 885735 0.0151515 0.00000037 58.46 5774.7 33 9.3 + 889056 0.0060976 0.00000037 145.81 14406.9 82 52.2 + 893025 0.0147059 0.00000037 60.73 6002.2 34 14.5 + 896000 0.0057471 0.00000034 155.90 15413.6 87 56.3 + 900000 0.0057471 0.00000037 156.60 15487.4 87 84.6 + 900375 0.0147059 0.00000037 61.23 6055.3 34 6.8 + 903168 0.0116279 0.00000035 77.67 7683.6 43 2.5 + 907200 0.0058824 0.00000034 154.22 15261.3 85 127.4 + 907578 0.0100000 0.00000038 90.76 8981.2 50 11.8 + 911250 0.0084746 0.00000035 107.53 10643.9 59 35.0 + 917504 0.0071429 0.00000036 128.45 12721.3 70 32.9 + 918540 0.0080645 0.00000037 113.90 11281.1 62 56.5 + 918750 0.0098039 0.00000038 93.71 9281.9 51 25.8 + 921600 0.0125000 0.00000032 73.73 7304.2 40 3.7 + 921984 0.0072464 0.00000037 127.23 12605.3 69 33.2 + 926100 0.0076923 0.00000036 120.39 11931.4 65 50.9 + 933120 0.0072464 0.00000035 128.77 12768.7 69 105.8 + 937500 0.0067568 0.00000040 138.75 13762.9 74 40.1 + 940800 0.0064935 0.00000034 144.88 14375.0 77 74.4 + 941192 0.0166667 0.00000037 56.47 5603.1 30 0.6 + 944784 0.0156250 0.00000036 60.47 6001.2 32 1.7 + 945000 0.0070423 0.00000037 134.19 13318.3 71 89.3 + 952560 0.0080645 0.00000036 118.12 11729.9 62 76.4 + 960000 0.0061728 0.00000034 155.52 15453.0 81 73.5 + 960400 0.0145089 0.00000035 66.19 6577.4 35 1.3 + 964467 0.0175108 0.00000038 55.08 5474.6 29 7.6 + 967680 0.0063291 0.00000037 152.89 15200.8 79 122.8 + 972000 0.0060976 0.00000036 159.41 15853.6 82 105.1 + 972405 0.0158691 0.00000037 61.28 6094.3 32 8.5 + 979776 0.0081967 0.00000037 119.53 11894.8 61 91.3 + 980000 0.0151515 0.00000035 64.68 6436.4 33 2.1 + 983040 0.0064935 0.00000034 151.39 15068.3 77 77.4 + 984150 0.0100000 0.00000037 98.42 9796.5 50 39.2 + 984375 0.0175108 0.00000039 56.22 5595.9 29 15.5 + 987840 0.0074627 0.00000036 132.37 13180.1 67 71.9 + 992250 0.0108696 0.00000035 91.29 9092.3 46 38.5 + 995328 0.0074627 0.00000036 133.37 13287.3 67 61.5 + 1000000 0.0138889 0.00000037 72.00 7175.4 36 2.9 + 1000188 0.0089286 0.00000038 112.02 11163.9 56 25.9 + 1003520 0.0075758 0.00000035 132.46 13204.5 66 54.9 + 1008000 0.0063291 0.00000035 159.26 15881.1 79 137.3 + 1008420 0.0081967 0.00000037 123.03 12268.1 61 32.0 + 1012500 0.0074627 0.00000037 135.68 13533.2 67 64.0 + 1016064 0.0131579 0.00000035 77.22 7704.5 38 3.6 + 1020600 0.0080645 0.00000036 126.55 12630.8 62 105.2 + 1024000 0.0069444 0.00000034 147.46 14720.4 72 54.8 + 1029000 0.0080645 0.00000037 127.60 12742.3 62 52.0 + 1032192 0.0078125 0.00000037 132.12 13197.0 64 83.7 + 1036800 0.0135135 0.00000033 76.72 7666.1 37 3.0 + 1037232 0.0094340 0.00000037 109.95 10986.0 53 31.1 + 1048576 0.0137247 0.00000035 76.40 7640.1 37 3.4 + 1049760 0.0074627 0.00000036 140.67 14067.9 67 143.2 + 1050000 0.0072464 0.00000037 144.90 14491.4 69 117.2 + 1053696 0.0080645 0.00000036 130.66 13070.4 62 77.1 + 1058400 0.0081967 0.00000036 129.12 12921.2 61 131.8 + 1058841 0.0217391 0.00000039 48.71 4874.1 23 4.5 + 1062882 0.0137247 0.00000038 77.44 7751.9 37 18.0 + 1063125 0.0190972 0.00000038 55.67 5572.4 27 20.3 + 1071630 0.0128205 0.00000037 83.59 8371.8 39 35.9 + 1071875 0.0211589 0.00000038 50.66 5073.9 24 4.0 + 1075200 0.0068493 0.00000035 156.98 15726.3 73 169.5 + 1075648 0.0087719 0.00000037 122.62 12284.9 57 36.5 + 1080000 0.0072464 0.00000036 149.04 14935.7 69 139.4 + 1080450 0.0119048 0.00000037 90.76 9095.4 42 30.9 + 1088640 0.0084746 0.00000035 128.46 12880.7 59 202.7 + 1093500 0.0089090 0.00000036 122.74 12311.3 57 90.9 + 1093750 0.0121951 0.00000041 89.69 8996.0 41 16.4 + 1097600 0.0094340 0.00000035 116.35 11672.9 53 92.4 + 1102248 0.0101562 0.00000038 108.53 10892.0 50 80.5 + 1102500 0.0234375 0.00000035 47.04 4721.0 22 0.3 + 1105920 0.0074627 0.00000036 148.19 14876.2 67 163.9 + 1111320 0.0092593 0.00000037 120.02 12052.6 54 78.7 + 1119744 0.0079365 0.00000036 141.09 14175.6 63 117.2 + 1120000 0.0076923 0.00000035 145.60 14629.2 65 114.0 + 1125000 0.0185185 0.00000037 60.75 6105.8 27 1.1 + 1128960 0.0080645 0.00000035 139.99 14073.7 62 178.9 + 1134000 0.0076923 0.00000036 147.42 14825.3 65 182.7 + 1143072 0.0178571 0.00000036 64.01 6441.0 28 2.7 + 1146880 0.0081967 0.00000035 139.92 14082.4 61 101.2 + 1148175 0.0195312 0.00000037 58.79 5917.1 26 22.6 + 1152000 0.0069444 0.00000034 165.89 16701.4 72 185.5 + 1152480 0.0096154 0.00000036 119.86 12067.5 52 101.1 + 1157625 0.0230824 0.00000037 50.15 5051.0 22 14.8 + 1161216 0.0081967 0.00000038 141.67 14271.1 61 156.0 + 1166400 0.0158691 0.00000034 73.50 7406.6 32 3.9 + 1166886 0.0135135 0.00000038 86.35 8701.5 37 16.8 + 1171875 0.0227273 0.00000037 51.56 5197.6 22 10.7 + 1176000 0.0080645 0.00000036 145.82 14703.0 62 152.7 + 1176490 0.0163810 0.00000037 71.82 7241.7 31 9.6 + 1179648 0.0169271 0.00000036 69.69 7028.2 30 3.3 + 1180980 0.0106383 0.00000037 111.01 11196.4 47 76.8 + 1181250 0.0120908 0.00000037 97.70 9853.8 42 55.6 + 1185408 0.0096154 0.00000038 123.28 12437.3 52 92.8 + 1190700 0.0104167 0.00000038 114.31 11535.5 48 74.2 + 1200000 0.0074627 0.00000037 160.80 16236.5 67 156.7 + 1200500 0.0100000 0.00000037 120.05 12122.2 50 30.1 + 1204224 0.0086207 0.00000037 139.69 14108.5 58 102.8 + 1209600 0.0081967 0.00000035 147.57 14909.2 61 244.7 + 1210104 0.0108696 0.00000038 111.33 11248.0 46 48.7 + 1215000 0.0092593 0.00000037 131.22 13261.4 54 104.1 + 1224720 0.0092330 0.00000037 132.65 13413.2 55 173.4 + 1225000 0.0099571 0.00000038 123.03 12440.8 51 62.6 + 1228800 0.0084746 0.00000034 145.00 14665.7 59 138.1 + 1229312 0.0185185 0.00000038 66.38 6714.4 27 3.3 + 1234800 0.0102041 0.00000037 121.01 12243.7 49 138.3 + 1240029 0.0271382 0.00000038 45.69 4624.6 19 11.2 + 1244160 0.0087719 0.00000035 141.83 14358.4 57 205.7 + 1250000 0.0090909 0.00000040 137.50 13924.3 55 68.8 + 1250235 0.0217391 0.00000038 57.51 5824.1 23 12.4 + 1254400 0.0172414 0.00000033 72.76 7369.6 29 4.4 + 1259712 0.0103635 0.00000037 121.55 12316.1 49 119.4 + 1260000 0.0086207 0.00000037 146.16 14809.7 58 199.3 + 1260525 0.0234375 0.00000037 53.78 5449.7 22 10.6 + 1265625 0.0241815 0.00000039 52.34 5304.9 21 19.9 + 1270080 0.0098039 0.00000036 129.55 13133.9 51 205.3 + 1275750 0.0133635 0.00000036 95.47 9681.6 38 66.4 + 1280000 0.0177802 0.00000033 71.99 7302.6 29 3.4 + 1285956 0.0298713 0.00000038 43.05 4368.4 17 0.3 + 1286250 0.0141059 0.00000038 91.19 9252.9 36 31.3 + 1290240 0.0094340 0.00000036 136.77 13881.2 53 221.5 + 1296000 0.0087719 0.00000035 147.74 15000.2 57 231.8 + 1296540 0.0112847 0.00000037 114.89 11665.3 45 67.6 + 1306368 0.0098039 0.00000038 133.25 13536.2 51 192.3 + 1310720 0.0096154 0.00000035 136.31 13850.9 52 99.5 + 1312200 0.0238095 0.00000035 55.11 5600.4 21 1.4 + 1312500 0.0104167 0.00000039 126.00 12804.0 48 107.1 + 1317120 0.0099571 0.00000037 132.28 13445.5 51 153.0 + 1323000 0.0102041 0.00000035 129.65 13182.8 49 166.7 + 1327104 0.0177802 0.00000035 74.64 7590.8 29 5.1 + 1333584 0.0110394 0.00000038 120.80 12289.7 46 89.1 + 1344000 0.0090909 0.00000035 147.84 15048.7 55 252.8 + 1344560 0.0116279 0.00000037 115.63 11770.6 43 65.9 + 1350000 0.0089286 0.00000036 151.20 15395.6 56 204.1 + 1354752 0.0105794 0.00000037 128.06 13042.2 48 155.2 + 1360800 0.0103635 0.00000036 131.31 13377.5 49 275.1 + 1361367 0.0286458 0.00000040 47.52 4841.9 18 7.4 + 1366875 0.0217391 0.00000038 62.88 6407.9 23 29.5 + 1372000 0.0111111 0.00000037 123.48 12587.5 45 95.2 + 1376256 0.0104167 0.00000036 132.12 13471.2 48 141.5 + 1377810 0.0153883 0.00000038 89.54 9130.0 33 63.4 + 1378125 0.0224185 0.00000039 61.47 6268.5 23 28.9 + 1382400 0.0102041 0.00000034 135.48 13817.6 49 234.7 + 1382976 0.0211589 0.00000036 65.36 6666.7 24 3.8 + 1389150 0.0156250 0.00000037 88.91 9070.9 32 60.9 + 1399680 0.0090909 0.00000036 153.96 15717.2 55 263.5 + 1400000 0.0090909 0.00000038 154.00 15721.1 55 155.9 + 1404928 0.0111111 0.00000037 126.44 12911.2 45 84.3 + 1406250 0.0158691 0.00000040 88.62 9049.1 32 65.0 + 1411200 0.0217391 0.00000034 64.92 6630.6 23 4.0 + 1411788 0.0195312 0.00000039 72.28 7383.4 26 23.6 + 1417176 0.0158691 0.00000038 89.30 9124.4 32 66.0 + 1417500 0.0116279 0.00000036 121.90 12455.6 43 159.6 + 1428840 0.0119048 0.00000037 120.02 12270.2 42 132.1 + 1433600 0.0102041 0.00000035 140.49 14366.2 49 168.3 + 1440000 0.0195312 0.00000034 73.73 7541.5 26 4.9 + 1440600 0.0116279 0.00000037 123.89 12673.0 43 98.8 + 1451520 0.0104167 0.00000037 139.35 14261.5 48 308.0 + 1458000 0.0120908 0.00000037 120.59 12345.5 42 206.6 + 1469664 0.0125000 0.00000038 117.57 12043.6 40 181.6 + 1470000 0.0100000 0.00000036 147.00 15058.2 50 162.5 + 1474560 0.0104167 0.00000035 141.56 14503.9 48 215.0 + 1476225 0.0250000 0.00000038 59.05 6050.6 20 30.3 + 1481760 0.0106383 0.00000037 139.29 14276.0 47 165.4 + 1488375 0.0238095 0.00000038 62.51 6409.1 21 35.9 + 1492992 0.0224185 0.00000036 66.60 6829.4 23 4.4 + 1500000 0.0099571 0.00000038 150.65 15453.7 51 167.1 + 1500282 0.0195312 0.00000039 76.81 7879.9 26 23.7 + 1500625 0.0253906 0.00000038 59.10 6063.0 20 8.6 + 1505280 0.0111111 0.00000037 135.48 13900.8 45 219.1 + 1512000 0.0090909 0.00000035 166.32 17071.1 55 341.4 + 1512630 0.0195312 0.00000038 77.45 7949.4 26 45.3 + 1518750 0.0147059 0.00000036 103.28 10603.5 34 78.5 + 1524096 0.0125000 0.00000037 121.93 12521.7 40 173.3 + 1530900 0.0137247 0.00000037 111.54 11458.9 37 184.7 + 1531250 0.0172414 0.00000039 88.81 9123.8 29 33.2 + 1536000 0.0101562 0.00000035 151.24 15540.2 50 243.8 + 1536640 0.0126953 0.00000036 121.04 12437.7 40 104.4 + 1543500 0.0131579 0.00000037 117.31 12057.8 38 119.0 + 1548288 0.0137247 0.00000038 112.81 11598.2 37 213.8 + 1555200 0.0106383 0.00000036 146.19 15034.5 47 290.5 + 1555848 0.0312500 0.00000038 49.79 5120.4 16 1.6 + 1562500 0.0343750 0.00000041 45.45 4676.2 15 0.3 + 1568000 0.0115412 0.00000035 135.86 13980.4 44 171.8 + 1572864 0.0126953 0.00000035 123.89 12751.7 40 117.3 + 1574640 0.0121951 0.00000037 129.12 13290.8 41 302.7 + 1575000 0.0113636 0.00000038 138.60 14266.7 44 285.5 + 1580544 0.0125000 0.00000037 126.44 13018.6 40 208.8 + 1587600 0.0241815 0.00000035 65.65 6761.8 21 3.0 + 1594323 0.0322266 0.00000039 49.47 5096.8 16 9.3 + 1600000 0.0111111 0.00000037 144.00 14838.9 45 144.4 + 1605632 0.0241815 0.00000037 66.40 6844.0 21 4.4 + 1607445 0.0290799 0.00000038 55.28 5698.0 18 26.5 + 1612800 0.0108045 0.00000035 149.27 15390.7 47 444.1 + 1613472 0.0156250 0.00000038 103.26 10647.2 32 115.4 + 1620000 0.0271382 0.00000034 59.69 6156.8 19 3.7 + 1620675 0.0263158 0.00000038 61.59 6352.0 19 26.1 + 1632960 0.0121951 0.00000037 133.90 13818.1 41 437.2 + 1638400 0.0227273 0.00000033 72.09 7441.0 22 5.8 + 1640250 0.0178571 0.00000037 91.85 9481.9 28 120.1 + 1640625 0.0317383 0.00000039 51.69 5336.1 16 31.3 + 1646400 0.0130208 0.00000036 126.44 13055.9 39 277.5 + 1647086 0.0271382 0.00000038 60.69 6267.0 19 5.3 + 1653372 0.0195312 0.00000039 84.65 8743.3 26 116.8 + 1653750 0.0175108 0.00000036 94.44 9754.6 29 114.8 + 1658880 0.0120908 0.00000038 137.20 14174.2 42 365.9 + 1666980 0.0177802 0.00000038 93.75 9689.0 29 134.3 + 1679616 0.0234375 0.00000035 71.66 7409.9 22 5.9 + 1680000 0.0112847 0.00000036 148.87 15393.6 45 393.9 + 1680700 0.0151515 0.00000037 110.93 11470.1 33 57.1 + 1687500 0.0121951 0.00000038 138.38 14312.4 41 157.8 + 1693440 0.0126953 0.00000037 133.39 13800.3 40 425.5 + 1701000 0.0137247 0.00000036 123.94 12826.3 37 356.2 + 1714608 0.0166667 0.00000038 102.88 10652.6 30 126.9 + 1715000 0.0145089 0.00000038 118.20 12239.8 35 102.6 + 1720320 0.0131579 0.00000036 130.74 13541.3 38 360.0 + 1728000 0.0116279 0.00000035 148.61 15396.3 43 466.1 + 1728720 0.0166667 0.00000037 103.72 10746.4 30 216.3 + 1741824 0.0131579 0.00000037 132.38 13722.5 38 354.6 + 1749600 0.0125000 0.00000036 139.97 14513.7 40 275.6 + 1750000 0.0130208 0.00000040 134.40 13936.6 39 150.8 + 1750329 0.0390625 0.00000040 44.81 4646.5 13 10.2 + 1756160 0.0145089 0.00000037 121.04 12554.3 35 154.3 + 1764000 0.0126953 0.00000036 138.95 14416.2 40 357.5 + 1764735 0.0362723 0.00000039 48.65 5047.9 14 13.8 + 1769472 0.0138889 0.00000036 127.40 13221.1 36 171.2 + 1771470 0.0217391 0.00000039 81.49 8457.0 23 91.5 + 1771875 0.0303309 0.00000039 58.42 6062.9 17 49.7 + 1778112 0.0158691 0.00000037 112.05 11631.7 32 227.6 + 1786050 0.0206250 0.00000037 86.60 8992.3 25 133.6 + 1792000 0.0111111 0.00000036 161.28 16751.5 45 237.2 + 1800000 0.0113636 0.00000037 158.40 16457.4 44 371.9 + 1800750 0.0208333 0.00000037 86.44 8980.8 24 70.6 + 1806336 0.0261719 0.00000038 69.02 7172.6 20 6.9 + 1814400 0.0130208 0.00000035 139.35 14485.7 39 570.3 + 1815156 0.0211589 0.00000039 85.79 8918.3 24 80.1 + 1822500 0.0402644 0.00000036 45.26 4706.8 13 0.5 + 1835008 0.0156250 0.00000035 117.44 12218.1 32 127.0 + 1837080 0.0161290 0.00000037 113.90 11850.6 31 365.5 + 1837500 0.0142857 0.00000039 128.62 13383.0 35 202.6 + 1843200 0.0271382 0.00000033 67.92 7068.3 19 5.8 + 1843968 0.0156250 0.00000038 118.01 12281.9 32 154.0 + 1852200 0.0141059 0.00000036 131.31 13669.6 36 317.5 + 1866240 0.0138889 0.00000036 134.37 13995.7 36 449.0 + 1875000 0.0145089 0.00000041 129.23 13464.9 35 228.7 + 1881600 0.0135135 0.00000036 139.24 14511.1 37 329.6 + 1882384 0.0327148 0.00000038 57.54 5996.8 16 2.4 + 1889568 0.0348958 0.00000038 54.15 5644.9 15 4.4 + 1890000 0.0147059 0.00000036 128.52 13398.2 34 496.6 + 1905120 0.0147059 0.00000036 129.55 13512.8 34 454.9 + 1913625 0.0333333 0.00000038 57.41 5990.0 15 67.5 + 1920000 0.0131579 0.00000035 145.92 15228.7 38 275.9 + 1920800 0.0327148 0.00000035 58.71 6127.7 16 3.5 + 1928934 0.0234375 0.00000039 82.30 8592.0 22 76.0 + 1929375 0.0343750 0.00000039 56.13 5859.6 15 44.3 + 1935360 0.0138889 0.00000036 139.35 14550.6 36 589.3 + 1944000 0.0142857 0.00000035 136.08 14214.0 35 539.0 + 1944810 0.0217391 0.00000038 89.46 9344.8 23 97.2 + 1953125 0.0390625 0.00000040 50.00 5224.3 13 12.5 + 1959552 0.0153883 0.00000038 127.34 13308.4 33 455.0 + 1960000 0.0282118 0.00000036 69.47 7260.9 18 5.9 + 1966080 0.0158691 0.00000036 123.89 12951.1 32 366.4 + 1968300 0.0192308 0.00000038 102.35 10700.1 26 203.5 + 1968750 0.0211589 0.00000039 93.05 9727.4 24 166.9 + 1975680 0.0166667 0.00000036 118.54 12395.8 30 392.8 + 1984500 0.0172414 0.00000036 115.10 12039.8 29 266.4 + 1990656 0.0166667 0.00000039 119.44 12496.2 30 209.8 + 2000000 0.0317383 0.00000037 63.02 6595.1 16 4.7 + 2000376 0.0190972 0.00000039 104.75 10962.7 27 146.4 + 2007040 0.0145089 0.00000036 138.33 14481.0 35 228.5 + 2016000 0.0130208 0.00000035 154.83 16212.9 39 646.8 + 2016840 0.0184152 0.00000037 109.52 11468.8 28 206.9 + 2025000 0.0156250 0.00000038 129.60 13575.3 32 325.1 + 2032128 0.0307904 0.00000037 66.00 6914.9 17 5.9 + 2041200 0.0161290 0.00000037 126.55 13263.5 31 515.9 + 2048000 0.0156250 0.00000035 131.07 13740.1 32 190.0 + 2058000 0.0153883 0.00000036 133.74 14024.3 33 310.0 + 2064384 0.0166667 0.00000037 123.86 12991.5 30 357.0 + 2066715 0.0390625 0.00000039 52.91 5549.8 13 51.1 + 2073600 0.0307904 0.00000033 67.35 7065.8 17 8.2 + 2074464 0.0166667 0.00000038 124.47 13059.4 30 146.2 + 2083725 0.0368304 0.00000038 56.58 5937.9 14 55.6 + 2097152 0.0282118 0.00000036 74.34 7805.3 18 5.2 + 2099520 0.0166667 0.00000037 125.97 13228.0 30 599.6 + 2100000 0.0130208 0.00000037 161.28 16936.0 39 563.5 + 2100875 0.0373884 0.00000038 56.19 5900.7 14 18.1 + 2107392 0.0163810 0.00000038 128.65 13512.6 31 338.6 + 2109375 0.0408654 0.00000041 51.62 5422.0 13 48.2 + 2116800 0.0141059 0.00000035 150.06 15766.9 36 556.5 + 2117682 0.0267270 0.00000039 79.23 8325.1 19 47.7 + 2125764 0.0531250 0.00000038 40.01 4205.4 10 0.4 + 2126250 0.0220788 0.00000036 96.30 10121.4 23 204.7 + 2143260 0.0208333 0.00000038 102.88 10818.2 24 273.1 + 2143750 0.0263158 0.00000039 81.46 8566.5 19 51.8 + 2150400 0.0145089 0.00000035 148.21 15589.1 35 705.5 + 2151296 0.0208333 0.00000038 103.26 10861.5 24 141.2 + 2160000 0.0153883 0.00000036 140.37 14768.4 33 517.9 + 2160900 0.0507812 0.00000037 42.55 4477.3 10 0.3 + 2177280 0.0156250 0.00000036 139.35 14669.0 32 854.1 + 2187000 0.0192308 0.00000037 113.72 11975.4 26 466.5 + 2187500 0.0172414 0.00000042 126.88 13360.5 29 126.0 + 2195200 0.0188079 0.00000037 116.72 12293.8 27 325.2 + 2204496 0.0185185 0.00000038 119.04 12542.4 27 408.1 + 2205000 0.0436198 0.00000036 50.55 5326.1 12 2.2 + 2211840 0.0161290 0.00000037 137.13 14451.7 31 679.1 + 2222640 0.0188079 0.00000037 118.18 12458.0 27 431.2 + 2239488 0.0208333 0.00000038 107.50 11337.9 24 393.5 + 2240000 0.0158691 0.00000037 141.15 14888.3 32 420.8 + 2250000 0.0368304 0.00000037 61.09 6445.5 14 3.7 + 2250423 0.0449219 0.00000039 50.10 5285.6 12 21.9 + 2257920 0.0172414 0.00000036 130.96 13820.5 29 709.7 + 2268000 0.0166667 0.00000036 136.08 14365.3 30 826.2 + 2268945 0.0408654 0.00000038 55.52 5861.4 13 37.0 + 2278125 0.0416667 0.00000039 54.67 5773.5 12 53.5 + 2286144 0.0384615 0.00000037 59.44 6278.2 13 7.7 + 2293760 0.0172414 0.00000036 133.04 14055.0 29 407.4 + 2296350 0.0250000 0.00000038 91.85 9704.8 20 227.0 + 2296875 0.0429688 0.00000040 53.45 5647.8 12 54.6 + 2304000 0.0156250 0.00000035 147.46 15582.9 32 698.9 diff --git a/wsjtx_lib/lib/noisegen.f90 b/wsjtx_lib/lib/noisegen.f90 new file mode 100644 index 0000000..7716d4b --- /dev/null +++ b/wsjtx_lib/lib/noisegen.f90 @@ -0,0 +1,16 @@ +subroutine noisegen(d4,nmax) + + real*4 d4(4,nmax) + + call init_random_seed() ! seed Fortran RANDOM_NUMBER generator + call sgran() ! see C rand generator (used in gran) + + do i=1,nmax + d4(1,i)=gran() + d4(2,i)=gran() + d4(3,i)=gran() + d4(4,i)=gran() + enddo + + return +end subroutine noisegen diff --git a/wsjtx_lib/lib/nuttal_window.f90 b/wsjtx_lib/lib/nuttal_window.f90 new file mode 100644 index 0000000..aa813b1 --- /dev/null +++ b/wsjtx_lib/lib/nuttal_window.f90 @@ -0,0 +1,15 @@ +subroutine nuttal_window(win,n) + real win(n) + + pi=4.0*atan(1.0) + a0=0.3635819 + a1=-0.4891775; + a2=0.1365995; + a3=-0.0106411; + do i=1,n + win(i)=a0+a1*cos(2*pi*(i-1)/(n))+ & + a2*cos(4*pi*(i-1)/(n))+ & + a3*cos(6*pi*(i-1)/(n)) + enddo + return +end subroutine nuttal_window diff --git a/wsjtx_lib/lib/options.f90 b/wsjtx_lib/lib/options.f90 new file mode 100644 index 0000000..f12311e --- /dev/null +++ b/wsjtx_lib/lib/options.f90 @@ -0,0 +1,337 @@ +module options + ! + ! Source code copied from: + ! http://fortranwiki.org/fortran/show/Command-line+arguments + ! + implicit none + + type option + !> Long name. + character(len=100) :: name + !> Does the option require an argument? + logical :: has_arg + !> Corresponding short name. + character :: chr + !> Description. + character(len=500) :: descr + !> Argument name, if required. + character(len=20) :: argname + contains + procedure :: print => print_opt + end type option + +contains + + !> Parse command line options. Options and their arguments must come before + !> all non-option arguments. Short options have the form "-X", long options + !> have the form "--XXXX..." where "X" is any character. Parsing can be + !> stopped with the option '--'. + !> The following code snippet illustrates the intended use: + !> \code + !> do + !> call getopt (..., optchar=c, ...) + !> if (stat /= 0) then + !> ! optional error handling + !> exit + !> end if + !> select case (c) + !> ! process options + !> end select + !> end do + !> \endcode + subroutine getopt (options, longopts, optchar, optarg, arglen, stat, & + offset, remain, err) + use iso_fortran_env, only: error_unit + + !> String containing the characters that are valid short options. If + !> present, command line arguments are scanned for those options. + !> If a character is followed by a colon (:) its corresponding option + !> requires an argument. E.g. "vn:" defines two options -v and -n with -n + !> requiring an argument. + character(len=*), intent(in), optional :: options + + !> Array of long options. If present, options of the form '--XXXX...' are + !> recognised. Each option has an associated option character. This can be + !> any character of default kind, it is just an identifier. It can, but + !> doesn't have to, match any character in the options argument. In fact it + !> is possible to only pass long options and no short options at all. + !> Only name, has_arg and chr need to be set. + type(option), intent(in), optional :: longopts(:) + + !> If stat is not 1, optchar contains the option character that was parsed. + !> Otherwise its value is undefined. + character, intent(out), optional :: optchar + + !> If stat is 0 and the parsed option requires an argument, optarg contains + !> the first len(optarg) (but at most 500) characters of that argument. + !> Otherwise its value is undefined. If the arguments length exceeds 500 + !> characters and err is .true., a warning is issued. + character(len=*), intent(out), optional :: optarg + + !> If stat is 0 and the parsed option requires an argument, arglen contains + !> the actual length of that argument. Otherwise its value is undefined. + !> This can be used to make sure the argument was not truncated by the + !> limited length of optarg. + integer, intent(out), optional :: arglen + + !> Status indicator. Can have the following values: + !> - 0: An option was successfully parsed. + !> - 1: Parsing stopped successfully because a non-option or '--' was + !> encountered. + !> - -1: An unrecognised option was encountered. + !> - -2: A required argument was missing. + !> . + !> Its value is never undefined. + integer, intent(out), optional :: stat + + !> If stat is 1, offset contains the number of the argument before the + !> first non-option argument, i.e. offset+n is the nth non-option argument. + !> If stat is not 1, offset contains the number of the argument that would + !> be parsed in the next call to getopt. This number can be greater than + !> the actual number of arguments. + integer, intent(out), optional :: offset + + !> If stat is 1, remain contains the number of remaining non-option + !> arguments, i.e. the non-option arguments are in the range + !> (offset+1:offset+remain). If stat is not 1, remain is undefined. + integer, intent(out), optional :: remain + + !> If err is present and .true., getopt prints messages to the standard + !> error unit if an error is encountered (i.e. whenever stat would be set + !> to a negative value). + logical, intent(in), optional :: err + + integer, save :: pos = 1, cnt = 0 + character(len=500), save :: arg + + integer :: chrpos, length, st, id = 0 + character :: chr + logical :: long + + if (cnt == 0) cnt = command_argument_count() + long = .false. + + ! no more arguments left + if (pos > cnt) then + pos = pos - 1 + st = 1 + goto 10 + end if + + call get_command_argument (pos, arg, length) + + ! is argument an option? + if (arg(1:1) == '-') then + + chr = arg(2:2) + + ! too long ('-xxxx...') for one dash? + if (chr /= '-' .and. len_trim(arg) > 2) then + st = -1 + goto 10 + end if + + ! forced stop ('--') + if (chr == '-' .and. arg(3:3) == ' ') then + st = 1 + goto 10 + end if + + ! long option ('--xxx...') + if (chr == '-') then + + long = .true. + + ! check if valid + id = lookup(arg(3:)) + + ! option is invalid, stop + if (id == 0) then + st = -1 + goto 10 + end if + + chr = longopts(id)%chr + + ! check if option requires an argument + if (.not. longopts(id)%has_arg) then + st = 0 + goto 10 + end if + + ! check if there are still arguments left + if (pos == cnt) then + st = -2 + goto 10 + end if + + ! go to next position + pos = pos + 1 + + ! get argument + call get_command_argument (pos, arg, length) + + ! make sure it is not an option + if (arg(1:1) == '-') then + st = -2 + pos = pos - 1 + goto 10 + end if + + end if + + ! short option + ! check if valid + if (present(options)) then + chrpos = scan(options, chr) + else + chrpos = 0 + end if + + ! option is invalid, stop + if (chrpos == 0) then + st = -1 + goto 10 + end if + + ! look for argument requirement + if (chrpos < len_trim(options)) then + if (options(chrpos+1:chrpos+1) == ':') then + + ! check if there are still arguments left + if (pos == cnt) then + st = -2 + goto 10 + end if + + ! go to next position + pos = pos + 1 + + ! get argument + call get_command_argument (pos, arg, length) + + ! make sure it is not an option + if (arg(1:1) == '-') then + st = -2 + pos = pos - 1 + goto 10 + end if + + end if + end if + + ! if we get to this point, no error happened + ! return option and the argument (if there is one) + st = 0 + goto 10 + end if + + ! not an option, parsing stops + st = 1 + ! we are already at the first non-option argument + ! go one step back to the last option or option argument + pos = pos - 1 + + + ! error handling and setting of return values +10 continue + + if (present(err)) then + if (err) then + + select case (st) + case (-1) + write (error_unit, *) "error: unrecognised option: " // trim(arg) + case (-2) + if (.not. long) then + write (error_unit, *) "error: option -" // chr & + // " requires an argument" + else + write (error_unit, *) "error: option --" & + // trim(longopts(id)%name) // " requires an argument" + end if + end select + + end if + end if + + if (present(optchar)) optchar = chr + if (present(optarg)) optarg = arg + if (present(arglen)) arglen = length + if (present(stat)) stat = st + if (present(offset)) offset = pos + if (present(remain)) remain = cnt-pos + + ! setup pos for next call to getopt + pos = pos + 1 + + contains + + integer function lookup (name) + character(len=*), intent(in) :: name + integer :: i + + ! if there are no long options, skip the loop + if (.not. present(longopts)) goto 10 + + do i = 1, size(longopts) + if (name == longopts(i)%name) then + lookup = i + return + end if + end do + ! if we get to this point, the option was not found + +10 lookup = 0 + end function lookup + + end subroutine getopt + + !============================================================================ + + !> Print an option in the style of a man page. I.e. + !> \code + !> -o arg + !> --option arg + !> description................................................................. + !> ............................................................................ + !> \endcode + subroutine print_opt (opt, unit) + !> the option + class(option), intent(in) :: opt + !> logical unit number + integer, intent(in) :: unit + + integer :: l, c1, c2 + + if (opt%has_arg) then + write (unit, '(1x,"-",a,1x,a)') opt%chr, trim(opt%argname) + write (unit, '(1x,"--",a,1x,a)') trim(opt%name), trim(opt%argname) + else + write (unit, '(1x,"-",a)') opt%chr + write (unit, '(1x,"--",a)') trim(opt%name) + end if + l = len_trim(opt%descr) + + ! c1 is the first character of the line + ! c2 is one past the last character of the line + c1 = 1 + do + if (c1 > l) exit + ! print at maximum 4+76 = 80 characters + c2 = min(c1 + 76, 500) + ! if not at the end of the whole string + if (c2 /= 500) then + ! find the end of a word + do + if (opt%descr(c2:c2) == ' ') exit + c2 = c2-1 + end do + end if + write (unit, '(4x,a)') opt%descr(c1:c2-1) + c1 = c2+1 + end do + + end subroutine print_opt + +end module options diff --git a/wsjtx_lib/lib/osd128_90.f90 b/wsjtx_lib/lib/osd128_90.f90 new file mode 100644 index 0000000..75082bf --- /dev/null +++ b/wsjtx_lib/lib/osd128_90.f90 @@ -0,0 +1,375 @@ +subroutine osd128_90(llr,apmask,ndeep,message77,cw,nhardmin,dmin) + +! Ordered-statistics decoder for the (128,90) code. + + integer, parameter:: N=128, K=90, M=N-K + 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*1 message77(77) + integer indx(N) + real llr(N),rx(N),absrx(N) + + include "ldpc_128_90_generator.f90" + + 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,23 + read(g(i)(j:j),"(Z1)") istr + ibmax=4 + if(j.eq.23) ibmax=2 + do jj=1, ibmax + irow=(j-1)*4+jj + if( btest(istr,4-jj) ) gen(irow,K+i)=1 + enddo + enddo + enddo + do irow=1,K + gen(irow,irow)=1 + enddo + first=.false. + endif + + rx=llr + apmaskr=apmask + d1=0. + ntheta=0 + npre1=0 + npre2=0 + nt=0 + +! 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 columns of 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 mrbencode90(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=12 + ntheta=3 + elseif(ndeep.eq.2) then + nord=1 + npre1=1 + npre2=0 + nt=18 + ntheta=4 + elseif(ndeep.eq.3) then + nord=1 + npre1=1 + npre2=0 + nt=12 + ntheta=4 + elseif(ndeep.eq.4) then + nord=1 + npre1=1 + npre2=1 + nt=12 + ntheta=4 + ntau=15 + elseif(ndeep.eq.5) then + nord=1 + npre1=1 + npre2=1 + nt=12 + ntheta=4 + ntau=5 + 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 mrbencode90(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 mrbencode90(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 nextpat90(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 boxit90(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 mrbencode90(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 fetchit90(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 mrbencode90(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 nextpat90(misub,K,nord,iflag) + enddo + endif + +998 continue +! Re-order the codeword to [message bits][parity bits] format. + cw(indices)=cw + hdec(indices)=hdec + decoded=cw(1:K) + call chkcrc13a(decoded,nbadcrc) + message77=decoded(1:77) + if(nbadcrc.eq.1) nhardmin=-nhardmin + + return +end subroutine osd128_90 + +subroutine mrbencode90(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 mrbencode90 + +subroutine nextpat90(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 nextpat90 + +subroutine boxit90(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 boxit90 + +subroutine fetchit90(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 fetchit90 diff --git a/wsjtx_lib/lib/packjt.f90 b/wsjtx_lib/lib/packjt.f90 new file mode 100644 index 0000000..5557214 --- /dev/null +++ b/wsjtx_lib/lib/packjt.f90 @@ -0,0 +1,1033 @@ +module packjt + +! These variables are accessible from outside via "use packjt": + integer jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2 + character*6 jt_c1,jt_c2,jt_c3 + + contains + +subroutine packbits(dbits,nsymd,m0,sym) + + ! Pack 0s and 1s from dbits() into sym() with m0 bits per word. + ! NB: nsymd is the number of packed output words. + + integer sym(:) + integer*1 dbits(:) + + k=0 + do i=1,nsymd + n=0 + do j=1,m0 + k=k+1 + m=dbits(k) + n=ior(ishft(n,1),m) + enddo + sym(i)=n + enddo + + return + end subroutine packbits + + subroutine unpackbits(sym,nsymd,m0,dbits) + + ! Unpack bits from sym() into dbits(), one bit per byte. + ! NB: nsymd is the number of input words, and m0 their length. + ! there will be m0*nsymd output bytes, each 0 or 1. + + integer sym(:) + integer*1 dbits(:) + + k=0 + do i=1,nsymd + mask=ishft(1,m0-1) + do j=1,m0 + k=k+1 + dbits(k)=0 + if(iand(mask,sym(i)).ne.0) dbits(k)=1 + mask=ishft(mask,-1) + enddo + enddo + + return + end subroutine unpackbits + + subroutine packcall(callsign,ncall,text) + + ! Pack a valid callsign into a 28-bit integer. + + parameter (NBASE=37*36*10*27*27*27) + character callsign*6,c*1,tmp*6 + logical text + + text=.false. + + ! Work-around for Swaziland prefix: + if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6) + + ! Work-around for Guinea prefixes: + if(callsign(1:2).eq.'3X' .and. callsign(3:3).ge.'A' .and. & + callsign(3:3).le.'Z') callsign='Q'//callsign(3:6) + + if(callsign(1:3).eq.'CQ ') then + ncall=NBASE + 1 + if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. & + callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. & + callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then + read(callsign(4:6),*) nfreq + ncall=NBASE + 3 + nfreq + endif + return + else if(callsign(1:4).eq.'QRZ ') then + ncall=NBASE + 2 + return + else if(callsign(1:3).eq.'DE ') then + ncall=267796945 + return + endif + + tmp=' ' + if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then + tmp=callsign + else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then + if(callsign(6:6).ne.' ') then + text=.true. + return + endif + tmp=' '//callsign(:5) + else + text=.true. + return + endif + + do i=1,6 + c=tmp(i:i) + if(c.ge.'a' .and. c.le.'z') & + tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A')) + enddo + + n1=0 + if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1 + if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1 + n2=0 + if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1 + if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1 + n3=0 + if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1 + n4=0 + if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1 + n5=0 + if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1 + n6=0 + if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1 + + if(n1+n2+n3+n4+n5+n6 .ne. 6) then + text=.true. + return + endif + + ncall=nchar(tmp(1:1)) + ncall=36*ncall+nchar(tmp(2:2)) + ncall=10*ncall+nchar(tmp(3:3)) + ncall=27*ncall+nchar(tmp(4:4))-10 + ncall=27*ncall+nchar(tmp(5:5))-10 + ncall=27*ncall+nchar(tmp(6:6))-10 + + return + end subroutine packcall + + subroutine unpackcall(ncall,word,iv2,psfx) + + parameter (NBASE=37*36*10*27*27*27) + character word*12,c*37,psfx*4 + + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/ + + word='......' + psfx=' ' + n=ncall + iv2=0 + if(n.ge.262177560) go to 20 + word='......' + ! if(n.ge.262177560) go to 999 !Plain text message ... + i=mod(n,27)+11 + word(6:6)=c(i:i) + n=n/27 + i=mod(n,27)+11 + word(5:5)=c(i:i) + n=n/27 + i=mod(n,27)+11 + word(4:4)=c(i:i) + n=n/27 + i=mod(n,10)+1 + word(3:3)=c(i:i) + n=n/10 + i=mod(n,36)+1 + word(2:2)=c(i:i) + n=n/36 + i=n+1 + word(1:1)=c(i:i) + do i=1,4 + if(word(i:i).ne.' ') go to 10 + enddo + go to 999 + 10 word=word(i:) + go to 999 + + 20 if(n.ge.267796946) go to 999 + + ! We have a JT65v2 message + if((n.ge.262178563) .and. (n.le.264002071)) then + ! CQ with prefix + iv2=1 + n=n-262178563 + i=mod(n,37)+1 + psfx(4:4)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(3:3)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(2:2)=c(i:i) + n=n/37 + i=n+1 + psfx(1:1)=c(i:i) + + else if((n.ge.264002072) .and. (n.le.265825580)) then + ! QRZ with prefix + iv2=2 + n=n-264002072 + i=mod(n,37)+1 + psfx(4:4)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(3:3)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(2:2)=c(i:i) + n=n/37 + i=n+1 + psfx(1:1)=c(i:i) + + else if((n.ge.265825581) .and. (n.le.267649089)) then + ! DE with prefix + iv2=3 + n=n-265825581 + i=mod(n,37)+1 + psfx(4:4)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(3:3)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(2:2)=c(i:i) + n=n/37 + i=n+1 + psfx(1:1)=c(i:i) + + else if((n.ge.267649090) .and. (n.le.267698374)) then + ! CQ with suffix + iv2=4 + n=n-267649090 + i=mod(n,37)+1 + psfx(3:3)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(2:2)=c(i:i) + n=n/37 + i=n+1 + psfx(1:1)=c(i:i) + + else if((n.ge.267698375) .and. (n.le.267747659)) then + ! QRZ with suffix + iv2=5 + n=n-267698375 + i=mod(n,37)+1 + psfx(3:3)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(2:2)=c(i:i) + n=n/37 + i=n+1 + psfx(1:1)=c(i:i) + + else if((n.ge.267747660) .and. (n.le.267796944)) then + ! DE with suffix + iv2=6 + n=n-267747660 + i=mod(n,37)+1 + psfx(3:3)=c(i:i) + n=n/37 + i=mod(n,37)+1 + psfx(2:2)=c(i:i) + n=n/37 + i=n+1 + psfx(1:1)=c(i:i) + + else if(n.eq.267796945) then + ! DE with no prefix or suffix + iv2=7 + psfx = ' ' + endif + +999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:) + if(word(1:1).eq.'Q' .and. word(2:2).ge.'A' .and. & + word(2:2).le.'Z') word='3X'//word(2:) + + return + end subroutine unpackcall + + subroutine packgrid(grid,ng,text) + + parameter (NGBASE=180*180) + character*4 grid + character*1 c1 + logical text + + text=.false. + if(grid.eq.' ') go to 90 !Blank grid is OK + + ! First, handle signal reports in the original range, -01 to -30 dB + if(grid(1:1).eq.'-') then + read(grid(2:3),*,err=800,end=800) n + if(n.ge.1 .and. n.le.30) then + ng=NGBASE+1+n + go to 900 + endif + go to 10 + else if(grid(1:2).eq.'R-') then + read(grid(3:4),*,err=800,end=800) n + if(n.ge.1 .and. n.le.30) then + ng=NGBASE+31+n + go to 900 + endif + go to 10 + ! Now check for RO, RRR, or 73 in the message field normally used for grid + else if(grid(1:4).eq.'RO ') then + ng=NGBASE+62 + go to 900 + else if(grid(1:4).eq.'RRR ') then + ng=NGBASE+63 + go to 900 + else if(grid(1:4).eq.'73 ') then + ng=NGBASE+64 + go to 900 + endif + + ! Now check for extended-range signal reports: -50 to -31, and 0 to +49. + 10 n=99 + c1=grid(1:1) + read(grid,*,err=20,end=20) n + go to 30 + 20 read(grid(2:4),*,err=30,end=30) n + 30 if(n.ge.-50 .and. n.le.49) then + if(c1.eq.'R') then + write(grid,1002) n+50 + 1002 format('LA',i2.2) + else + write(grid,1003) n+50 + 1003 format('KA',i2.2) + endif + go to 40 + endif + + ! Maybe it's free text ? + if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true. + if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true. + if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true. + if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true. + if(text) go to 900 + + ! OK, we have a properly formatted grid locator + 40 call grid2deg(grid//'mm',dlong,dlat) + long=int(dlong) + lat=int(dlat+ 90.0) + ng=((long+180)/2)*180 + lat + go to 900 + + 90 ng=NGBASE + 1 + go to 900 + + 800 text=.true. + 900 continue + + return + end subroutine packgrid + + subroutine unpackgrid(ng,grid) + + parameter (NGBASE=180*180) + character grid*4,grid6*6 + + grid=' ' + if(ng.ge.32400) go to 10 + dlat=mod(ng,180)-90 + dlong=(ng/180)*2 - 180 + 2 + call deg2grid(dlong,dlat,grid6) + grid=grid6(:4) + if(grid(1:2).eq.'KA') then + read(grid(3:4),*) n + n=n-50 + write(grid,1001) n + 1001 format(i3.2) + if(grid(1:1).eq.' ') grid(1:1)='+' + else if(grid(1:2).eq.'LA') then + read(grid(3:4),*) n + n=n-50 + write(grid,1002) n + 1002 format('R',i3.2) + if(grid(2:2).eq.' ') grid(2:2)='+' + endif + go to 900 + + 10 n=ng-NGBASE-1 + if(n.ge.1 .and.n.le.30) then + write(grid,1012) -n + 1012 format(i3.2) + else if(n.ge.31 .and.n.le.60) then + n=n-30 + write(grid,1022) -n + 1022 format('R',i3.2) + else if(n.eq.61) then + grid='RO' + else if(n.eq.62) then + grid='RRR' + else if(n.eq.63) then + grid='73' + endif + + 900 return + end subroutine unpackgrid + + subroutine packmsg(msg0,dat,itype) + + ! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols + + ! itype Message Type + !-------------------- + ! 1 Standardd message + ! 2 Type 1 prefix + ! 3 Type 1 suffix + ! 4 Type 2 prefix + ! 5 Type 2 suffix + ! 6 Free text + ! -1 Does not decode correctly + + parameter (NBASE=37*36*10*27*27*27) + parameter (NBASE2=262178562) + character*22 msg0,msg + integer dat(:) + character*12 c1,c2 + character*4 c3 + character*6 grid6 + logical text1,text2,text3 + + itype=1 + msg=msg0 + + call fmtmsg(msg,iz) + if(msg(1:3).eq.'CQ ' .and. msg(4:4).ge.'0' .and. msg(4:4).le.'9' & + .and. msg(5:5).eq.' ') msg='CQ 00'//msg(4:) + + if(msg(1:6).eq.'CQ DX ') msg(3:3)='9' + if(msg(1:3).eq.'CQ ' .and. & + msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. & + msg(5:5).ge.'A' .and. msg(5:5).le.'Z' .and. & + msg(6:6).eq.' ') msg='E9'//msg(4:) + + ! See if it's a CQ message + if(msg(1:3).eq.'CQ ') then + i=3 + ! ... and if so, does it have a reply frequency? + if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and. & + msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and. & + msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7 + go to 1 + endif + + do i=1,22 + if(msg(i:i).eq.' ') go to 1 !Get 1st blank + enddo + go to 10 !Consider msg as plain text + + 1 ia=i + c1=msg(1:ia-1) + do i=ia+1,22 + if(msg(i:i).eq.' ') go to 2 !Get 2nd blank + enddo + go to 10 !Consider msg as plain text + + 2 ib=i + c2=msg(ia+1:ib-1) + + do i=ib+1,22 + if(msg(i:i).eq.' ') go to 3 !Get 3rd blank + enddo + go to 10 !Consider msg as plain text + + 3 ic=i + c3=' ' + if(ic.ge.ib+1) c3=msg(ib+1:ic) + if(c3.eq.'OOO ') c3=' ' !Strip out the OOO flag + call getpfx1(c1,k1,nv2a) + if(nv2a.ge.4) go to 10 + call packcall(c1,nc1,text1) + if(text1) go to 10 + call getpfx1(c2,k2,nv2b) + call packcall(c2,nc2,text2) + if(text2) go to 10 + if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then + if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10 + if(k2.gt.0) k2=k2+450 + k=max(k1,k2) + if(k.gt.0) then + call k2grid(k,grid6) + c3=grid6(:4) + endif + endif + call packgrid(c3,ng,text3) + + if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and. & + (.not.text3)) go to 20 + + nc1=0 + if(nv2b.eq.4) then + if(c1(1:3).eq.'CQ ' .and. (.not.text3)) nc1=262178563 + k2 + if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=264002072 + k2 + if(c1(1:3).eq.'DE ' .and. (.not.text3)) nc1=265825581 + k2 + else if(nv2b.eq.5) then + if(c1(1:3).eq.'CQ ' .and. (.not.text3)) nc1=267649090 + k2 + if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=267698375 + k2 + if(c1(1:3).eq.'DE ' .and. (.not.text3)) nc1=267747660 + k2 + endif + if(nc1.ne.0) go to 20 + + ! The message will be treated as plain text. + 10 itype=6 + call packtext(msg,nc1,nc2,ng) + ng=ng+32768 + + ! Encode data into 6-bit words +20 continue + if(itype.ne.6) itype=max(nv2a,nv2b) + jt_itype=itype + jt_c1=c1(1:6) + jt_c2=c2(1:6) + jt_c3=c3 + jt_k1=k1 + jt_k2=k2 + jt_nc1=nc1 + jt_nc2=nc2 + jt_ng=ng + dat(1)=iand(ishft(nc1,-22),63) !6 bits + dat(2)=iand(ishft(nc1,-16),63) !6 bits + dat(3)=iand(ishft(nc1,-10),63) !6 bits + dat(4)=iand(ishft(nc1, -4),63) !6 bits + dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3) !4+2 bits + dat(6)=iand(ishft(nc2,-20),63) !6 bits + dat(7)=iand(ishft(nc2,-14),63) !6 bits + dat(8)=iand(ishft(nc2, -8),63) !6 bits + dat(9)=iand(ishft(nc2, -2),63) !6 bits + dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits + dat(11)=iand(ishft(ng,-6),63) + dat(12)=iand(ng,63) + + return + end subroutine packmsg + + subroutine unpackmsg(dat,msg) + + parameter (NBASE=37*36*10*27*27*27) + parameter (NGBASE=180*180) + integer dat(:) + character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4 + logical cqnnn + + cqnnn=.false. + nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ & + ishft(dat(4),4) + iand(ishft(dat(5),-2),15) + + nc2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) + & + ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) + & + iand(ishft(dat(10),-4),3) + + ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12) + + if(ng.ge.32768) then + call unpacktext(nc1,nc2,ng,msg) + go to 100 + endif + + call unpackcall(nc1,c1,iv2,psfx) + if(iv2.eq.0) then + ! This is an "original JT65" message + if(nc1.eq.NBASE+1) c1='CQ ' + if(nc1.eq.NBASE+2) c1='QRZ ' + nfreq=nc1-NBASE-3 + if(nfreq.ge.0 .and. nfreq.le.999) then + write(c1,1002) nfreq + 1002 format('CQ ',i3.3) + cqnnn=.true. + endif + endif + + call unpackcall(nc2,c2,junk1,junk2) + call unpackgrid(ng,grid) + + if(iv2.gt.0) then + ! This is a JT65v2 message + do i=1,4 + if(ichar(psfx(i:i)).eq.0) psfx(i:i)=' ' + enddo + + n1=len_trim(psfx) + n2=len_trim(c2) + if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid + if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid + if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid + if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid + if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid + if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid + if(iv2.eq.7) then + grid6=grid//'ma' + call grid2k(grid6,k) + if(k.ge.451 .and. k.le.900) then + call getpfx2(k,c2) + n2=len_trim(c2) + msg='DE '//c2(:n2) + else + msg='DE '//c2(:n2)//' '//grid + endif + endif + if(iv2.eq.8) msg=' ' + go to 100 + else + + endif + + grid6=grid//'ma' + call grid2k(grid6,k) + if(k.ge.1 .and. k.le.450) call getpfx2(k,c1) + if(k.ge.451 .and. k.le.900) call getpfx2(k,c2) + + i=index(c1,char(0)) + if(i.ge.3) c1=c1(1:i-1)//' ' + i=index(c2,char(0)) + if(i.ge.3) c2=c2(1:i-1)//' ' + + msg=' ' + j=0 + if(cqnnn) then + msg=c1//' ' + j=7 !### ??? ### + go to 10 + endif + + do i=1,12 + j=j+1 + msg(j:j)=c1(i:i) + if(c1(i:i).eq.' ') go to 10 + enddo + j=j+1 + msg(j:j)=' ' + + 10 do i=1,12 + if(j.le.21) j=j+1 + msg(j:j)=c2(i:i) + if(c2(i:i).eq.' ') go to 20 + enddo + if(j.le.21) j=j+1 + msg(j:j)=' ' + + 20 if(k.eq.0) then + do i=1,4 + if(j.le.21) j=j+1 + msg(j:j)=grid(i:i) + enddo + if(j.le.21) j=j+1 + msg(j:j)=' ' + endif + + 100 continue + if(msg(1:6).eq.'CQ9DX ') msg(3:3)=' ' + if(msg(1:2).eq.'E9' .and. & + msg(3:3).ge.'A' .and. msg(3:3).le.'Z' .and. & + msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. & + msg(5:5).eq.' ') msg='CQ '//msg(3:) + + if(msg(1:5).eq.'CQ 00' .and. msg(6:6).ge.'0' .and. & + msg(6:6).le.'9') msg='CQ '//msg(6:) + + return + end subroutine unpackmsg + + subroutine packtext(msg,nc1,nc2,nc3) + + parameter (MASK28=2**28 - 1) + character*22 msg + character*42 c + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/ + + nc1=0 + nc2=0 + nc3=0 + + do i=1,5 !First 5 characters in nc1 + do j=1,42 !Get character code + if(msg(i:i).eq.c(j:j)) go to 10 + enddo + j=37 + 10 j=j-1 !Codes should start at zero + nc1=42*nc1 + j + enddo + + do i=6,10 !Characters 6-10 in nc2 + do j=1,42 !Get character code + if(msg(i:i).eq.c(j:j)) go to 20 + enddo + j=37 + 20 j=j-1 !Codes should start at zero + nc2=42*nc2 + j + enddo + + do i=11,13 !Characters 11-13 in nc3 + do j=1,42 !Get character code + if(msg(i:i).eq.c(j:j)) go to 30 + enddo + j=37 + 30 j=j-1 !Codes should start at zero + nc3=42*nc3 + j + enddo + + ! We now have used 17 bits in nc3. Must move one each to nc1 and nc2. + nc1=nc1+nc1 + if(iand(nc3,32768).ne.0) nc1=nc1+1 + nc2=nc2+nc2 + if(iand(nc3,65536).ne.0) nc2=nc2+1 + nc3=iand(nc3,32767) + + return + end subroutine packtext + + subroutine unpacktext(nc1a,nc2a,nc3a,msg) + + character*22 msg + character*44 c + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/ + + nc1=nc1a + nc2=nc2a + nc3=iand(nc3a,32767) !Remove the "plain text" bit + if(iand(nc1,1).ne.0) nc3=nc3+32768 + nc1=nc1/2 + if(iand(nc2,1).ne.0) nc3=nc3+65536 + nc2=nc2/2 + + do i=5,1,-1 + j=mod(nc1,42)+1 + msg(i:i)=c(j:j) + nc1=nc1/42 + enddo + + do i=10,6,-1 + j=mod(nc2,42)+1 + msg(i:i)=c(j:j) + nc2=nc2/42 + enddo + + do i=13,11,-1 + j=mod(nc3,42)+1 + msg(i:i)=c(j:j) + nc3=nc3/42 + enddo + msg(14:22) = ' ' + + return + end subroutine unpacktext + + subroutine getpfx1(callsign,k,nv2) + + character*12 callsign0,callsign,lof,rof + character*8 c + character addpfx*8,tpfx*4,tsfx*3 + logical ispfx,issfx,invalid + common/pfxcom/addpfx + include 'pfx.f90' + + callsign0=callsign + nv2=1 + iz=index(callsign,' ') - 1 + if(iz.lt.0) iz=12 + islash=index(callsign(1:iz),'/') + k=0 + ! if(k.eq.0) go to 10 !Tnx to DL9RDZ for reminder:this was for tests only! + c=' ' + if(islash.gt.0 .and. islash.le.(iz-4)) then + ! Add-on prefix + c=callsign(1:islash-1) + callsign=callsign(islash+1:iz) + do i=1,NZ + if(pfx(i)(1:4).eq.c) then + k=i + nv2=2 + go to 10 + endif + enddo + if(addpfx.eq.c) then + k=449 + nv2=2 + go to 10 + endif + + else if(islash.eq.(iz-1)) then + ! Add-on suffix + c=callsign(islash+1:iz) + callsign=callsign(1:islash-1) + do i=1,NZ2 + if(sfx(i).eq.c(1:1)) then + k=400+i + nv2=3 + go to 10 + endif + enddo + endif + + 10 if(islash.ne.0 .and.k.eq.0) then + ! Original JT65 would force this compound callsign to be treated as + ! plain text. In JT65v2, we will encode the prefix or suffix into nc1. + ! The task here is to compute the proper value of k. + lof=callsign0(:islash-1) + rof=callsign0(islash+1:) + llof=len_trim(lof) + lrof=len_trim(rof) + ispfx=(llof.gt.0 .and. llof.le.4) + issfx=(lrof.gt.0 .and. lrof.le.3) + invalid=.not.(ispfx.or.issfx) + if(ispfx.and.issfx) then + if(llof.lt.3) issfx=.false. + if(lrof.lt.3) ispfx=.false. + if(ispfx.and.issfx) then + i=ichar(callsign0(islash-1:islash-1)) + if(i.ge.ichar('0') .and. i.le.ichar('9')) then + issfx=.false. + else + ispfx=.false. + endif + endif + endif + + if(invalid) then + k=-1 + else + if(ispfx) then + tpfx=lof(1:4) + k=nchar(tpfx(1:1)) + k=37*k + nchar(tpfx(2:2)) + k=37*k + nchar(tpfx(3:3)) + k=37*k + nchar(tpfx(4:4)) + nv2=4 + i=index(callsign0,'/') + callsign=callsign0(:i-1) + callsign=callsign0(i+1:) + endif + if(issfx) then + tsfx=rof(1:3) + k=nchar(tsfx(1:1)) + k=37*k + nchar(tsfx(2:2)) + k=37*k + nchar(tsfx(3:3)) + nv2=5 + i=index(callsign0,'/') + callsign=callsign0(:i-1) + endif + endif + endif + + return + end subroutine getpfx1 + + subroutine getpfx2(k0,callsign) + + character callsign*12 + include 'pfx.f90' + character addpfx*8 + common/pfxcom/addpfx + + k=k0 + if(k.gt.450) k=k-450 + if(k.ge.1 .and. k.le.NZ) then + iz=index(pfx(k),' ') - 1 + callsign=pfx(k)(1:iz)//'/'//callsign + else if(k.ge.401 .and. k.le.400+NZ2) then + iz=index(callsign,' ') - 1 + callsign=callsign(1:iz)//'/'//sfx(k-400) + else if(k.eq.449) then + iz=index(addpfx,' ') - 1 + if(iz.lt.1) iz=8 + callsign=addpfx(1:iz)//'/'//callsign + endif + + return + end subroutine getpfx2 + + subroutine grid2k(grid,k) + + character*6 grid + + call grid2deg(grid,xlong,xlat) + nlong=nint(xlong) + nlat=nint(xlat) + k=0 + if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84 + + return + end subroutine grid2k + + subroutine k2grid(k,grid) + character grid*6 + + nlong=2*mod((k-1)/5,90)-179 + if(k.gt.450) nlong=nlong+180 + nlat=mod(k-1,5)+ 85 + dlat=nlat + dlong=nlong + call deg2grid(dlong,dlat,grid) + + return + end subroutine k2grid + + subroutine grid2n(grid,n) + character*4 grid + + i1=ichar(grid(1:1))-ichar('A') + i2=ichar(grid(3:3))-ichar('0') + i=10*i1 + i2 + n=-i - 31 + + return + end subroutine grid2n + + subroutine n2grid(n,grid) + character*4 grid + + if(n.gt.-31 .or. n.lt.-70) stop 'Error in n2grid' + i=-(n+31) !NB: 0 <= i <= 39 + i1=i/10 + i2=mod(i,10) + grid(1:1)=char(ichar('A')+i1) + grid(2:2)='A' + grid(3:3)=char(ichar('0')+i2) + grid(4:4)='0' + + return + end subroutine n2grid + + function nchar(c) + + ! Convert ascii number, letter, or space to 0-36 for callsign packing. + + character c*1 + + n=0 !Silence compiler warning + if(c.ge.'0' .and. c.le.'9') then + n=ichar(c)-ichar('0') + else if(c.ge.'A' .and. c.le.'Z') then + n=ichar(c)-ichar('A') + 10 + else if(c.ge.'a' .and. c.le.'z') then + n=ichar(c)-ichar('a') + 10 + else if(c.ge.' ') then + n=36 + else + Print*,'Invalid character in callsign ',c,' ',ichar(c) + stop + endif + nchar=n + + return + end function nchar + + subroutine pack50(n1,n2,dat) + + integer*1 dat(:),i1 + + i1=iand(ishft(n1,-20),255) !8 bits + dat(1)=i1 + i1=iand(ishft(n1,-12),255) !8 bits + dat(2)=i1 + i1=iand(ishft(n1, -4),255) !8 bits + dat(3)=i1 + i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits + dat(4)=i1 + i1=iand(ishft(n2,-10),255) !8 bits + dat(5)=i1 + i1=iand(ishft(n2, -2),255) !8 bits + dat(6)=i1 + i1=64*iand(n2,3) !2 bits + dat(7)=i1 + dat(8)=0 + dat(9)=0 + dat(10)=0 + dat(11)=0 + + return + end subroutine pack50 + +subroutine packpfx(call1,n1,ng,nadd) + + character*12 call1,call0 + character*3 pfx + logical text + + i1=index(call1,'/') + if(call1(i1+2:i1+2).eq.' ') then +! Single-character add-on suffix (maybe also fourth suffix letter?) + call0=call1(:i1-1) + call packcall(call0,n1,text) + nadd=1 + nc=ichar(call1(i1+1:i1+1)) + if(nc.ge.48 .and. nc.le.57) then + n=nc-48 + else if(nc.ge.65 .and. nc.le.90) then + n=nc-65+10 + else + n=38 + endif + nadd=1 + ng=60000-32768+n + else if(call1(i1+3:i1+3).eq.' ') then +! Two-character numerical suffix, /10 to /99 + call0=call1(:i1-1) + call packcall(call0,n1,text) + nadd=1 + n=10*(ichar(call1(i1+1:i1+1))-48) + ichar(call1(i1+2:i1+2)) - 48 + nadd=1 + ng=60000 + 26 + n + else +! Prefix of 1 to 3 characters + pfx=call1(:i1-1) + if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2) + if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2) + call0=call1(i1+1:) + call packcall(call0,n1,text) + + ng=0 + do i=1,3 + nc=ichar(pfx(i:i)) + if(nc.ge.48 .and. nc.le.57) then + n=nc-48 + else if(nc.ge.65 .and. nc.le.90) then + n=nc-65+10 + else + n=36 + endif + ng=37*ng + n + enddo + nadd=0 + if(ng.ge.32768) then + ng=ng-32768 + nadd=1 + endif + endif + + return +end subroutine packpfx + +end module packjt diff --git a/wsjtx_lib/lib/pctile.f90 b/wsjtx_lib/lib/pctile.f90 new file mode 100644 index 0000000..0c16aab --- /dev/null +++ b/wsjtx_lib/lib/pctile.f90 @@ -0,0 +1,16 @@ +subroutine pctile(x,npts,npct,xpct) + + real x(npts) + real,allocatable :: tmp(:) + + allocate(tmp(npts)) + + tmp=x + call shell(npts,tmp) + j=nint(npts*0.01*npct) + if(j.lt.1) j=1 + if(j.gt.npts) j=npts + xpct=tmp(j) + + return +end subroutine pctile diff --git a/wsjtx_lib/lib/peakdt9.f90 b/wsjtx_lib/lib/peakdt9.f90 new file mode 100644 index 0000000..d9b9b5c --- /dev/null +++ b/wsjtx_lib/lib/peakdt9.f90 @@ -0,0 +1,54 @@ +subroutine peakdt9(c2,nsps8,nspsd,c3,xdt) + + parameter (NZ2=1512,NZ3=1360) + complex c2(0:NZ2-1) + complex c3(0:NZ3-1) + complex z + real p(0:3300) + include 'jt9sync.f90' + + p=0. + i0=5*nspsd + do i=0,NZ2-1 + z=1.e-3*sum(c2(max(i-(nspsd-1),0):i)) + p(i0+i)=real(z)**2 + aimag(z)**2 !Integrated symbol power at freq=0 + enddo + + call getlags(nsps8,lag0,lag1,lag2) + tsymbol=nsps8/1500.0 + dtlag=tsymbol/nspsd + smax=0. + lagpk=0 + do lag=lag1,lag2 + sum0=0. + sum1=0. + j=-nspsd + do i=1,85 + j=j+nspsd + if(isync(i).eq.1) then + sum1=sum1+p(j+lag) + else + sum0=sum0+p(j+lag) + endif + enddo + ss=(sum1/16.0)/(sum0/69.0) - 1.0 + xdt=(lag-lag0)*dtlag + if(ss.gt.smax) then + smax=ss + lagpk=lag + endif + enddo + + xdt=(lagpk-lag0)*dtlag + + do i=0,NZ3-1 + j=i+lagpk-i0-nspsd+1 + if(j.ge.0 .and. j.lt.NZ2) then + c3(i)=c2(j) + else + c3(i)=0. + endif + enddo + + return +end subroutine peakdt9 diff --git a/wsjtx_lib/lib/peakup.f90 b/wsjtx_lib/lib/peakup.f90 new file mode 100644 index 0000000..92327ab --- /dev/null +++ b/wsjtx_lib/lib/peakup.f90 @@ -0,0 +1,8 @@ +subroutine peakup(ym,y0,yp,dx) + + b=(yp-ym)/2.0 + c=(yp+ym-2.0*y0)/2.0 + dx=-b/(2.0*c) + + return +end subroutine peakup diff --git a/wsjtx_lib/lib/pfx.f90 b/wsjtx_lib/lib/pfx.f90 new file mode 100644 index 0000000..eb81fef --- /dev/null +++ b/wsjtx_lib/lib/pfx.f90 @@ -0,0 +1,50 @@ + parameter (NZ=339) !Total number of prefixes + parameter (NZ2=12) !Total number of suffixes + character*1 sfx(NZ2) + character*5 pfx(NZ) + + data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/ + data pfx/ & + '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', & + '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ', & + '3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ', & + '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ', & + '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ', & + '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ', & + '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ', & + '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ', & + 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ', & + 'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ', & + 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ', & + 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ', & + 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ', & + 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ', & + 'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ', & + 'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ', & + 'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ', & + 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', & + 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ', & + 'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ', & + 'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ', & + 'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ', & + 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ', & + 'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ', & + 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ', & + 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ', & + 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ', & + 'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ', & + 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ', & + 'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ', & + 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ', & + 'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ', & + 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ', & + 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ', & + 'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ', & + 'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ', & + 'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ', & + 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ', & + 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ', & + 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ', & + 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ', & + 'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ', & + 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/ diff --git a/wsjtx_lib/lib/platanh.f90 b/wsjtx_lib/lib/platanh.f90 new file mode 100644 index 0000000..e610366 --- /dev/null +++ b/wsjtx_lib/lib/platanh.f90 @@ -0,0 +1,24 @@ +subroutine platanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.664 ) then + y=x/0.83 + return + elseif( z.le. 0.9217 ) then + y=isign*(z-0.4064)/0.322 + return + elseif( z.le. 0.9951 ) then + y=isign*(z-0.8378)/0.0524 + return + elseif( z.le. 0.9998 ) then + y=isign*(z-0.9914)/0.0012 + return + else + y=isign*7.0 + return + endif +end subroutine platanh diff --git a/wsjtx_lib/lib/plotsave.f90 b/wsjtx_lib/lib/plotsave.f90 new file mode 100644 index 0000000..ee1a41c --- /dev/null +++ b/wsjtx_lib/lib/plotsave.f90 @@ -0,0 +1,34 @@ +subroutine plotsave(swide,nw,nh,irow) + + real, dimension(:,:), allocatable :: sw + real swide(0:nw-1) + data nw0/-1/,nh0/-1/ + save nw0,nh0,sw + + if(irow.eq.-99) then + if(allocated(sw)) deallocate(sw) + go to 900 + endif + + if(nw.ne.nw0 .or. nh.ne.nh0 .or. (.not.allocated(sw))) then + if(allocated(sw)) deallocate(sw) +! if(nw0.ne.-1) deallocate(sw) + allocate(sw(0:nw-1,0:nh-1)) + sw=0. + nw0=nw + nh0=nh + endif + df=12000.0/16384 + if(irow.lt.0) then +! Push a new row of data into sw + do j=nh-1,1,-1 + sw(0:nw-1,j)=sw(0:nw-1,j-1) + enddo + sw(0:nw-1,0)=swide + else +! Return the saved "irow" as swide(), for a waterfall replot. + swide=sw(0:nw-1,irow) + endif + +900 return +end subroutine plotsave diff --git a/wsjtx_lib/lib/pltanh.f90 b/wsjtx_lib/lib/pltanh.f90 new file mode 100644 index 0000000..4c6c2b6 --- /dev/null +++ b/wsjtx_lib/lib/pltanh.f90 @@ -0,0 +1,24 @@ +subroutine pltanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.8 ) then + y=0.83*x + return + elseif( z.le. 1.6 ) then + y=isign*(0.322*z+0.4064) + return + elseif( z.le. 3.0 ) then + y=isign*(0.0524*z+0.8378) + return + elseif( z.lt. 7.0 ) then + y=isign*(0.0012*z+0.9914) + return + else + y=isign*0.9998 + return + endif +end subroutine pltanh diff --git a/wsjtx_lib/lib/polyfit.f90 b/wsjtx_lib/lib/polyfit.f90 new file mode 100644 index 0000000..6322230 --- /dev/null +++ b/wsjtx_lib/lib/polyfit.f90 @@ -0,0 +1,72 @@ +subroutine polyfit(x,y,sigmay,npts,nterms,mode,a,chisqr) + implicit real*8 (a-h,o-z) + real*8 x(npts), y(npts), sigmay(npts), a(nterms) + real*8 sumx(10), sumy(10), array(10,10) + +! 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=determ(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)=determ(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 polyfit diff --git a/wsjtx_lib/lib/prcom.f90 b/wsjtx_lib/lib/prcom.f90 new file mode 100644 index 0000000..ac333b6 --- /dev/null +++ b/wsjtx_lib/lib/prcom.f90 @@ -0,0 +1 @@ + common/prcom/pr(126),mdat(126),mref(126,2),mdat2(126),mref2(126,2) diff --git a/wsjtx_lib/lib/prog_args.f90 b/wsjtx_lib/lib/prog_args.f90 new file mode 100644 index 0000000..63cdb79 --- /dev/null +++ b/wsjtx_lib/lib/prog_args.f90 @@ -0,0 +1,4 @@ +MODULE prog_args + CHARACTER(len=80) :: shm_key + CHARACTER(len=500) :: exe_dir = '.', data_dir = '.', temp_dir = '.' +END MODULE prog_args diff --git a/wsjtx_lib/lib/ps4.f90 b/wsjtx_lib/lib/ps4.f90 new file mode 100644 index 0000000..782ab50 --- /dev/null +++ b/wsjtx_lib/lib/ps4.f90 @@ -0,0 +1,27 @@ +subroutine ps4(dat,nfft,s) + + parameter (NMAX=2520+2) + parameter (NHMAX=NMAX/2-1) + real dat(nfft) + real dat2(NMAX) + real s(NHMAX) + complex c(0:NMAX) + equivalence(dat2,c) + + nh=nfft/2 + do i=1,nh + dat2(i)=dat(i)/128.0 !### Why 128 ?? + enddo + do i=nh+1,nfft + dat2(i)=0. + enddo + + call four2a(c,nfft,1,-1,0) + + fac=1.0/nfft + do i=1,nh + s(i)=fac*(real(c(i))**2 + aimag(c(i))**2) + enddo + + return +end subroutine ps4 diff --git a/wsjtx_lib/lib/psk_parse.f90 b/wsjtx_lib/lib/psk_parse.f90 new file mode 100644 index 0000000..5f97732 --- /dev/null +++ b/wsjtx_lib/lib/psk_parse.f90 @@ -0,0 +1,108 @@ +program psk_parse + + character line*256,callsign*12,callsign0*12,progname*30 + integer nc(6),ntot(6),nsingle(6) + logical zap + data callsign0/' '/ + + open(10,file='jt65-2',status='old') + nc=0 + ntot=0 + ncalls=0 + nsingle=0 + zap=.false. + + do iline=1,9999999 + read(10,'(a256)',end=900) line + n=len(trim(line)) + i1=0 + i2=0 + i3=0 + do i=1,n + if(ichar(line(i:i)).eq.9) then + if(i1.eq.0) then + i1=i + cycle + endif + if(i2.eq.0) then + i2=i + cycle + endif + if(i3.eq.0) then + i3=i + exit + endif + endif + enddo + callsign=line(1:i1-1) + + if(zap) then + if(callsign(1:1).ge.'0' .and. callsign(1:1).le.'9' .and. & + callsign(2:2).ge.'0' .and. callsign(2:2).le.'9' .and. & + callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') cycle + + if(callsign(1:1).ge.'A' .and. callsign(1:1).le.'Z' .and. & + callsign(2:2).ge.'A' .and. callsign(2:2).le.'Z' .and. & + callsign(3:3).ge.'A' .and. callsign(3:3).le.'Z' .and. & + callsign(4:4).ge.'A' .and. callsign(4:4).le.'Z') cycle + + if(callsign(1:1).eq.'N' .and. & + callsign(2:2).ge.'0' .and. callsign(2:2).le.'9' .and. & + callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') cycle + + endif + + progname=line(i1+1:i2-1) + do i=1,len(trim(progname)) + if(progname(i:i).eq.' ') progname(i:i)='_' + enddo + read(line(i2+1:i3-1),*) ndecodes + read(line(i3+1:),*) nreporters + + j=6 + if(index(progname,'WSJT-X').gt.0) j=1 + if(index(progname,'HB9HQX').gt.0) j=2 + if(index(progname,'JTDX').gt.0) j=3 + if(index(progname,'Comfort').gt.0) j=4 + if(index(progname,'COMFORT').gt.0) j=4 + if(index(progname,'JT65-HF').gt.0 .and. j.eq.6) j=5 + + nctot=sum(nc) + if(callsign.ne.callsign0 .and. nctot.gt.0) then + write(13,1000) callsign0,nc,nctot +1000 format(a12,6i8,i10) + if(nctot.eq.1) nsingle(j)=nsingle(j)+1 + nc=0 + callsign0=callsign + ncalls=ncalls+1 + endif + nc(j)=nc(j) + ndecodes + ntot(j)=ntot(j) + ndecodes + write(12,1010) iline,callsign,ndecodes,nreporters,progname +1010 format(i8,2x,a12,2x,2i8,2x,a30) + enddo + +900 nctot=sum(nc) + if(nctot.gt.0) write(13,1000) callsign0,nc,nctot + + write(*,1018) +1018 format(' Total WSJT-X HB9HQX JTDX Comfort JT65-HF Other'/ & + '----------------------------------------------------------') + write(*,1019) +1019 format('Spots reported; fraction of total:') + write(*,1020) sum(ntot),ntot +1020 format(i8,2x,6i8) + fac=1.0/sum(ntot) + write(*,1030) 1.0000,fac*ntot +1030 format(f8.4,2x,6f8.4,f10.4) + + write(*,1038) +1038 format(/'Singletons; as fraction of spots by same program') + write(*,1040) sum(nsingle),nsingle +1040 format(i8,2x,6i8) + write(*,1030) float(sum(nsingle))/sum(ntot),float(nsingle)/ntot + + write(*,1050) ncalls +1050 format(/'Distinct calls spotted:',i6) + +end program psk_parse diff --git a/wsjtx_lib/lib/ptt.c b/wsjtx_lib/lib/ptt.c new file mode 100644 index 0000000..902193f --- /dev/null +++ b/wsjtx_lib/lib/ptt.c @@ -0,0 +1,50 @@ +#include +#include + +int ptt_(int *nport, int *ntx, int *iptt) +{ + static HANDLE hFile; + static int open=0; + char s[10]; + int i3=1,i4=1,i5=1,i6=1,i9=1,i00=1; + + if(*nport==0) { + *iptt=*ntx; + return(0); + } + + if(*ntx && (!open)) { + sprintf(s,"\\\\.\\COM%d",*nport); + hFile=CreateFile(TEXT(s),GENERIC_WRITE,0,NULL,OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL,NULL); + if(hFile==INVALID_HANDLE_VALUE) { + // printf("PTT: Cannot open COM port %d.\n",*nport); + return 1; + } + open=1; + } + + if(*ntx && open) { + i3=EscapeCommFunction(hFile,3); + i5=EscapeCommFunction(hFile,5); + *iptt=1; + } + + else { + i4=EscapeCommFunction(hFile,4); + i6=EscapeCommFunction(hFile,6); + i9=EscapeCommFunction(hFile,9); + i00=CloseHandle(hFile); + *iptt=0; + open=0; + } + /* + if(i3==0) return 3; + if(i4==0) return 4; + if(i5==0) return 5; + if(i6==0) return 6; + if(i9==0) return 9; + if(i00==0) return 10; + */ + return 0; +} diff --git a/wsjtx_lib/lib/q65_decode.f90 b/wsjtx_lib/lib/q65_decode.f90 new file mode 100644 index 0000000..04d4471 --- /dev/null +++ b/wsjtx_lib/lib/q65_decode.f90 @@ -0,0 +1,505 @@ +module q65_decode + + integer nsnr0,nfreq0 + real xdt0 + character msg0*37,cq0*3 + + type :: q65_decoder + procedure(q65_decode_callback), pointer :: callback + contains + procedure :: decode + end type q65_decoder + + abstract interface + subroutine q65_decode_callback (this,nutc,snr1,nsnr,dt,freq, & + decoded,idec,nused,ntrperiod) + import q65_decoder + implicit none + class(q65_decoder), intent(inout) :: this + integer, intent(in) :: nutc + real, intent(in) :: snr1 + integer, intent(in) :: nsnr + real, intent(in) :: dt + real, intent(in) :: freq + character(len=37), intent(in) :: decoded + integer, intent(in) :: idec + integer, intent(in) :: nused + integer, intent(in) :: ntrperiod + end subroutine q65_decode_callback + end interface + +contains + + subroutine decode(this,callback,iwave,nqd0,nutc,ntrperiod,nsubmode,nfqso, & + ntol,ndepth,nfa0,nfb0,lclearave,single_decode,lagain,max_drift0, & + lnewdat0,emedelay,mycall,hiscall,hisgrid,nQSOprogress,ncontest, & + lapcqonly,navg0,nqf) + +! Top-level routine that organizes the decoding of Q65 signals +! Input: iwave Raw data, i*2 +! nutc UTC for time-tagging the decode +! ntrperiod T/R sequence length (s) +! nsubmode Tone-spacing indicator, 0-4 for A-E +! nfqso Target signal frequency (Hz) +! ntol Search range around nfqso (Hz) +! ndepth Optional decoding level +! lclearave Flag to clear the message-averaging arrays +! emedelay Sync search extended to cover EME delays +! nQSOprogress Auto-sequencing state for the present QSO +! ncontest Supported contest type +! lapcqonly Flag to use AP only for CQ calls +! Output: sent to the callback routine for display to user + + use timer_module, only: timer + use packjt77 + use, intrinsic :: iso_c_binding + use q65 !Shared variables + use prog_args + use types + + parameter (NMAX=300*12000) !Max TRperiod is 300 s + parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode + + class(q65_decoder), intent(inout) :: this + + procedure(q65_decode_callback) :: callback + character(len=12) :: mycall, hiscall !Used for AP decoding + character(len=6) :: hisgrid + character*37 decoded !Decoded message + character*37 decodes(100) + character*77 c77 + character*78 c78 + character*6 cutc + character c6*6,c4*4,cmode*4 + character*80 fmt + integer*2 iwave(NMAX) !Raw data + real, allocatable :: dd(:) !Raw data + real xdtdecodes(100) + real f0decodes(100) + integer dat4(13) !Decoded message as 12 6-bit integers + integer dgen(13) + integer nqf(20) + integer stageno !Added by W3SZ + integer time + logical lclearave,lnewdat0,lapcqonly,unpk77_success + logical single_decode,lagain + complex, allocatable :: c00(:) !Analytic signal, 6000 Sa/s + complex, allocatable :: c0(:) !Analytic signal, 6000 Sa/s + type(q3list) callers(MAX_CALLERS) + +! Start by setting some parameters and allocating storage for large arrays + call sec0(0,tdecode) + stageno=0 + ndecodes=0 + decodes=' ' + f0decodes=0. + xdtdecodes=0. + nfa=nfa0 + nfb=nfb0 + nqd=nqd0 + lnewdat=lnewdat0 + max_drift=max_drift0 + idec=-1 + idf=0 + idt=0 + nrc=-2 + mode_q65=2**nsubmode + npts=ntrperiod*12000 + nfft1=ntrperiod*12000 + nfft2=ntrperiod*6000 + npasses=1 + nhist2=0 + if(lagain) ndepth=ior(ndepth,3) !Use 'Deep' for manual Q65 decodes + dxcall13=hiscall ! initialize for use in packjt77 + mycall13=mycall + if(ncontest.eq.1) then +! NA VHF, WW-Digi, or ARRL Digi Contest + open(24,file=trim(data_dir)//'/tsil.3q',status='unknown', & + form='unformatted') + read(24,end=2) nhist2 + if(nhist2.ge.1 .and. nhist2.le.40) then + read(24,end=2) callers(1:nhist2) + now=time() + do i=1,nhist2 + hours=(now - callers(i)%nsec)/3600.0 + if(hours.gt.24.0) then + callers(i:nhist2-1)=callers(i+1:nhist2) + nhist2=nhist2-1 + endif + enddo + else + nhist2=0 + endif +2 close(24) + endif + +! Determine the T/R sequence: iseq=0 (even), or iseq=1 (odd) + n=nutc + if(ntrperiod.ge.60 .and. nutc.le.2359) n=100*n + write(cutc,'(i6.6)') n + read(cutc,'(3i2)') ih,im,is + nsec=3600*ih + 60*im + is + iseq=mod(nsec/ntrperiod,2) + + if(lclearave) call q65_clravg + allocate(dd(npts)) + allocate (c00(0:nfft1-1)) + allocate (c0(0:nfft1-1)) + + if(lagain) then + call q65_hist(nfqso,dxcall=hiscall,dxgrid=hisgrid) + endif + + nsps=1800 + if(ntrperiod.eq.30) then + nsps=3600 + else if(ntrperiod.eq.60) then + nsps=7200 + else if(ntrperiod.eq.120) then + nsps=16000 + else if(ntrperiod.eq.300) then + nsps=41472 + endif + + baud=12000.0/nsps + this%callback => callback + nFadingModel=1 + +! ibwa=max(1,int(1.8*log(baud*mode_q65)) + 5) +!### This needs work! + ibwa=1 !Q65-60A + if(mode_q65.eq.2) ibwa=3 !Q65-60B + if(mode_q65.eq.4) ibwa=8 !Q65-60C + if(mode_q65.eq.2) ibwa=9 !Q65-60D + if(mode_q65.eq.2) ibwa=10 !Q65-60E +!### + +! ibwb=min(15,ibwa+4) + ibwb=min(15,ibwa+6) + maxiters=40 + if(iand(ndepth,3).eq.2) maxiters=60 + if(iand(ndepth,3).eq.3) then + ibwa=max(1,ibwa-2) + ibwb=ibwb+2 + maxiters=100 + endif + +! Generate codewords for full-AP list decoding + if(ichar(hiscall(1:1)).eq.0) hiscall=' ' + if(ichar(hisgrid(1:1)).eq.0) hisgrid=' ' + ncw=0 + if(nqd.eq.1 .or. lagain .or. ncontest.eq.1) then + if(ncontest.eq.1) then + call q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2, & + codewords,ncw) + else + call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) + endif + endif + dgen=0 + call q65_enc(dgen,codewords) !Initialize the Q65 codec + nused=1 + iavg=0 + +! W3SZ patch: Initialize AP params here, rather than afer the call to ana64(). + call ft8apset(mycall,hiscall,ncontest,apsym0,aph10) ! Generate ap symbols + where(apsym0.eq.-1) apsym0=0 + npasses=2 + if(nQSOprogress.eq.5) npasses=3 + + call timer('q65_dec0',0) +! Call top-level routine in q65 module: establish sync and try for a +! q3 or q0 decode. + call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, & + emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno) + call timer('q65_dec0',1) + + if(idec.ge.0) then + dtdec=xdt !We have a q3 or q0 decode at nfqso + f0dec=f0 + go to 100 + endif + + if(ncontest.eq.1 .and. lagain .and. iand(ndepth,16).eq.16) go to 50 + if(ncontest.eq.1 .and. lagain .and. iand(ndepth,16).eq.0) go to 100 + +! Prepare for a single-period decode with iaptype = 0, 1, 2, or 4 + jpk0=(xdt+1.0)*6000 !Index of nominal start of signal + if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !For shortest sequences + if(jpk0.lt.0) jpk0=0 + call ana64(iwave,npts,c00) !Convert to complex c00() at 6000 Sa/s + if(lapcqonly) npasses=1 + iaptype=0 + do ipass=0,npasses !Loop over AP passes + apmask=0 !Try first with no AP information + apsymbols=0 + if(ipass.ge.1) then + ! Subsequent passes use AP information appropiate for nQSOprogress + call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype, & + apsym0,apmask1,apsymbols1) + write(c78,1050) apmask1 +1050 format(78i1) + read(c78,1060) apmask +1060 format(13b6.6) + write(c78,1050) apsymbols1 + read(c78,1060) apsymbols + endif + + call timer('q65loop1',0) + call q65_loops(c00,npts/2,nsps/2,nsubmode,ndepth,jpk0, & + xdt,f0,iaptype,xdt1,f1,snr2,dat4,idec) + call timer('q65loop1',1) + if(idec.ge.0) then + dtdec=xdt1 + f0dec=f1 + go to 100 !Successful decode, we're done + endif + enddo ! ipass + + if(iand(ndepth,16).eq.0 .or. navg(iseq).lt.2) go to 100 + +! There was no single-transmission decode. Try for an average 'q3n' decode. +50 iavg=1 + call timer('list_avg',0) +! Call top-level routine in q65 module: establish sync and try for a q3 +! decode, this time using the cumulative 's1a' symbol spectra. + call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, & + emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno) + call timer('list_avg',1) + + if(idec.ge.0) then + dtdec=xdt !We have a list-decode result from averaged data + f0dec=f0 + nused=navg(iseq) + go to 100 + endif + +! There was no 'q3n' decode. Try for a 'q[0124]n' decode. +! Call top-level routine in q65 module: establish sync and try for a q[012]n +! decode, this time using the cumulative 's1a' symbol spectra. + + call timer('q65_avg ',0) + iavg=2 + call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, & + emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno) + call timer('q65_avg ',1) + if(idec.ge.0) then + dtdec=xdt !We have a q[012]n result + f0dec=f0 + nused=navg(iseq) + endif + +100 if(idec.lt.0 .and. max_drift.eq.50) then + stageno = 5 + call timer('q65_dec0',0) + ! Call top-level routine in q65 module: establish sync and try for a + ! q3 or q0 decode. + call q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, & + emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno) + call timer('q65_dec0',1) + if(idec.ge.0) then + dtdec=xdt !We have a q[012]n result + f0dec=f0 + endif + endif ! if(idec.lt.0) + + decoded=' ' + if(idec.ge.0) then +! idec Meaning +! ------------------------------------------------------ +! -1: No decode +! 0: Decode without AP information +! 1: Decode with AP for "CQ ? ?" +! 2: Decode with AP for "MyCall ? ?" +! 3: Decode with AP for "MyCall DxCall ?" + +! Unpack decoded message for display to user + write(c77,1000) dat4(1:12),dat4(13)/2 +1000 format(12b6.6,b5.5) + call unpack77(c77,1,decoded,unpk77_success) !Unpack to get decoded + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.decoded) idupe=1 + enddo + if(idupe.eq.0) then + ndecodes=min(ndecodes+1,100) + decodes(ndecodes)=decoded + f0decodes(ndecodes)=f0dec + xdtdecodes(ndecodes)=dtdec + call q65_snr(dat4,dtdec,f0dec,mode_q65,snr2) + nsnr=nint(snr2) + call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded, & + idec,nused,ntrperiod) + if(ncontest.eq.1) then + call q65_hist2(nint(f0dec),decoded,callers,nhist2) + else + call q65_hist(nint(f0dec),msg0=decoded) + endif + if(iand(ndepth,128).ne.0 .and. .not.lagain .and. & + int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg !AutoClrAvg + call sec0(1,tdecode) + open(22,file=trim(data_dir)//'/q65_decodes.txt',status='unknown', & + position='append',iostat=ios) + if(ios.eq.0) then +! Save decoding parameters to q65_decoded.dat, for later analysis. + write(cmode,'(i3)') ntrperiod + cmode(4:4)=char(ichar('A')+nsubmode) + c6=hiscall(1:6) + if(c6.eq.' ') c6=' ' + c4=hisgrid(1:4) + if(c4.eq.' ') c4=' ' + fmt='(i6.4,1x,a4,i5,4i2,8i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'// & + '1x,a6,1x,a6,1x,a4,1x,a)' + if(ntrperiod.le.30) fmt(5:5)='6' + if(idec.eq.3) nrc=0 + write(22,fmt) nutc,cmode,nfqso,nQSOprogress,idec,idfbest,idtbest, & + ibwa,ibwb,ibw,ndistbest,nused,icand,ncand,nrc,ndepth,xdt, & + f0,snr2,plog,tdecode,mycall(1:6),c6,c4,trim(decoded) + close(22) + endif + endif + endif + navg0=1000*navg(0) + navg(1) + if(single_decode .or. lagain) go to 900 + + do icand=1,ncand +! Prepare for single-period candidate decodes with iaptype = 0, 1, 2, or 4 + snr1=candidates(icand,1) + xdt= candidates(icand,2) + f0 = candidates(icand,3) + do i=1,ndecodes + fdiff=f0-f0decodes(i) + if(fdiff.gt.-baud*mode_q65 .and. fdiff.lt.65*baud*mode_q65) go to 800 + enddo + +!### TEST REGION + if(ncontest.eq.-1) then + call timer('q65_dec0',0) +! Call top-level routine in q65 module: establish sync and try for a +! q3 or q0 decode. + call q65_dec0(iavg,iwave,ntrperiod,nint(f0),ntol,lclearave, & + emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno) + call timer('q65_dec0',1) + if(idec.ge.0) then + dtdec=xdt !We have a q3 or q0 decode at f0 + f0dec=f0 + go to 200 + endif + endif +!### + jpk0=(xdt+1.0)*6000 !Index of nominal start of signal + if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !For shortest sequences + if(jpk0.lt.0) jpk0=0 + call ana64(iwave,npts,c00) !Convert to complex c00() at 6000 Sa/s + call ft8apset(mycall,hiscall,ncontest,apsym0,aph10) ! Generate ap symbols + where(apsym0.eq.-1) apsym0=0 + + npasses=2 + if(nQSOprogress.eq.5) npasses=3 + if(lapcqonly) npasses=1 + iaptype=0 + do ipass=0,npasses !Loop over AP passes +! write(*,3001) nutc,icand,ipass,f0,xdt,snr1 +!3001 format('a',i5.4,2i3,3f7.1) + apmask=0 !Try first with no AP information + apsymbols=0 + if(ipass.ge.1) then + ! Subsequent passes use AP information appropiate for nQSOprogress + call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype, & + apsym0,apmask1,apsymbols1) + write(c78,1050) apmask1 + read(c78,1060) apmask + write(c78,1050) apsymbols1 + read(c78,1060) apsymbols + endif + + call timer('q65loop2',0) + call q65_loops(c00,npts/2,nsps/2,nsubmode,ndepth,jpk0, & + xdt,f0,iaptype,xdt1,f1,snr2,dat4,idec) + call timer('q65loop2',1) +! write(*,3001) '=e',nfqso,ntol,ndepth,xdt,f0,idec + if(idec.ge.0) then + dtdec=xdt1 + f0dec=f1 + go to 200 !Successful decode, we're done + endif + enddo ! ipass + +200 decoded=' ' + if(idec.ge.0) then +! Unpack decoded message for display to user + write(c77,1000) dat4(1:12),dat4(13)/2 + call unpack77(c77,1,decoded,unpk77_success) !Unpack to get decoded + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.decoded) idupe=1 + enddo + if(idupe.eq.0) then + ndecodes=min(ndecodes+1,100) + decodes(ndecodes)=decoded + f0decodes(ndecodes)=f0dec + call q65_snr(dat4,dtdec,f0dec,mode_q65,snr2) + nsnr=nint(snr2) + call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded, & + idec,nused,ntrperiod) + if(ncontest.eq.1) then + call q65_hist2(nint(f0dec),decoded,callers,nhist2) + else + call q65_hist(nint(f0dec),msg0=decoded) + endif + if(iand(ndepth,128).ne.0 .and. .not.lagain .and. & + int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg !AutoClrAvg + call sec0(1,tdecode) + ios=1 + open(22,file=trim(data_dir)//'/q65_decodes.txt',status='unknown',& + position='append',iostat=ios) + if(ios.eq.0) then +! Save decoding parameters to q65_decoded.dat, for later analysis. + write(cmode,'(i3)') ntrperiod + cmode(4:4)=char(ichar('A')+nsubmode) + c6=hiscall(1:6) + if(c6.eq.' ') c6=' ' + c4=hisgrid(1:4) + if(c4.eq.' ') c4=' ' + fmt='(i6.4,1x,a4,i5,4i2,8i3,i4,f6.2,f7.1,f6.1,f7.1,f6.2,'// & + '1x,a6,1x,a6,1x,a4,1x,a)' + if(ntrperiod.le.30) fmt(5:5)='6' + if(idec.eq.3) nrc=0 + write(22,fmt) nutc,cmode,nfqso,nQSOprogress,idec,idfbest, & + idtbest,ibwa,ibwb,ibw,ndistbest,nused,icand,ncand,nrc, & + ndepth,xdt,f0,snr2,plog,tdecode,mycall(1:6),c6,c4, & + trim(decoded) + close(22) + endif + endif + endif +800 continue + enddo ! icand + if(iavg.eq.0 .and.navg(iseq).ge.2 .and. iand(ndepth,16).ne.0) go to 50 + +900 if(ncontest.ne.1 .or. lagain) go to 999 + if(ntrperiod.ne.60 .or. nsubmode.ne.0) go to 999 + +! This is first time here, and we're running Q65-60A in NA VHF Contest mode. +! Return a list of potential sync frequencies at which to try q3 decoding. + + k=0 + nqf=0 + bw=baud*mode_q65*65 + do i=1,ncand +! snr1=candidates(i,1) +! xdt= candidates(i,2) + f0 = candidates(i,3) + do j=1,ndecodes ! Already decoded one at or near this frequency? + fj=f0decodes(j) + if(f0.gt.fj-5.0 .and. f0.lt.fj+bw+5.0) go to 990 + enddo + k=k+1 + nqf(k)=nint(f0) +990 continue + enddo + +999 return + end subroutine decode + +end module q65_decode diff --git a/wsjtx_lib/lib/q65params.f90 b/wsjtx_lib/lib/q65params.f90 new file mode 100644 index 0000000..932dcfb --- /dev/null +++ b/wsjtx_lib/lib/q65params.f90 @@ -0,0 +1,32 @@ +program q65params + + integer ntrp(5) + integer nsps(5) + data ntrp/15,30,60,120,300/ + data nsps/1800,3600,7200,16000,41472/ + + write(*,1000) +1000 format('T/R tsym baud BW TxT SNR'/39('-')) + do i=1,5 + baud=12000.0/nsps(i) + bw=65.0*baud + tsym=1.0/baud + txt=85.0*tsym + snr=-27.0 + 10.0*log10(7200.0/nsps(i)) + write(*,1010) ntrp(i),tsym,baud,bw,txt,snr +1010 format(i3,2f7.3,3f7.1) + enddo + + do j=1,5 + write(*,1020) char(ichar('A')+j-1) +1020 format(/a1,' T/R baud BW'/20('-')) + do i=1,5 + baud=12000.0/nsps(i) + spacing=baud*2**(j-1) + bw=65.0*spacing + write(*,1030) ntrp(i),spacing,nint(bw) +1030 format(i6,f7.2,i6) + enddo + enddo + +end program q65params diff --git a/wsjtx_lib/lib/qra/q65/Makefile.Win b/wsjtx_lib/lib/qra/q65/Makefile.Win new file mode 100644 index 0000000..8f2214d --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/Makefile.Win @@ -0,0 +1,40 @@ +CC = gcc +CFLAGS = -O2 -Wall -I. -D_WIN32 +FC = gfortran +FFLAGS = -Wall -fbounds-check + +# 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: libq65.a q65.exe q65_ftn_test.exe + +OBJS1 = normrnd.o npfwht.o pdmath.o qra15_65_64_irr_e23.o \ + q65.o qracodes.o + +libq65.a: $(OBJS1) + ar cr libq65.a $(OBJS1) + ranlib libq65.a + +OBJS2 = q65test.o + +q65.exe: $(OBJS2) + ${CC} -o q65.exe $(OBJS2) libq65.a -lm + +OBJS3 = q65_ftn_test.o q65_subs.o + +q65_ftn_test.exe: $(OBJS3) + ${FC} -o q65_ftn_test.exe $(OBJS3) libq65.a -lm + +.PHONY : clean + +clean: + $(RM) *.o libq65.a q65.exe diff --git a/wsjtx_lib/lib/qra/q65/build.sh b/wsjtx_lib/lib/qra/q65/build.sh new file mode 100644 index 0000000..3d7d76f --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/build.sh @@ -0,0 +1,2 @@ +gcc -Wall -march=native -pthread -O3 *.c -lpthread -lm -o q65 + diff --git a/wsjtx_lib/lib/qra/q65/ebnovalues.txt b/wsjtx_lib/lib/qra/q65/ebnovalues.txt new file mode 100644 index 0000000..06a3f58 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/ebnovalues.txt @@ -0,0 +1,17 @@ +# Eb/No Values to be used during the Q65 codec simulation +# Each line of this file indicates the Eb/No value to be simulated (in dB) +# and the number of errors that should be detected by the decoder +# +# Be careful that the simulation takes a long time to complete +# if the number of errors is large for the specified Eb/No +# (this is particularly true if AP decoding is used) +# +-30 100 +0.5 1000 +1.0 1000 +1.5 1000 +2.0 1000 +2.5 1000 +3.0 1000 +3.5 1000 +4.0 1000 \ No newline at end of file diff --git a/wsjtx_lib/lib/qra/q65/fadengauss.c b/wsjtx_lib/lib/qra/q65/fadengauss.c new file mode 100644 index 0000000..f6ca272 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/fadengauss.c @@ -0,0 +1,302 @@ +// Gaussian energy fading tables for QRA64 +static const int glen_tab_gauss[64] = { + 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, + 3, 3, 3, 3, 3, 3, 3, 3, + 4, 4, 4, 4, 5, 5, 5, 6, + 6, 6, 7, 7, 8, 8, 9, 10, + 10, 11, 12, 13, 14, 15, 17, 18, + 19, 21, 23, 25, 27, 29, 32, 34, + 37, 41, 44, 48, 52, 57, 62, 65 +}; +static const float ggauss1[2] = { +0.0296f, 0.9101f +}; +static const float ggauss2[2] = { +0.0350f, 0.8954f +}; +static const float ggauss3[2] = { +0.0411f, 0.8787f +}; +static const float ggauss4[2] = { +0.0483f, 0.8598f +}; +static const float ggauss5[2] = { +0.0566f, 0.8387f +}; +static const float ggauss6[2] = { +0.0660f, 0.8154f +}; +static const float ggauss7[2] = { +0.0767f, 0.7898f +}; +static const float ggauss8[2] = { +0.0886f, 0.7621f +}; +static const float ggauss9[2] = { +0.1017f, 0.7325f +}; +static const float ggauss10[2] = { +0.1159f, 0.7012f +}; +static const float ggauss11[2] = { +0.1310f, 0.6687f +}; +static const float ggauss12[2] = { +0.1465f, 0.6352f +}; +static const float ggauss13[2] = { +0.1621f, 0.6013f +}; +static const float ggauss14[2] = { +0.1771f, 0.5674f +}; +static const float ggauss15[2] = { +0.1911f, 0.5339f +}; +static const float ggauss16[2] = { +0.2034f, 0.5010f +}; +static const float ggauss17[3] = { +0.0299f, 0.2135f, 0.4690f +}; +static const float ggauss18[3] = { +0.0369f, 0.2212f, 0.4383f +}; +static const float ggauss19[3] = { +0.0454f, 0.2263f, 0.4088f +}; +static const float ggauss20[3] = { +0.0552f, 0.2286f, 0.3806f +}; +static const float ggauss21[3] = { +0.0658f, 0.2284f, 0.3539f +}; +static const float ggauss22[3] = { +0.0766f, 0.2258f, 0.3287f +}; +static const float ggauss23[3] = { +0.0869f, 0.2212f, 0.3049f +}; +static const float ggauss24[3] = { +0.0962f, 0.2148f, 0.2826f +}; +static const float ggauss25[4] = { +0.0351f, 0.1041f, 0.2071f, 0.2616f +}; +static const float ggauss26[4] = { +0.0429f, 0.1102f, 0.1984f, 0.2420f +}; +static const float ggauss27[4] = { +0.0508f, 0.1145f, 0.1890f, 0.2237f +}; +static const float ggauss28[4] = { +0.0582f, 0.1169f, 0.1791f, 0.2067f +}; +static const float ggauss29[5] = { +0.0289f, 0.0648f, 0.1176f, 0.1689f, 0.1908f +}; +static const float ggauss30[5] = { +0.0351f, 0.0703f, 0.1168f, 0.1588f, 0.1760f +}; +static const float ggauss31[5] = { +0.0411f, 0.0745f, 0.1146f, 0.1488f, 0.1623f +}; +static const float ggauss32[6] = { +0.0246f, 0.0466f, 0.0773f, 0.1115f, 0.1390f, 0.1497f +}; +static const float ggauss33[6] = { +0.0297f, 0.0512f, 0.0788f, 0.1075f, 0.1295f, 0.1379f +}; +static const float ggauss34[6] = { +0.0345f, 0.0549f, 0.0791f, 0.1029f, 0.1205f, 0.1270f +}; +static const float ggauss35[7] = { +0.0240f, 0.0387f, 0.0575f, 0.0784f, 0.0979f, 0.1118f, 0.1169f +}; +static const float ggauss36[7] = { +0.0281f, 0.0422f, 0.0590f, 0.0767f, 0.0926f, 0.1037f, 0.1076f +}; +static const float ggauss37[8] = { +0.0212f, 0.0318f, 0.0449f, 0.0596f, 0.0744f, 0.0872f, 0.0960f, 0.0991f +}; +static const float ggauss38[8] = { +0.0247f, 0.0348f, 0.0467f, 0.0593f, 0.0716f, 0.0819f, 0.0887f, 0.0911f +}; +static const float ggauss39[9] = { +0.0199f, 0.0278f, 0.0372f, 0.0476f, 0.0584f, 0.0684f, 0.0766f, 0.0819f, +0.0838f +}; +static const float ggauss40[10] = { +0.0166f, 0.0228f, 0.0303f, 0.0388f, 0.0478f, 0.0568f, 0.0649f, 0.0714f, +0.0756f, 0.0771f +}; +static const float ggauss41[10] = { +0.0193f, 0.0254f, 0.0322f, 0.0397f, 0.0474f, 0.0548f, 0.0613f, 0.0664f, +0.0697f, 0.0709f +}; +static const float ggauss42[11] = { +0.0168f, 0.0217f, 0.0273f, 0.0335f, 0.0399f, 0.0464f, 0.0524f, 0.0576f, +0.0617f, 0.0643f, 0.0651f +}; +static const float ggauss43[12] = { +0.0151f, 0.0191f, 0.0237f, 0.0288f, 0.0342f, 0.0396f, 0.0449f, 0.0498f, +0.0540f, 0.0572f, 0.0592f, 0.0599f +}; +static const float ggauss44[13] = { +0.0138f, 0.0171f, 0.0210f, 0.0252f, 0.0297f, 0.0343f, 0.0388f, 0.0432f, +0.0471f, 0.0504f, 0.0529f, 0.0545f, 0.0550f +}; +static const float ggauss45[14] = { +0.0128f, 0.0157f, 0.0189f, 0.0224f, 0.0261f, 0.0300f, 0.0339f, 0.0377f, +0.0412f, 0.0444f, 0.0470f, 0.0489f, 0.0501f, 0.0505f +}; +static const float ggauss46[15] = { +0.0121f, 0.0146f, 0.0173f, 0.0202f, 0.0234f, 0.0266f, 0.0299f, 0.0332f, +0.0363f, 0.0391f, 0.0416f, 0.0437f, 0.0452f, 0.0461f, 0.0464f +}; +static const float ggauss47[17] = { +0.0097f, 0.0116f, 0.0138f, 0.0161f, 0.0186f, 0.0212f, 0.0239f, 0.0267f, +0.0294f, 0.0321f, 0.0346f, 0.0369f, 0.0389f, 0.0405f, 0.0417f, 0.0424f, +0.0427f +}; +static const float ggauss48[18] = { +0.0096f, 0.0113f, 0.0131f, 0.0151f, 0.0172f, 0.0194f, 0.0217f, 0.0241f, +0.0264f, 0.0287f, 0.0308f, 0.0329f, 0.0347f, 0.0362f, 0.0375f, 0.0384f, +0.0390f, 0.0392f +}; +static const float ggauss49[19] = { +0.0095f, 0.0110f, 0.0126f, 0.0143f, 0.0161f, 0.0180f, 0.0199f, 0.0219f, +0.0239f, 0.0258f, 0.0277f, 0.0294f, 0.0310f, 0.0325f, 0.0337f, 0.0347f, +0.0354f, 0.0358f, 0.0360f +}; +static const float ggauss50[21] = { +0.0083f, 0.0095f, 0.0108f, 0.0122f, 0.0136f, 0.0152f, 0.0168f, 0.0184f, +0.0201f, 0.0217f, 0.0234f, 0.0250f, 0.0265f, 0.0279f, 0.0292f, 0.0303f, +0.0313f, 0.0320f, 0.0326f, 0.0329f, 0.0330f +}; +static const float ggauss51[23] = { +0.0074f, 0.0084f, 0.0095f, 0.0106f, 0.0118f, 0.0131f, 0.0144f, 0.0157f, +0.0171f, 0.0185f, 0.0199f, 0.0213f, 0.0227f, 0.0240f, 0.0252f, 0.0263f, +0.0273f, 0.0282f, 0.0290f, 0.0296f, 0.0300f, 0.0303f, 0.0303f +}; +static const float ggauss52[25] = { +0.0068f, 0.0076f, 0.0085f, 0.0094f, 0.0104f, 0.0115f, 0.0126f, 0.0137f, +0.0149f, 0.0160f, 0.0172f, 0.0184f, 0.0196f, 0.0207f, 0.0218f, 0.0228f, +0.0238f, 0.0247f, 0.0255f, 0.0262f, 0.0268f, 0.0273f, 0.0276f, 0.0278f, +0.0279f +}; +static const float ggauss53[27] = { +0.0063f, 0.0070f, 0.0078f, 0.0086f, 0.0094f, 0.0103f, 0.0112f, 0.0121f, +0.0131f, 0.0141f, 0.0151f, 0.0161f, 0.0170f, 0.0180f, 0.0190f, 0.0199f, +0.0208f, 0.0216f, 0.0224f, 0.0231f, 0.0237f, 0.0243f, 0.0247f, 0.0251f, +0.0254f, 0.0255f, 0.0256f +}; +static const float ggauss54[29] = { +0.0060f, 0.0066f, 0.0072f, 0.0079f, 0.0086f, 0.0093f, 0.0101f, 0.0109f, +0.0117f, 0.0125f, 0.0133f, 0.0142f, 0.0150f, 0.0159f, 0.0167f, 0.0175f, +0.0183f, 0.0190f, 0.0197f, 0.0204f, 0.0210f, 0.0216f, 0.0221f, 0.0225f, +0.0228f, 0.0231f, 0.0233f, 0.0234f, 0.0235f +}; +static const float ggauss55[32] = { +0.0053f, 0.0058f, 0.0063f, 0.0068f, 0.0074f, 0.0080f, 0.0086f, 0.0093f, +0.0099f, 0.0106f, 0.0113f, 0.0120f, 0.0127f, 0.0134f, 0.0141f, 0.0148f, +0.0155f, 0.0162f, 0.0168f, 0.0174f, 0.0180f, 0.0186f, 0.0191f, 0.0196f, +0.0201f, 0.0204f, 0.0208f, 0.0211f, 0.0213f, 0.0214f, 0.0215f, 0.0216f +}; +static const float ggauss56[34] = { +0.0052f, 0.0056f, 0.0060f, 0.0065f, 0.0070f, 0.0075f, 0.0080f, 0.0086f, +0.0091f, 0.0097f, 0.0103f, 0.0109f, 0.0115f, 0.0121f, 0.0127f, 0.0133f, +0.0138f, 0.0144f, 0.0150f, 0.0155f, 0.0161f, 0.0166f, 0.0170f, 0.0175f, +0.0179f, 0.0183f, 0.0186f, 0.0189f, 0.0192f, 0.0194f, 0.0196f, 0.0197f, +0.0198f, 0.0198f +}; +static const float ggauss57[37] = { +0.0047f, 0.0051f, 0.0055f, 0.0058f, 0.0063f, 0.0067f, 0.0071f, 0.0076f, +0.0080f, 0.0085f, 0.0090f, 0.0095f, 0.0100f, 0.0105f, 0.0110f, 0.0115f, +0.0120f, 0.0125f, 0.0130f, 0.0134f, 0.0139f, 0.0144f, 0.0148f, 0.0152f, +0.0156f, 0.0160f, 0.0164f, 0.0167f, 0.0170f, 0.0173f, 0.0175f, 0.0177f, +0.0179f, 0.0180f, 0.0181f, 0.0181f, 0.0182f +}; +static const float ggauss58[41] = { +0.0041f, 0.0044f, 0.0047f, 0.0050f, 0.0054f, 0.0057f, 0.0060f, 0.0064f, +0.0068f, 0.0072f, 0.0076f, 0.0080f, 0.0084f, 0.0088f, 0.0092f, 0.0096f, +0.0101f, 0.0105f, 0.0109f, 0.0113f, 0.0117f, 0.0121f, 0.0125f, 0.0129f, +0.0133f, 0.0137f, 0.0140f, 0.0144f, 0.0147f, 0.0150f, 0.0153f, 0.0155f, +0.0158f, 0.0160f, 0.0162f, 0.0163f, 0.0164f, 0.0165f, 0.0166f, 0.0167f, +0.0167f +}; +static const float ggauss59[44] = { +0.0039f, 0.0042f, 0.0044f, 0.0047f, 0.0050f, 0.0053f, 0.0056f, 0.0059f, +0.0062f, 0.0065f, 0.0068f, 0.0072f, 0.0075f, 0.0079f, 0.0082f, 0.0086f, +0.0089f, 0.0093f, 0.0096f, 0.0100f, 0.0104f, 0.0107f, 0.0110f, 0.0114f, +0.0117f, 0.0120f, 0.0124f, 0.0127f, 0.0130f, 0.0132f, 0.0135f, 0.0138f, +0.0140f, 0.0142f, 0.0144f, 0.0146f, 0.0148f, 0.0149f, 0.0150f, 0.0151f, +0.0152f, 0.0153f, 0.0153f, 0.0153f +}; +static const float ggauss60[48] = { +0.0036f, 0.0038f, 0.0040f, 0.0042f, 0.0044f, 0.0047f, 0.0049f, 0.0052f, +0.0055f, 0.0057f, 0.0060f, 0.0063f, 0.0066f, 0.0068f, 0.0071f, 0.0074f, +0.0077f, 0.0080f, 0.0083f, 0.0086f, 0.0089f, 0.0092f, 0.0095f, 0.0098f, +0.0101f, 0.0104f, 0.0107f, 0.0109f, 0.0112f, 0.0115f, 0.0117f, 0.0120f, +0.0122f, 0.0124f, 0.0126f, 0.0128f, 0.0130f, 0.0132f, 0.0134f, 0.0135f, +0.0136f, 0.0137f, 0.0138f, 0.0139f, 0.0140f, 0.0140f, 0.0140f, 0.0140f +}; +static const float ggauss61[52] = { +0.0033f, 0.0035f, 0.0037f, 0.0039f, 0.0041f, 0.0043f, 0.0045f, 0.0047f, +0.0049f, 0.0051f, 0.0053f, 0.0056f, 0.0058f, 0.0060f, 0.0063f, 0.0065f, +0.0068f, 0.0070f, 0.0073f, 0.0075f, 0.0078f, 0.0080f, 0.0083f, 0.0085f, +0.0088f, 0.0090f, 0.0093f, 0.0095f, 0.0098f, 0.0100f, 0.0102f, 0.0105f, +0.0107f, 0.0109f, 0.0111f, 0.0113f, 0.0115f, 0.0116f, 0.0118f, 0.0120f, +0.0121f, 0.0122f, 0.0124f, 0.0125f, 0.0126f, 0.0126f, 0.0127f, 0.0128f, +0.0128f, 0.0129f, 0.0129f, 0.0129f +}; +static const float ggauss62[57] = { +0.0030f, 0.0031f, 0.0033f, 0.0034f, 0.0036f, 0.0038f, 0.0039f, 0.0041f, +0.0043f, 0.0045f, 0.0047f, 0.0048f, 0.0050f, 0.0052f, 0.0054f, 0.0056f, +0.0058f, 0.0060f, 0.0063f, 0.0065f, 0.0067f, 0.0069f, 0.0071f, 0.0073f, +0.0075f, 0.0077f, 0.0080f, 0.0082f, 0.0084f, 0.0086f, 0.0088f, 0.0090f, +0.0092f, 0.0094f, 0.0096f, 0.0097f, 0.0099f, 0.0101f, 0.0103f, 0.0104f, +0.0106f, 0.0107f, 0.0108f, 0.0110f, 0.0111f, 0.0112f, 0.0113f, 0.0114f, +0.0115f, 0.0116f, 0.0116f, 0.0117f, 0.0117f, 0.0118f, 0.0118f, 0.0118f, +0.0118f +}; +static const float ggauss63[62] = { +0.0027f, 0.0029f, 0.0030f, 0.0031f, 0.0032f, 0.0034f, 0.0035f, 0.0037f, +0.0038f, 0.0040f, 0.0041f, 0.0043f, 0.0045f, 0.0046f, 0.0048f, 0.0049f, +0.0051f, 0.0053f, 0.0055f, 0.0056f, 0.0058f, 0.0060f, 0.0062f, 0.0063f, +0.0065f, 0.0067f, 0.0069f, 0.0071f, 0.0072f, 0.0074f, 0.0076f, 0.0078f, +0.0079f, 0.0081f, 0.0083f, 0.0084f, 0.0086f, 0.0088f, 0.0089f, 0.0091f, +0.0092f, 0.0094f, 0.0095f, 0.0096f, 0.0098f, 0.0099f, 0.0100f, 0.0101f, +0.0102f, 0.0103f, 0.0104f, 0.0105f, 0.0105f, 0.0106f, 0.0107f, 0.0107f, +0.0108f, 0.0108f, 0.0108f, 0.0108f, 0.0109f, 0.0109f +}; +static const float ggauss64[65] = { +0.0028f, 0.0029f, 0.0030f, 0.0031f, 0.0032f, 0.0034f, 0.0035f, 0.0036f, +0.0037f, 0.0039f, 0.0040f, 0.0041f, 0.0043f, 0.0044f, 0.0046f, 0.0047f, +0.0048f, 0.0050f, 0.0051f, 0.0053f, 0.0054f, 0.0056f, 0.0057f, 0.0059f, +0.0060f, 0.0062f, 0.0063f, 0.0065f, 0.0066f, 0.0068f, 0.0069f, 0.0071f, +0.0072f, 0.0074f, 0.0075f, 0.0077f, 0.0078f, 0.0079f, 0.0081f, 0.0082f, +0.0083f, 0.0084f, 0.0086f, 0.0087f, 0.0088f, 0.0089f, 0.0090f, 0.0091f, +0.0092f, 0.0093f, 0.0094f, 0.0094f, 0.0095f, 0.0096f, 0.0097f, 0.0097f, +0.0098f, 0.0098f, 0.0099f, 0.0099f, 0.0099f, 0.0099f, 0.0100f, 0.0100f, +0.0100f +}; +static const float *gptr_tab_gauss[64] = { +ggauss1, ggauss2, ggauss3, ggauss4, +ggauss5, ggauss6, ggauss7, ggauss8, +ggauss9, ggauss10, ggauss11, ggauss12, +ggauss13, ggauss14, ggauss15, ggauss16, +ggauss17, ggauss18, ggauss19, ggauss20, +ggauss21, ggauss22, ggauss23, ggauss24, +ggauss25, ggauss26, ggauss27, ggauss28, +ggauss29, ggauss30, ggauss31, ggauss32, +ggauss33, ggauss34, ggauss35, ggauss36, +ggauss37, ggauss38, ggauss39, ggauss40, +ggauss41, ggauss42, ggauss43, ggauss44, +ggauss45, ggauss46, ggauss47, ggauss48, +ggauss49, ggauss50, ggauss51, ggauss52, +ggauss53, ggauss54, ggauss55, ggauss56, +ggauss57, ggauss58, ggauss59, ggauss60, +ggauss61, ggauss62, ggauss63, ggauss64 +}; diff --git a/wsjtx_lib/lib/qra/q65/fadenlorentz.c b/wsjtx_lib/lib/qra/q65/fadenlorentz.c new file mode 100644 index 0000000..22329f6 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/fadenlorentz.c @@ -0,0 +1,304 @@ +// Lorentz energy fading tables for QRA64 +static const int glen_tab_lorentz[64] = { + 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 3, 3, + 3, 3, 3, 3, 3, 4, 4, 4, + 4, 4, 5, 5, 5, 5, 6, 6, + 7, 7, 7, 8, 8, 9, 10, 10, + 11, 12, 13, 14, 15, 16, 17, 19, + 20, 22, 23, 25, 27, 30, 32, 35, + 38, 41, 45, 49, 53, 57, 62, 65 +}; +static const float glorentz1[2] = { +0.0214f, 0.9107f +}; +static const float glorentz2[2] = { +0.0244f, 0.9030f +}; +static const float glorentz3[2] = { +0.0280f, 0.8950f +}; +static const float glorentz4[2] = { +0.0314f, 0.8865f +}; +static const float glorentz5[2] = { +0.0349f, 0.8773f +}; +static const float glorentz6[2] = { +0.0388f, 0.8675f +}; +static const float glorentz7[2] = { +0.0426f, 0.8571f +}; +static const float glorentz8[2] = { +0.0463f, 0.8459f +}; +static const float glorentz9[2] = { +0.0500f, 0.8339f +}; +static const float glorentz10[2] = { +0.0538f, 0.8210f +}; +static const float glorentz11[2] = { +0.0579f, 0.8074f +}; +static const float glorentz12[2] = { +0.0622f, 0.7930f +}; +static const float glorentz13[2] = { +0.0668f, 0.7777f +}; +static const float glorentz14[2] = { +0.0715f, 0.7616f +}; +static const float glorentz15[3] = { +0.0196f, 0.0765f, 0.7445f +}; +static const float glorentz16[3] = { +0.0210f, 0.0816f, 0.7267f +}; +static const float glorentz17[3] = { +0.0226f, 0.0870f, 0.7080f +}; +static const float glorentz18[3] = { +0.0242f, 0.0925f, 0.6885f +}; +static const float glorentz19[3] = { +0.0259f, 0.0981f, 0.6682f +}; +static const float glorentz20[3] = { +0.0277f, 0.1039f, 0.6472f +}; +static const float glorentz21[3] = { +0.0296f, 0.1097f, 0.6255f +}; +static const float glorentz22[4] = { +0.0143f, 0.0316f, 0.1155f, 0.6031f +}; +static const float glorentz23[4] = { +0.0153f, 0.0337f, 0.1213f, 0.5803f +}; +static const float glorentz24[4] = { +0.0163f, 0.0358f, 0.1270f, 0.5570f +}; +static const float glorentz25[4] = { +0.0174f, 0.0381f, 0.1325f, 0.5333f +}; +static const float glorentz26[4] = { +0.0186f, 0.0405f, 0.1378f, 0.5095f +}; +static const float glorentz27[5] = { +0.0113f, 0.0198f, 0.0429f, 0.1428f, 0.4855f +}; +static const float glorentz28[5] = { +0.0120f, 0.0211f, 0.0455f, 0.1473f, 0.4615f +}; +static const float glorentz29[5] = { +0.0129f, 0.0225f, 0.0481f, 0.1514f, 0.4376f +}; +static const float glorentz30[5] = { +0.0137f, 0.0239f, 0.0508f, 0.1549f, 0.4140f +}; +static const float glorentz31[6] = { +0.0095f, 0.0147f, 0.0254f, 0.0536f, 0.1578f, 0.3907f +}; +static const float glorentz32[6] = { +0.0101f, 0.0156f, 0.0270f, 0.0564f, 0.1600f, 0.3680f +}; +static const float glorentz33[7] = { +0.0076f, 0.0109f, 0.0167f, 0.0287f, 0.0592f, 0.1614f, 0.3458f +}; +static const float glorentz34[7] = { +0.0081f, 0.0116f, 0.0178f, 0.0305f, 0.0621f, 0.1620f, 0.3243f +}; +static const float glorentz35[7] = { +0.0087f, 0.0124f, 0.0190f, 0.0324f, 0.0649f, 0.1618f, 0.3035f +}; +static const float glorentz36[8] = { +0.0069f, 0.0093f, 0.0133f, 0.0203f, 0.0343f, 0.0676f, 0.1607f, 0.2836f +}; +static const float glorentz37[8] = { +0.0074f, 0.0100f, 0.0142f, 0.0216f, 0.0362f, 0.0702f, 0.1588f, 0.2645f +}; +static const float glorentz38[9] = { +0.0061f, 0.0080f, 0.0107f, 0.0152f, 0.0230f, 0.0382f, 0.0726f, 0.1561f, +0.2464f +}; +static const float glorentz39[10] = { +0.0052f, 0.0066f, 0.0086f, 0.0115f, 0.0162f, 0.0244f, 0.0402f, 0.0747f, +0.1526f, 0.2291f +}; +static const float glorentz40[10] = { +0.0056f, 0.0071f, 0.0092f, 0.0123f, 0.0173f, 0.0259f, 0.0422f, 0.0766f, +0.1484f, 0.2128f +}; +static const float glorentz41[11] = { +0.0049f, 0.0061f, 0.0076f, 0.0098f, 0.0132f, 0.0184f, 0.0274f, 0.0441f, +0.0780f, 0.1437f, 0.1975f +}; +static const float glorentz42[12] = { +0.0044f, 0.0053f, 0.0065f, 0.0082f, 0.0106f, 0.0141f, 0.0196f, 0.0290f, +0.0460f, 0.0791f, 0.1384f, 0.1831f +}; +static const float glorentz43[13] = { +0.0040f, 0.0048f, 0.0057f, 0.0070f, 0.0088f, 0.0113f, 0.0150f, 0.0209f, +0.0305f, 0.0477f, 0.0797f, 0.1327f, 0.1695f +}; +static const float glorentz44[14] = { +0.0037f, 0.0043f, 0.0051f, 0.0062f, 0.0075f, 0.0094f, 0.0121f, 0.0160f, +0.0221f, 0.0321f, 0.0493f, 0.0799f, 0.1267f, 0.1568f +}; +static const float glorentz45[15] = { +0.0035f, 0.0040f, 0.0047f, 0.0055f, 0.0066f, 0.0081f, 0.0101f, 0.0129f, +0.0171f, 0.0234f, 0.0335f, 0.0506f, 0.0795f, 0.1204f, 0.1450f +}; +static const float glorentz46[16] = { +0.0033f, 0.0037f, 0.0043f, 0.0050f, 0.0059f, 0.0071f, 0.0087f, 0.0108f, +0.0138f, 0.0181f, 0.0246f, 0.0349f, 0.0517f, 0.0786f, 0.1141f, 0.1340f +}; +static const float glorentz47[17] = { +0.0031f, 0.0035f, 0.0040f, 0.0046f, 0.0054f, 0.0064f, 0.0077f, 0.0093f, +0.0116f, 0.0147f, 0.0192f, 0.0259f, 0.0362f, 0.0525f, 0.0773f, 0.1076f, +0.1237f +}; +static const float glorentz48[19] = { +0.0027f, 0.0030f, 0.0034f, 0.0038f, 0.0043f, 0.0050f, 0.0058f, 0.0069f, +0.0082f, 0.0100f, 0.0123f, 0.0156f, 0.0203f, 0.0271f, 0.0374f, 0.0530f, +0.0755f, 0.1013f, 0.1141f +}; +static const float glorentz49[20] = { +0.0026f, 0.0029f, 0.0032f, 0.0036f, 0.0041f, 0.0047f, 0.0054f, 0.0063f, +0.0074f, 0.0088f, 0.0107f, 0.0131f, 0.0165f, 0.0213f, 0.0282f, 0.0383f, +0.0531f, 0.0734f, 0.0950f, 0.1053f +}; +static const float glorentz50[22] = { +0.0023f, 0.0025f, 0.0028f, 0.0031f, 0.0035f, 0.0039f, 0.0044f, 0.0050f, +0.0058f, 0.0067f, 0.0079f, 0.0094f, 0.0114f, 0.0139f, 0.0175f, 0.0223f, +0.0292f, 0.0391f, 0.0529f, 0.0709f, 0.0889f, 0.0971f +}; +static const float glorentz51[23] = { +0.0023f, 0.0025f, 0.0027f, 0.0030f, 0.0034f, 0.0037f, 0.0042f, 0.0048f, +0.0054f, 0.0062f, 0.0072f, 0.0085f, 0.0100f, 0.0121f, 0.0148f, 0.0184f, +0.0233f, 0.0301f, 0.0396f, 0.0524f, 0.0681f, 0.0829f, 0.0894f +}; +static const float glorentz52[25] = { +0.0021f, 0.0023f, 0.0025f, 0.0027f, 0.0030f, 0.0033f, 0.0036f, 0.0040f, +0.0045f, 0.0051f, 0.0058f, 0.0067f, 0.0077f, 0.0090f, 0.0107f, 0.0128f, +0.0156f, 0.0192f, 0.0242f, 0.0308f, 0.0398f, 0.0515f, 0.0650f, 0.0772f, +0.0824f +}; +static const float glorentz53[27] = { +0.0019f, 0.0021f, 0.0022f, 0.0024f, 0.0027f, 0.0029f, 0.0032f, 0.0035f, +0.0039f, 0.0044f, 0.0049f, 0.0055f, 0.0062f, 0.0072f, 0.0083f, 0.0096f, +0.0113f, 0.0135f, 0.0164f, 0.0201f, 0.0249f, 0.0314f, 0.0398f, 0.0502f, +0.0619f, 0.0718f, 0.0759f +}; +static const float glorentz54[30] = { +0.0017f, 0.0018f, 0.0019f, 0.0021f, 0.0022f, 0.0024f, 0.0026f, 0.0029f, +0.0031f, 0.0034f, 0.0038f, 0.0042f, 0.0047f, 0.0052f, 0.0059f, 0.0067f, +0.0076f, 0.0088f, 0.0102f, 0.0120f, 0.0143f, 0.0171f, 0.0208f, 0.0256f, +0.0317f, 0.0395f, 0.0488f, 0.0586f, 0.0666f, 0.0698f +}; +static const float glorentz55[32] = { +0.0016f, 0.0017f, 0.0018f, 0.0019f, 0.0021f, 0.0022f, 0.0024f, 0.0026f, +0.0028f, 0.0031f, 0.0034f, 0.0037f, 0.0041f, 0.0045f, 0.0050f, 0.0056f, +0.0063f, 0.0071f, 0.0081f, 0.0094f, 0.0108f, 0.0127f, 0.0149f, 0.0178f, +0.0214f, 0.0261f, 0.0318f, 0.0389f, 0.0470f, 0.0553f, 0.0618f, 0.0643f +}; +static const float glorentz56[35] = { +0.0014f, 0.0015f, 0.0016f, 0.0017f, 0.0018f, 0.0020f, 0.0021f, 0.0023f, +0.0024f, 0.0026f, 0.0028f, 0.0031f, 0.0033f, 0.0036f, 0.0040f, 0.0044f, +0.0049f, 0.0054f, 0.0060f, 0.0067f, 0.0076f, 0.0087f, 0.0099f, 0.0114f, +0.0133f, 0.0156f, 0.0184f, 0.0220f, 0.0264f, 0.0318f, 0.0381f, 0.0451f, +0.0520f, 0.0572f, 0.0591f +}; +static const float glorentz57[38] = { +0.0013f, 0.0014f, 0.0015f, 0.0016f, 0.0017f, 0.0018f, 0.0019f, 0.0020f, +0.0021f, 0.0023f, 0.0024f, 0.0026f, 0.0028f, 0.0031f, 0.0033f, 0.0036f, +0.0039f, 0.0043f, 0.0047f, 0.0052f, 0.0058f, 0.0064f, 0.0072f, 0.0081f, +0.0092f, 0.0104f, 0.0120f, 0.0139f, 0.0162f, 0.0190f, 0.0224f, 0.0265f, +0.0315f, 0.0371f, 0.0431f, 0.0487f, 0.0529f, 0.0544f +}; +static const float glorentz58[41] = { +0.0012f, 0.0013f, 0.0014f, 0.0014f, 0.0015f, 0.0016f, 0.0017f, 0.0018f, +0.0019f, 0.0020f, 0.0022f, 0.0023f, 0.0025f, 0.0026f, 0.0028f, 0.0030f, +0.0033f, 0.0036f, 0.0039f, 0.0042f, 0.0046f, 0.0050f, 0.0056f, 0.0061f, +0.0068f, 0.0076f, 0.0086f, 0.0097f, 0.0110f, 0.0125f, 0.0144f, 0.0167f, +0.0194f, 0.0226f, 0.0265f, 0.0309f, 0.0359f, 0.0409f, 0.0455f, 0.0488f, +0.0500f +}; +static const float glorentz59[45] = { +0.0011f, 0.0012f, 0.0012f, 0.0013f, 0.0013f, 0.0014f, 0.0015f, 0.0016f, +0.0016f, 0.0017f, 0.0018f, 0.0019f, 0.0021f, 0.0022f, 0.0023f, 0.0025f, +0.0026f, 0.0028f, 0.0030f, 0.0033f, 0.0035f, 0.0038f, 0.0041f, 0.0045f, +0.0049f, 0.0054f, 0.0059f, 0.0065f, 0.0072f, 0.0081f, 0.0090f, 0.0102f, +0.0115f, 0.0130f, 0.0149f, 0.0171f, 0.0197f, 0.0227f, 0.0263f, 0.0302f, +0.0345f, 0.0387f, 0.0425f, 0.0451f, 0.0460f +}; +static const float glorentz60[49] = { +0.0010f, 0.0011f, 0.0011f, 0.0012f, 0.0012f, 0.0013f, 0.0013f, 0.0014f, +0.0014f, 0.0015f, 0.0016f, 0.0017f, 0.0018f, 0.0019f, 0.0020f, 0.0021f, +0.0022f, 0.0024f, 0.0025f, 0.0027f, 0.0028f, 0.0030f, 0.0033f, 0.0035f, +0.0038f, 0.0041f, 0.0044f, 0.0048f, 0.0052f, 0.0057f, 0.0063f, 0.0069f, +0.0077f, 0.0085f, 0.0095f, 0.0106f, 0.0119f, 0.0135f, 0.0153f, 0.0174f, +0.0199f, 0.0227f, 0.0259f, 0.0293f, 0.0330f, 0.0365f, 0.0395f, 0.0415f, +0.0423f +}; +static const float glorentz61[53] = { +0.0009f, 0.0010f, 0.0010f, 0.0011f, 0.0011f, 0.0011f, 0.0012f, 0.0012f, +0.0013f, 0.0014f, 0.0014f, 0.0015f, 0.0016f, 0.0016f, 0.0017f, 0.0018f, +0.0019f, 0.0020f, 0.0021f, 0.0023f, 0.0024f, 0.0025f, 0.0027f, 0.0029f, +0.0031f, 0.0033f, 0.0035f, 0.0038f, 0.0041f, 0.0044f, 0.0047f, 0.0051f, +0.0056f, 0.0061f, 0.0067f, 0.0073f, 0.0081f, 0.0089f, 0.0099f, 0.0110f, +0.0124f, 0.0139f, 0.0156f, 0.0176f, 0.0199f, 0.0225f, 0.0253f, 0.0283f, +0.0314f, 0.0343f, 0.0367f, 0.0383f, 0.0389f +}; +static const float glorentz62[57] = { +0.0009f, 0.0009f, 0.0009f, 0.0010f, 0.0010f, 0.0011f, 0.0011f, 0.0011f, +0.0012f, 0.0012f, 0.0013f, 0.0013f, 0.0014f, 0.0015f, 0.0015f, 0.0016f, +0.0017f, 0.0018f, 0.0019f, 0.0020f, 0.0021f, 0.0022f, 0.0023f, 0.0024f, +0.0026f, 0.0027f, 0.0029f, 0.0031f, 0.0033f, 0.0035f, 0.0038f, 0.0040f, +0.0043f, 0.0047f, 0.0050f, 0.0055f, 0.0059f, 0.0064f, 0.0070f, 0.0077f, +0.0085f, 0.0093f, 0.0103f, 0.0114f, 0.0127f, 0.0142f, 0.0158f, 0.0177f, +0.0198f, 0.0221f, 0.0246f, 0.0272f, 0.0297f, 0.0321f, 0.0340f, 0.0353f, +0.0357f +}; +static const float glorentz63[62] = { +0.0008f, 0.0008f, 0.0009f, 0.0009f, 0.0009f, 0.0010f, 0.0010f, 0.0010f, +0.0011f, 0.0011f, 0.0011f, 0.0012f, 0.0012f, 0.0013f, 0.0013f, 0.0014f, +0.0015f, 0.0015f, 0.0016f, 0.0017f, 0.0017f, 0.0018f, 0.0019f, 0.0020f, +0.0021f, 0.0022f, 0.0023f, 0.0025f, 0.0026f, 0.0028f, 0.0029f, 0.0031f, +0.0033f, 0.0035f, 0.0038f, 0.0040f, 0.0043f, 0.0046f, 0.0050f, 0.0053f, +0.0058f, 0.0062f, 0.0068f, 0.0074f, 0.0081f, 0.0088f, 0.0097f, 0.0106f, +0.0117f, 0.0130f, 0.0144f, 0.0159f, 0.0176f, 0.0195f, 0.0216f, 0.0237f, +0.0259f, 0.0280f, 0.0299f, 0.0315f, 0.0325f, 0.0328f +}; +static const float glorentz64[65] = { +0.0008f, 0.0008f, 0.0008f, 0.0009f, 0.0009f, 0.0009f, 0.0010f, 0.0010f, +0.0010f, 0.0011f, 0.0011f, 0.0012f, 0.0012f, 0.0012f, 0.0013f, 0.0013f, +0.0014f, 0.0014f, 0.0015f, 0.0016f, 0.0016f, 0.0017f, 0.0018f, 0.0019f, +0.0020f, 0.0021f, 0.0022f, 0.0023f, 0.0024f, 0.0025f, 0.0027f, 0.0028f, +0.0030f, 0.0031f, 0.0033f, 0.0035f, 0.0038f, 0.0040f, 0.0043f, 0.0046f, +0.0049f, 0.0052f, 0.0056f, 0.0061f, 0.0066f, 0.0071f, 0.0077f, 0.0084f, +0.0091f, 0.0100f, 0.0109f, 0.0120f, 0.0132f, 0.0145f, 0.0159f, 0.0175f, +0.0192f, 0.0209f, 0.0228f, 0.0246f, 0.0264f, 0.0279f, 0.0291f, 0.0299f, +0.0301f +}; +static const float *gptr_tab_lorentz[64] = { +glorentz1, glorentz2, glorentz3, glorentz4, +glorentz5, glorentz6, glorentz7, glorentz8, +glorentz9, glorentz10, glorentz11, glorentz12, +glorentz13, glorentz14, glorentz15, glorentz16, +glorentz17, glorentz18, glorentz19, glorentz20, +glorentz21, glorentz22, glorentz23, glorentz24, +glorentz25, glorentz26, glorentz27, glorentz28, +glorentz29, glorentz30, glorentz31, glorentz32, +glorentz33, glorentz34, glorentz35, glorentz36, +glorentz37, glorentz38, glorentz39, glorentz40, +glorentz41, glorentz42, glorentz43, glorentz44, +glorentz45, glorentz46, glorentz47, glorentz48, +glorentz49, glorentz50, glorentz51, glorentz52, +glorentz53, glorentz54, glorentz55, glorentz56, +glorentz57, glorentz58, glorentz59, glorentz60, +glorentz61, glorentz62, glorentz63, glorentz64 +}; diff --git a/wsjtx_lib/lib/qra/q65/genq65.f90 b/wsjtx_lib/lib/qra/q65/genq65.f90 new file mode 100644 index 0000000..4c55574 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/genq65.f90 @@ -0,0 +1,51 @@ +subroutine genq65(msg0,ichk,msgsent,itone,i3,n3) + +! Encodes a Q65 message to yield itone(1:85) + + use packjt77 + character*37 msg0 !Message to be generated + character*37 msgsent !Message as it will be received + character*77 c77 + logical unpk77_success + integer itone(85) !QRA64 uses only 84 + integer dgen(13) + integer sent(63) + integer isync(22) + data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + save + + if(msg0(1:1).eq.'@') then + read(msg0(2:5),*,end=1,err=1) nfreq + go to 2 +1 nfreq=1000 +2 itone(1)=nfreq + write(msgsent,1000) nfreq +1000 format(i5,' Hz') + goto 999 + endif + i3=-1 + n3=-1 + call pack77(msg0,i3,n3,c77) + read(c77(60:74),'(b15)') ng15 + if(ng15.eq.32373) c77(60:74)='111111010010011' !Message is RR73 + call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent + read(c77,1001) dgen +1001 format(12b6.6,b5.5) + dgen(13)=2*dgen(13) !Convert 77-bit to 78-bit payload + if(ichk.eq.1) go to 999 !Return if checking only + call q65_enc(dgen,sent) !Encode message, dgen(1:13) ==> sent(1:63) + + j=1 + k=0 + do i=1,85 + if(i.eq.isync(j)) then + j=j+1 !Index for next sync symbol + itone(i)=0 !Insert sync symbol at tone 0 + else + k=k+1 + itone(i)=sent(k) + 1 !Q65 symbol=0 is transmitted at tone 1, etc. + endif + enddo + +999 return +end subroutine genq65 diff --git a/wsjtx_lib/lib/qra/q65/normrnd.c b/wsjtx_lib/lib/qra/q65/normrnd.c new file mode 100644 index 0000000..90abfa4 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/normrnd.c @@ -0,0 +1,82 @@ +// normrnd.c +// functions to generate gaussian distributed numbers +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// +// Credits to Andrea Montefusco - IW0HDV for his help on adapting the sources +// to OSs other than MS Windows +// +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + + +#include "normrnd.h" + +#if _WIN32 // note the underscore: without it, it's not msdn official! + // Windows (x64 and x86) + #include // required only for GetTickCount(...) + #define K_RAND_MAX UINT_MAX +#elif _SVID_SOURCE || _XOPEN_SOURCE || __unix__ || (defined (__APPLE__) && defined(__MACH__)) /* POSIX or Unix or Apple */ + #include + #define rand_s(x) (*x)=(unsigned int)lrand48() // returns unsigned integers in the range 0..0x7FFFFFFF + #define K_RAND_MAX 0x7FFFFFFF // that's the max number + // generated by lrand48 +#else + #error "No good quality PRNG found" +#endif + + +// use MS rand_s(...) function +void normrnd_s(float *dst, int nitems, float mean, float stdev) +{ + unsigned int r; + float phi=0, u=0; + int set = 0; + + while (nitems--) + if (set==1) { + *dst++ = (float)sin(phi)*u*stdev+mean; + set = 0; + } + else { + rand_s((unsigned int*)&r); phi = (M_2PI/(1.0f+K_RAND_MAX))*r; + rand_s((unsigned int*)&r); u = (float)sqrt(-2.0f* log( (1.0f/(1.0f+K_RAND_MAX))*(1.0f+r) ) ); + *dst++ = (float)cos(phi)*u*stdev+mean; + set=1; + } +} + +/* NOT USED +// use MS rand() function +void normrnd(float *dst, int nitems, float mean, float stdev) +{ + float phi=0, u=0; + int set = 0; + + while (nitems--) + if (set==1) { + *dst++ = (float)sin(phi)*u*stdev+mean; + set = 0; + } + else { + phi = (M_2PI/(1.0f+RAND_MAX))*rand(); + u = (float)sqrt(-2.0f* log( (1.0f/(1.0f+RAND_MAX))*(1.0f+rand()) ) ); + *dst++ = (float)cos(phi)*u*stdev+mean; + set=1; + } +} +*/ diff --git a/wsjtx_lib/lib/qra/q65/normrnd.h b/wsjtx_lib/lib/qra/q65/normrnd.h new file mode 100644 index 0000000..dd4b65b --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/normrnd.h @@ -0,0 +1,51 @@ +// normrnd.h +// Functions to generate gaussian distributed numbers +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _normrnd_h_ +#define _normrnd_h_ + +#define _CRT_RAND_S +#include + +#define _USE_MATH_DEFINES +#include +#define M_2PI (2.0f*(float)M_PI) + +#ifdef __cplusplus +extern "C" { +#endif + +void normrnd_s(float *dst, int nitems, float mean, float stdev); +// generate a random array of numbers with a gaussian distribution of given mean and stdev +// use MS rand_s(...) function + +/* not used +void normrnd(float *dst, int nitems, float mean, float stdev); +// generate a random array of numbers with a gaussian distribution of given mean and stdev +// use MS rand() function +*/ + +#ifdef __cplusplus +} +#endif + +#endif // _normrnd_h_ + diff --git a/wsjtx_lib/lib/qra/q65/npfwht.c b/wsjtx_lib/lib/qra/q65/npfwht.c new file mode 100644 index 0000000..5732ce9 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/npfwht.c @@ -0,0 +1,216 @@ +// npfwht.c +// Basic implementation of the Fast Walsh-Hadamard Transforms +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (repeat and accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "npfwht.h" + +#define WHBFY(dst,src,base,offs,dist) { dst[base+offs]=src[base+offs]+src[base+offs+dist]; dst[base+offs+dist]=src[base+offs]-src[base+offs+dist]; } + +typedef void (*pnp_fwht)(float*,float*); + +static void np_fwht2(float *dst, float *src); + +static void np_fwht1(float *dst, float *src); +static void np_fwht2(float *dst, float *src); +static void np_fwht4(float *dst, float *src); +static void np_fwht8(float *dst, float *src); +static void np_fwht16(float *dst, float *src); +static void np_fwht32(float *dst, float *src); +static void np_fwht64(float *dst, float *src); + +static pnp_fwht np_fwht_tab[7] = { + np_fwht1, + np_fwht2, + np_fwht4, + np_fwht8, + np_fwht16, + np_fwht32, + np_fwht64 +}; + +void np_fwht(int nlogdim, float *dst, float *src) +{ + np_fwht_tab[nlogdim](dst,src); +} + +static void np_fwht1(float *dst, float *src) +{ + dst[0] = src[0]; +} + + +static void np_fwht2(float *dst, float *src) +{ + float t[2]; + + WHBFY(t,src,0,0,1); + dst[0]= t[0]; + dst[1]= t[1]; +} + +static void np_fwht4(float *dst, float *src) +{ + float t[4]; + + // group 1 + WHBFY(t,src,0,0,2); WHBFY(t,src,0,1,2); + // group 2 + WHBFY(dst,t,0,0,1); WHBFY(dst,t,2,0,1); +}; + + +static void np_fwht8(float *dst, float *src) +{ + float t[16]; + float *t1=t, *t2=t+8; + + // group 1 + WHBFY(t1,src,0,0,4); WHBFY(t1,src,0,1,4); WHBFY(t1,src,0,2,4); WHBFY(t1,src,0,3,4); + // group 2 + WHBFY(t2,t1,0,0,2); WHBFY(t2,t1,0,1,2); WHBFY(t2,t1,4,0,2); WHBFY(t2,t1,4,1,2); + // group 3 + WHBFY(dst,t2,0,0,1); WHBFY(dst,t2,2,0,1); WHBFY(dst,t2,4,0,1); WHBFY(dst,t2,6,0,1); +}; + + +static void np_fwht16(float *dst, float *src) +{ + float t[32]; + float *t1=t, *t2=t+16; + + // group 1 + WHBFY(t1,src,0,0,8); WHBFY(t1,src,0,1,8); WHBFY(t1,src,0,2,8); WHBFY(t1,src,0,3,8); + WHBFY(t1,src,0,4,8); WHBFY(t1,src,0,5,8); WHBFY(t1,src,0,6,8); WHBFY(t1,src,0,7,8); + // group 2 + WHBFY(t2,t1,0,0,4); WHBFY(t2,t1,0,1,4); WHBFY(t2,t1,0,2,4); WHBFY(t2,t1,0,3,4); + WHBFY(t2,t1,8,0,4); WHBFY(t2,t1,8,1,4); WHBFY(t2,t1,8,2,4); WHBFY(t2,t1,8,3,4); + // group 3 + WHBFY(t1,t2,0,0,2); WHBFY(t1,t2,0,1,2); WHBFY(t1,t2,4,0,2); WHBFY(t1,t2,4,1,2); + WHBFY(t1,t2,8,0,2); WHBFY(t1,t2,8,1,2); WHBFY(t1,t2,12,0,2); WHBFY(t1,t2,12,1,2); + // group 4 + WHBFY(dst,t1,0,0,1); WHBFY(dst,t1,2,0,1); WHBFY(dst,t1,4,0,1); WHBFY(dst,t1,6,0,1); + WHBFY(dst,t1,8,0,1); WHBFY(dst,t1,10,0,1); WHBFY(dst,t1,12,0,1); WHBFY(dst,t1,14,0,1); + +} + +static void np_fwht32(float *dst, float *src) +{ + float t[64]; + float *t1=t, *t2=t+32; + + // group 1 + WHBFY(t1,src,0,0,16); WHBFY(t1,src,0,1,16); WHBFY(t1,src,0,2,16); WHBFY(t1,src,0,3,16); + WHBFY(t1,src,0,4,16); WHBFY(t1,src,0,5,16); WHBFY(t1,src,0,6,16); WHBFY(t1,src,0,7,16); + WHBFY(t1,src,0,8,16); WHBFY(t1,src,0,9,16); WHBFY(t1,src,0,10,16); WHBFY(t1,src,0,11,16); + WHBFY(t1,src,0,12,16); WHBFY(t1,src,0,13,16); WHBFY(t1,src,0,14,16); WHBFY(t1,src,0,15,16); + + // group 2 + WHBFY(t2,t1,0,0,8); WHBFY(t2,t1,0,1,8); WHBFY(t2,t1,0,2,8); WHBFY(t2,t1,0,3,8); + WHBFY(t2,t1,0,4,8); WHBFY(t2,t1,0,5,8); WHBFY(t2,t1,0,6,8); WHBFY(t2,t1,0,7,8); + WHBFY(t2,t1,16,0,8); WHBFY(t2,t1,16,1,8); WHBFY(t2,t1,16,2,8); WHBFY(t2,t1,16,3,8); + WHBFY(t2,t1,16,4,8); WHBFY(t2,t1,16,5,8); WHBFY(t2,t1,16,6,8); WHBFY(t2,t1,16,7,8); + + // group 3 + WHBFY(t1,t2,0,0,4); WHBFY(t1,t2,0,1,4); WHBFY(t1,t2,0,2,4); WHBFY(t1,t2,0,3,4); + WHBFY(t1,t2,8,0,4); WHBFY(t1,t2,8,1,4); WHBFY(t1,t2,8,2,4); WHBFY(t1,t2,8,3,4); + WHBFY(t1,t2,16,0,4); WHBFY(t1,t2,16,1,4); WHBFY(t1,t2,16,2,4); WHBFY(t1,t2,16,3,4); + WHBFY(t1,t2,24,0,4); WHBFY(t1,t2,24,1,4); WHBFY(t1,t2,24,2,4); WHBFY(t1,t2,24,3,4); + + // group 4 + WHBFY(t2,t1,0,0,2); WHBFY(t2,t1,0,1,2); WHBFY(t2,t1,4,0,2); WHBFY(t2,t1,4,1,2); + WHBFY(t2,t1,8,0,2); WHBFY(t2,t1,8,1,2); WHBFY(t2,t1,12,0,2); WHBFY(t2,t1,12,1,2); + WHBFY(t2,t1,16,0,2); WHBFY(t2,t1,16,1,2); WHBFY(t2,t1,20,0,2); WHBFY(t2,t1,20,1,2); + WHBFY(t2,t1,24,0,2); WHBFY(t2,t1,24,1,2); WHBFY(t2,t1,28,0,2); WHBFY(t2,t1,28,1,2); + + // group 5 + WHBFY(dst,t2,0,0,1); WHBFY(dst,t2,2,0,1); WHBFY(dst,t2,4,0,1); WHBFY(dst,t2,6,0,1); + WHBFY(dst,t2,8,0,1); WHBFY(dst,t2,10,0,1); WHBFY(dst,t2,12,0,1); WHBFY(dst,t2,14,0,1); + WHBFY(dst,t2,16,0,1); WHBFY(dst,t2,18,0,1); WHBFY(dst,t2,20,0,1); WHBFY(dst,t2,22,0,1); + WHBFY(dst,t2,24,0,1); WHBFY(dst,t2,26,0,1); WHBFY(dst,t2,28,0,1); WHBFY(dst,t2,30,0,1); + +} + +static void np_fwht64(float *dst, float *src) +{ + float t[128]; + float *t1=t, *t2=t+64; + + + // group 1 + WHBFY(t1,src,0,0,32); WHBFY(t1,src,0,1,32); WHBFY(t1,src,0,2,32); WHBFY(t1,src,0,3,32); + WHBFY(t1,src,0,4,32); WHBFY(t1,src,0,5,32); WHBFY(t1,src,0,6,32); WHBFY(t1,src,0,7,32); + WHBFY(t1,src,0,8,32); WHBFY(t1,src,0,9,32); WHBFY(t1,src,0,10,32); WHBFY(t1,src,0,11,32); + WHBFY(t1,src,0,12,32); WHBFY(t1,src,0,13,32); WHBFY(t1,src,0,14,32); WHBFY(t1,src,0,15,32); + WHBFY(t1,src,0,16,32); WHBFY(t1,src,0,17,32); WHBFY(t1,src,0,18,32); WHBFY(t1,src,0,19,32); + WHBFY(t1,src,0,20,32); WHBFY(t1,src,0,21,32); WHBFY(t1,src,0,22,32); WHBFY(t1,src,0,23,32); + WHBFY(t1,src,0,24,32); WHBFY(t1,src,0,25,32); WHBFY(t1,src,0,26,32); WHBFY(t1,src,0,27,32); + WHBFY(t1,src,0,28,32); WHBFY(t1,src,0,29,32); WHBFY(t1,src,0,30,32); WHBFY(t1,src,0,31,32); + + // group 2 + WHBFY(t2,t1,0,0,16); WHBFY(t2,t1,0,1,16); WHBFY(t2,t1,0,2,16); WHBFY(t2,t1,0,3,16); + WHBFY(t2,t1,0,4,16); WHBFY(t2,t1,0,5,16); WHBFY(t2,t1,0,6,16); WHBFY(t2,t1,0,7,16); + WHBFY(t2,t1,0,8,16); WHBFY(t2,t1,0,9,16); WHBFY(t2,t1,0,10,16); WHBFY(t2,t1,0,11,16); + WHBFY(t2,t1,0,12,16); WHBFY(t2,t1,0,13,16); WHBFY(t2,t1,0,14,16); WHBFY(t2,t1,0,15,16); + + WHBFY(t2,t1,32,0,16); WHBFY(t2,t1,32,1,16); WHBFY(t2,t1,32,2,16); WHBFY(t2,t1,32,3,16); + WHBFY(t2,t1,32,4,16); WHBFY(t2,t1,32,5,16); WHBFY(t2,t1,32,6,16); WHBFY(t2,t1,32,7,16); + WHBFY(t2,t1,32,8,16); WHBFY(t2,t1,32,9,16); WHBFY(t2,t1,32,10,16); WHBFY(t2,t1,32,11,16); + WHBFY(t2,t1,32,12,16); WHBFY(t2,t1,32,13,16); WHBFY(t2,t1,32,14,16); WHBFY(t2,t1,32,15,16); + + // group 3 + WHBFY(t1,t2,0,0,8); WHBFY(t1,t2,0,1,8); WHBFY(t1,t2,0,2,8); WHBFY(t1,t2,0,3,8); + WHBFY(t1,t2,0,4,8); WHBFY(t1,t2,0,5,8); WHBFY(t1,t2,0,6,8); WHBFY(t1,t2,0,7,8); + WHBFY(t1,t2,16,0,8); WHBFY(t1,t2,16,1,8); WHBFY(t1,t2,16,2,8); WHBFY(t1,t2,16,3,8); + WHBFY(t1,t2,16,4,8); WHBFY(t1,t2,16,5,8); WHBFY(t1,t2,16,6,8); WHBFY(t1,t2,16,7,8); + WHBFY(t1,t2,32,0,8); WHBFY(t1,t2,32,1,8); WHBFY(t1,t2,32,2,8); WHBFY(t1,t2,32,3,8); + WHBFY(t1,t2,32,4,8); WHBFY(t1,t2,32,5,8); WHBFY(t1,t2,32,6,8); WHBFY(t1,t2,32,7,8); + WHBFY(t1,t2,48,0,8); WHBFY(t1,t2,48,1,8); WHBFY(t1,t2,48,2,8); WHBFY(t1,t2,48,3,8); + WHBFY(t1,t2,48,4,8); WHBFY(t1,t2,48,5,8); WHBFY(t1,t2,48,6,8); WHBFY(t1,t2,48,7,8); + + // group 4 + WHBFY(t2,t1,0,0,4); WHBFY(t2,t1,0,1,4); WHBFY(t2,t1,0,2,4); WHBFY(t2,t1,0,3,4); + WHBFY(t2,t1,8,0,4); WHBFY(t2,t1,8,1,4); WHBFY(t2,t1,8,2,4); WHBFY(t2,t1,8,3,4); + WHBFY(t2,t1,16,0,4); WHBFY(t2,t1,16,1,4); WHBFY(t2,t1,16,2,4); WHBFY(t2,t1,16,3,4); + WHBFY(t2,t1,24,0,4); WHBFY(t2,t1,24,1,4); WHBFY(t2,t1,24,2,4); WHBFY(t2,t1,24,3,4); + WHBFY(t2,t1,32,0,4); WHBFY(t2,t1,32,1,4); WHBFY(t2,t1,32,2,4); WHBFY(t2,t1,32,3,4); + WHBFY(t2,t1,40,0,4); WHBFY(t2,t1,40,1,4); WHBFY(t2,t1,40,2,4); WHBFY(t2,t1,40,3,4); + WHBFY(t2,t1,48,0,4); WHBFY(t2,t1,48,1,4); WHBFY(t2,t1,48,2,4); WHBFY(t2,t1,48,3,4); + WHBFY(t2,t1,56,0,4); WHBFY(t2,t1,56,1,4); WHBFY(t2,t1,56,2,4); WHBFY(t2,t1,56,3,4); + + // group 5 + WHBFY(t1,t2,0,0,2); WHBFY(t1,t2,0,1,2); WHBFY(t1,t2,4,0,2); WHBFY(t1,t2,4,1,2); + WHBFY(t1,t2,8,0,2); WHBFY(t1,t2,8,1,2); WHBFY(t1,t2,12,0,2); WHBFY(t1,t2,12,1,2); + WHBFY(t1,t2,16,0,2); WHBFY(t1,t2,16,1,2); WHBFY(t1,t2,20,0,2); WHBFY(t1,t2,20,1,2); + WHBFY(t1,t2,24,0,2); WHBFY(t1,t2,24,1,2); WHBFY(t1,t2,28,0,2); WHBFY(t1,t2,28,1,2); + WHBFY(t1,t2,32,0,2); WHBFY(t1,t2,32,1,2); WHBFY(t1,t2,36,0,2); WHBFY(t1,t2,36,1,2); + WHBFY(t1,t2,40,0,2); WHBFY(t1,t2,40,1,2); WHBFY(t1,t2,44,0,2); WHBFY(t1,t2,44,1,2); + WHBFY(t1,t2,48,0,2); WHBFY(t1,t2,48,1,2); WHBFY(t1,t2,52,0,2); WHBFY(t1,t2,52,1,2); + WHBFY(t1,t2,56,0,2); WHBFY(t1,t2,56,1,2); WHBFY(t1,t2,60,0,2); WHBFY(t1,t2,60,1,2); + + // group 6 + WHBFY(dst,t1,0,0,1); WHBFY(dst,t1,2,0,1); WHBFY(dst,t1,4,0,1); WHBFY(dst,t1,6,0,1); + WHBFY(dst,t1,8,0,1); WHBFY(dst,t1,10,0,1); WHBFY(dst,t1,12,0,1); WHBFY(dst,t1,14,0,1); + WHBFY(dst,t1,16,0,1); WHBFY(dst,t1,18,0,1); WHBFY(dst,t1,20,0,1); WHBFY(dst,t1,22,0,1); + WHBFY(dst,t1,24,0,1); WHBFY(dst,t1,26,0,1); WHBFY(dst,t1,28,0,1); WHBFY(dst,t1,30,0,1); + WHBFY(dst,t1,32,0,1); WHBFY(dst,t1,34,0,1); WHBFY(dst,t1,36,0,1); WHBFY(dst,t1,38,0,1); + WHBFY(dst,t1,40,0,1); WHBFY(dst,t1,42,0,1); WHBFY(dst,t1,44,0,1); WHBFY(dst,t1,46,0,1); + WHBFY(dst,t1,48,0,1); WHBFY(dst,t1,50,0,1); WHBFY(dst,t1,52,0,1); WHBFY(dst,t1,54,0,1); + WHBFY(dst,t1,56,0,1); WHBFY(dst,t1,58,0,1); WHBFY(dst,t1,60,0,1); WHBFY(dst,t1,62,0,1); +} \ No newline at end of file diff --git a/wsjtx_lib/lib/qra/q65/npfwht.h b/wsjtx_lib/lib/qra/q65/npfwht.h new file mode 100644 index 0000000..9452e20 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/npfwht.h @@ -0,0 +1,45 @@ +// np_fwht.h +// Basic implementation of the Fast Walsh-Hadamard Transforms +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (repeat and accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _npfwht_h_ +#define _npfwht_h_ + +#ifdef __cplusplus +extern "C" { +#endif + +void np_fwht(int nlogdim, float *dst, float *src); +// Compute the Walsh-Hadamard transform of the given data up to a +// 64-dimensional transform +// +// Input parameters: +// nlogdim: log2 of the transform size. Must be in the range [0..6] +// src : pointer to the input data buffer. +// dst : pointer to the output data buffer. +// +// src and dst must point to preallocated data buffers of size 2^nlogdim*sizeof(float) +// src and dst buffers can overlap + +#ifdef __cplusplus +} +#endif + +#endif // _npfwht_ diff --git a/wsjtx_lib/lib/qra/q65/pdmath.c b/wsjtx_lib/lib/qra/q65/pdmath.c new file mode 100644 index 0000000..47ecab9 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/pdmath.c @@ -0,0 +1,385 @@ +// pdmath.c +// Elementary math on probability distributions +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "pdmath.h" + +typedef const float *ppd_uniform; +typedef void (*ppd_imul)(float*,const float*); +typedef float (*ppd_norm)(float*); + +// define vector size in function of its logarithm in base 2 +static const int pd_log2dim[7] = { + 1,2,4,8,16,32,64 +}; + +// define uniform distributions of given size +static const float pd_uniform1[1] = { + 1. +}; +static const float pd_uniform2[2] = { + 1./2., 1./2. +}; +static const float pd_uniform4[4] = { + 1./4., 1./4.,1./4., 1./4. +}; +static const float pd_uniform8[8] = { + 1./8., 1./8.,1./8., 1./8.,1./8., 1./8.,1./8., 1./8. +}; +static const float pd_uniform16[16] = { + 1./16., 1./16., 1./16., 1./16.,1./16., 1./16.,1./16., 1./16., + 1./16., 1./16., 1./16., 1./16.,1./16., 1./16.,1./16., 1./16. +}; +static const float pd_uniform32[32] = { + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32., + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32., + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32., + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32. +}; +static const float pd_uniform64[64] = { + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64. + +}; + +static const ppd_uniform pd_uniform_tab[7] = { + pd_uniform1, + pd_uniform2, + pd_uniform4, + pd_uniform8, + pd_uniform16, + pd_uniform32, + pd_uniform64 +}; + +// returns a pointer to the uniform distribution of the given logsize +const float *pd_uniform(int nlogdim) +{ + return pd_uniform_tab[nlogdim]; +} + +// in-place multiplication functions +// compute dst = dst*src for any element of the distrib + +static void pd_imul1(float *dst, const float *src) +{ + dst[0] *= src[0]; +} + +static void pd_imul2(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; +} +static void pd_imul4(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; + dst[2] *= src[2]; dst[3] *= src[3]; +} +static void pd_imul8(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; dst[2] *= src[2]; dst[3] *= src[3]; + dst[4] *= src[4]; dst[5] *= src[5]; dst[6] *= src[6]; dst[7] *= src[7]; +} +static void pd_imul16(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; dst[2] *= src[2]; dst[3] *= src[3]; + dst[4] *= src[4]; dst[5] *= src[5]; dst[6] *= src[6]; dst[7] *= src[7]; + dst[8] *= src[8]; dst[9] *= src[9]; dst[10]*= src[10]; dst[11]*= src[11]; + dst[12]*= src[12]; dst[13]*= src[13]; dst[14]*= src[14]; dst[15]*= src[15]; +} +static void pd_imul32(float *dst, const float *src) +{ + pd_imul16(dst,src); + pd_imul16(dst+16,src+16); +} +static void pd_imul64(float *dst, const float *src) +{ + pd_imul16(dst, src); + pd_imul16(dst+16, src+16); + pd_imul16(dst+32, src+32); + pd_imul16(dst+48, src+48); +} + +static const ppd_imul pd_imul_tab[7] = { + pd_imul1, + pd_imul2, + pd_imul4, + pd_imul8, + pd_imul16, + pd_imul32, + pd_imul64 +}; + +// in place multiplication +// compute dst = dst*src for any element of the distrib give their log2 size +// arguments must be pointers to array of floats of the given size +void pd_imul(float *dst, const float *src, int nlogdim) +{ + pd_imul_tab[nlogdim](dst,src); +} + +static float pd_norm1(float *ppd) +{ + float t = ppd[0]; + ppd[0] = 1.f; + return t; +} + +static float pd_norm2(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; + + if (t<=0) { + pd_init(ppd,pd_uniform(1),pd_log2dim[1]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; + return to; + +} + +static float pd_norm4(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + + if (t<=0) { + pd_init(ppd,pd_uniform(2),pd_log2dim[2]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + return to; +} + +static float pd_norm8(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + + if (t<=0) { + pd_init(ppd,pd_uniform(3),pd_log2dim[3]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + return to; +} +static float pd_norm16(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + t +=ppd[8]; t +=ppd[9]; t +=ppd[10]; t +=ppd[11]; + t +=ppd[12]; t +=ppd[13]; t +=ppd[14]; t +=ppd[15]; + + if (t<=0) { + pd_init(ppd,pd_uniform(4),pd_log2dim[4]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + ppd[8] *=t; ppd[9] *=t; ppd[10] *=t; ppd[11] *=t; + ppd[12] *=t; ppd[13] *=t; ppd[14] *=t; ppd[15] *=t; + + return to; +} +static float pd_norm32(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + t +=ppd[8]; t +=ppd[9]; t +=ppd[10]; t +=ppd[11]; + t +=ppd[12]; t +=ppd[13]; t +=ppd[14]; t +=ppd[15]; + t +=ppd[16]; t +=ppd[17]; t +=ppd[18]; t +=ppd[19]; + t +=ppd[20]; t +=ppd[21]; t +=ppd[22]; t +=ppd[23]; + t +=ppd[24]; t +=ppd[25]; t +=ppd[26]; t +=ppd[27]; + t +=ppd[28]; t +=ppd[29]; t +=ppd[30]; t +=ppd[31]; + + if (t<=0) { + pd_init(ppd,pd_uniform(5),pd_log2dim[5]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + ppd[8] *=t; ppd[9] *=t; ppd[10] *=t; ppd[11] *=t; + ppd[12] *=t; ppd[13] *=t; ppd[14] *=t; ppd[15] *=t; + ppd[16] *=t; ppd[17] *=t; ppd[18] *=t; ppd[19] *=t; + ppd[20] *=t; ppd[21] *=t; ppd[22] *=t; ppd[23] *=t; + ppd[24] *=t; ppd[25] *=t; ppd[26] *=t; ppd[27] *=t; + ppd[28] *=t; ppd[29] *=t; ppd[30] *=t; ppd[31] *=t; + + return to; +} + +static float pd_norm64(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + t +=ppd[8]; t +=ppd[9]; t +=ppd[10]; t +=ppd[11]; + t +=ppd[12]; t +=ppd[13]; t +=ppd[14]; t +=ppd[15]; + t +=ppd[16]; t +=ppd[17]; t +=ppd[18]; t +=ppd[19]; + t +=ppd[20]; t +=ppd[21]; t +=ppd[22]; t +=ppd[23]; + t +=ppd[24]; t +=ppd[25]; t +=ppd[26]; t +=ppd[27]; + t +=ppd[28]; t +=ppd[29]; t +=ppd[30]; t +=ppd[31]; + + t +=ppd[32]; t +=ppd[33]; t +=ppd[34]; t +=ppd[35]; + t +=ppd[36]; t +=ppd[37]; t +=ppd[38]; t +=ppd[39]; + t +=ppd[40]; t +=ppd[41]; t +=ppd[42]; t +=ppd[43]; + t +=ppd[44]; t +=ppd[45]; t +=ppd[46]; t +=ppd[47]; + t +=ppd[48]; t +=ppd[49]; t +=ppd[50]; t +=ppd[51]; + t +=ppd[52]; t +=ppd[53]; t +=ppd[54]; t +=ppd[55]; + t +=ppd[56]; t +=ppd[57]; t +=ppd[58]; t +=ppd[59]; + t +=ppd[60]; t +=ppd[61]; t +=ppd[62]; t +=ppd[63]; + + if (t<=0) { + pd_init(ppd,pd_uniform(6),pd_log2dim[6]); + return t; + } + + to = t; + t = 1.0f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + ppd[8] *=t; ppd[9] *=t; ppd[10] *=t; ppd[11] *=t; + ppd[12] *=t; ppd[13] *=t; ppd[14] *=t; ppd[15] *=t; + ppd[16] *=t; ppd[17] *=t; ppd[18] *=t; ppd[19] *=t; + ppd[20] *=t; ppd[21] *=t; ppd[22] *=t; ppd[23] *=t; + ppd[24] *=t; ppd[25] *=t; ppd[26] *=t; ppd[27] *=t; + ppd[28] *=t; ppd[29] *=t; ppd[30] *=t; ppd[31] *=t; + + ppd[32] *=t; ppd[33] *=t; ppd[34] *=t; ppd[35] *=t; + ppd[36] *=t; ppd[37] *=t; ppd[38] *=t; ppd[39] *=t; + ppd[40] *=t; ppd[41] *=t; ppd[42] *=t; ppd[43] *=t; + ppd[44] *=t; ppd[45] *=t; ppd[46] *=t; ppd[47] *=t; + ppd[48] *=t; ppd[49] *=t; ppd[50] *=t; ppd[51] *=t; + ppd[52] *=t; ppd[53] *=t; ppd[54] *=t; ppd[55] *=t; + ppd[56] *=t; ppd[57] *=t; ppd[58] *=t; ppd[59] *=t; + ppd[60] *=t; ppd[61] *=t; ppd[62] *=t; ppd[63] *=t; + + return to; +} + + +static const ppd_norm pd_norm_tab[7] = { + pd_norm1, + pd_norm2, + pd_norm4, + pd_norm8, + pd_norm16, + pd_norm32, + pd_norm64 +}; + +float pd_norm(float *pd, int nlogdim) +{ + return pd_norm_tab[nlogdim](pd); +} + +void pd_memset(float *dst, const float *src, int ndim, int nitems) +{ + int size = PD_SIZE(ndim); + while(nitems--) { + memcpy(dst,src,size); + dst +=ndim; + } +} + +void pd_fwdperm(float *dst, float *src, const int *perm, int ndim) +{ + // TODO: non-loop implementation + while (ndim--) + dst[ndim] = src[perm[ndim]]; +} + +void pd_bwdperm(float *dst, float *src, const int *perm, int ndim) +{ + // TODO: non-loop implementation + while (ndim--) + dst[perm[ndim]] = src[ndim]; +} + +float pd_max(float *src, int ndim) +{ + // TODO: faster implementation + + float cmax=0; // we assume that prob distributions are always positive + float cval; + + while (ndim--) { + cval = src[ndim]; + if (cval>=cmax) { + cmax = cval; + } + } + + return cmax; +} + +int pd_argmax(float *pmax, float *src, int ndim) +{ + // TODO: faster implementation + + float cmax=0; // we assume that prob distributions are always positive + float cval; + int idxmax=-1; // indicates that all pd elements are <0 + + while (ndim--) { + cval = src[ndim]; + if (cval>=cmax) { + cmax = cval; + idxmax = ndim; + } + } + + if (pmax) + *pmax = cmax; + + return idxmax; +} diff --git a/wsjtx_lib/lib/qra/q65/pdmath.h b/wsjtx_lib/lib/qra/q65/pdmath.h new file mode 100644 index 0000000..bbd1210 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/pdmath.h @@ -0,0 +1,85 @@ +// pdmath.h +// Elementary math on probability distributions +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (repeat and accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + + +#ifndef _pdmath_h_ +#define _pdmath_h_ + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#define PD_NDIM(nlogdim) ((1<<(nlogdim)) +#define PD_SIZE(ndim) ((ndim)*sizeof(float)) +#define PD_ROWADDR(fp,ndim,idx) (fp+((ndim)*(idx))) + +const float *pd_uniform(int nlogdim); +// Returns a pointer to a (constant) uniform distribution of the given log2 size + +#define pd_init(dst,src,ndim) memcpy(dst,src,PD_SIZE(ndim)) +// Distribution copy + +void pd_memset(float *dst, const float *src, int ndim, int nitems); +// Copy the distribution pointed by src to the array of distributions dst +// src is a pointer to the input distribution (a vector of size ndim) +// dst is a pointer to a linear array of distributions (a vector of size ndim*nitems) + +void pd_imul(float *dst, const float *src, int nlogdim); +// In place multiplication +// Compute dst = dst*src for any element of the distrib give their log2 size +// src and dst arguments must be pointers to array of floats of the given size + +float pd_norm(float *pd, int nlogdim); +// In place normalizazion +// Normalizes the input vector so that the sum of its components are one +// pd must be a pointer to an array of floats of the given size. +// If the norm of the input vector is non-positive the vector components +// are replaced with a uniform distribution +// Returns the norm of the distribution prior to the normalization + +void pd_fwdperm(float *dst, float *src, const int *perm, int ndim); +// Forward permutation of a distribution +// Computes dst[k] = src[perm[k]] for every element in the distribution +// perm must be a pointer to an array of integers of length ndim + +void pd_bwdperm(float *dst, float *src, const int *perm, int ndim); +// Backward permutation of a distribution +// Computes dst[perm[k]] = src[k] for every element in the distribution +// perm must be a pointer to an array of integers of length ndim + +float pd_max(float *src, int ndim); +// Return the maximum of the elements of the given distribution +// Assumes that the input vector is a probability distribution and that each element in the +// distribution is non negative + +int pd_argmax(float *pmax, float *src, int ndim); +// Return the index of the maximum element of the given distribution +// The maximum is stored in the variable pointed by pmax if pmax is not null +// Same note of pd_max applies. +// Return -1 if all the elements in the distribution are negative + +#ifdef __cplusplus +} +#endif + +#endif // _pdmath_h_ diff --git a/wsjtx_lib/lib/qra/q65/q65.c b/wsjtx_lib/lib/qra/q65/q65.c new file mode 100644 index 0000000..10d756d --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65.c @@ -0,0 +1,889 @@ +// q65.c +// q65 modes encoding/decoding functions +// +// (c) 2020 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include +#include +#include + +#include "q65.h" +#include "pdmath.h" + +// Minimum codeword loglikelihood for decoding +#define Q65_LLH_THRESHOLD -260.0f + +// This value produce the same WER performance in decode_fullaplist +// #define Q65_LLH_THRESHOLD -262.0f + + +static int _q65_crc6(int *x, int sz); +static void _q65_crc12(int *y, int *x, int sz); + +float q65_llh; + +int q65_init(q65_codec_ds *pCodec, const qracode *pqracode) +{ + // Eb/No value for which we optimize the decoder metric (AWGN/Rayleigh cases) + const float EbNodBMetric = 2.8f; + const float EbNoMetric = (float)pow(10,EbNodBMetric/10); + + float R; // code effective rate (after puncturing) + int nm; // bits per symbol + + if (!pCodec) + return -1; // why do you called me? + + if (!pqracode) + return -2; // invalid qra code + + if (pqracode->M!=64) + return -3; // q65 supports only codes over GF(64) + + pCodec->pQraCode = pqracode; + + // allocate buffers used by encoding/decoding functions + pCodec->x = (int*)malloc(pqracode->K*sizeof(int)); + pCodec->y = (int*)malloc(pqracode->N*sizeof(int)); + pCodec->qra_v2cmsg = (float*)malloc(pqracode->NMSG*pqracode->M*sizeof(float)); + pCodec->qra_c2vmsg = (float*)malloc(pqracode->NMSG*pqracode->M*sizeof(float)); + pCodec->ix = (float*)malloc(pqracode->N*pqracode->M*sizeof(float)); + pCodec->ex = (float*)malloc(pqracode->N*pqracode->M*sizeof(float)); + + if (pCodec->x== NULL || + pCodec->y== NULL || + pCodec->qra_v2cmsg== NULL || + pCodec->qra_c2vmsg== NULL || + pCodec->ix== NULL || + pCodec->ex== NULL) { + q65_free(pCodec); + return -4; // out of memory + } + + // compute and store the AWGN/Rayleigh Es/No ratio for which we optimize + // the decoder metric + nm = _q65_get_bits_per_symbol(pqracode); + R = _q65_get_code_rate(pqracode); + pCodec->decoderEsNoMetric = 1.0f*nm*R*EbNoMetric; + + return 1; +} + +void q65_free(q65_codec_ds *pCodec) +{ + if (!pCodec) + return; + + // free internal buffers + if (pCodec->x!=NULL) + free(pCodec->x); + + if (pCodec->y!=NULL) + free(pCodec->y); + + if (pCodec->qra_v2cmsg!=NULL) + free(pCodec->qra_v2cmsg); + + if (pCodec->qra_c2vmsg!=NULL) + free(pCodec->qra_c2vmsg); + + if (pCodec->ix!=NULL) + free(pCodec->ix); + + if (pCodec->ex!=NULL) + free(pCodec->ex); + + pCodec->pQraCode = NULL; + pCodec->x = NULL; + pCodec->y = NULL; + pCodec->qra_v2cmsg = NULL; + pCodec->qra_c2vmsg = NULL; + pCodec->qra_v2cmsg = NULL; + pCodec->ix = NULL; + pCodec->ex = NULL; + + return; +} + +int q65_encode(const q65_codec_ds *pCodec, int *pOutputCodeword, const int *pInputMsg) +{ + const qracode *pQraCode; + int *px; + int *py; + int nK; + int nN; + + if (!pCodec) + return -1; // which codec? + + pQraCode = pCodec->pQraCode; + px = pCodec->x; + py = pCodec->y; + nK = _q65_get_message_length(pQraCode); + nN = _q65_get_codeword_length(pQraCode); + + // copy the information symbols into the internal buffer + memcpy(px,pInputMsg,nK*sizeof(int)); + + // compute and append the appropriate CRC if required + switch (pQraCode->type) { + case QRATYPE_NORMAL: + break; + case QRATYPE_CRC: + case QRATYPE_CRCPUNCTURED: + px[nK] = _q65_crc6(px,nK); + break; + case QRATYPE_CRCPUNCTURED2: + _q65_crc12(px+nK,px,nK); + break; + default: + return -2; // code type not supported + } + + // encode with the given qra code + qra_encode(pQraCode,py,px); + + // puncture the CRC symbols as required + // and copy the result to the destination buffer + switch (pQraCode->type) { + case QRATYPE_NORMAL: + case QRATYPE_CRC: + // no puncturing + memcpy(pOutputCodeword,py,nN*sizeof(int)); + break; + case QRATYPE_CRCPUNCTURED: + // strip the single CRC symbol from the encoded codeword + memcpy(pOutputCodeword,py,nK*sizeof(int)); // copy the systematic symbols + memcpy(pOutputCodeword+nK,py+nK+1,(nN-nK)*sizeof(int)); // copy the check symbols skipping the CRC symbol + break; + case QRATYPE_CRCPUNCTURED2: + // strip the 2 CRC symbols from the encoded codeword + memcpy(pOutputCodeword,py,nK*sizeof(int)); // copy the systematic symbols + memcpy(pOutputCodeword+nK,py+nK+2,(nN-nK)*sizeof(int)); // copy the check symbols skipping the two CRC symbols + break; + default: + return -2; // code type unsupported + } + + return 1; // ok +} + +int q65_intrinsics(q65_codec_ds *pCodec, float *pIntrinsics, const float *pInputEnergies) +{ + // compute observations intrinsics probabilities + // for the AWGN/Rayleigh channels + + // NOTE: + // A true Rayleigh channel metric would require that the channel gains were known + // for each symbol in the codeword. Such gains cannot be estimated reliably when + // the Es/No ratio is small. Therefore we compute intrinsic probabilities assuming + // that, on average, these channel gains are unitary. + // In general it is even difficult to estimate the Es/No ratio for the AWGN channel + // Therefore we always compute the intrinsic probabilities assuming that the Es/No + // ratio is known and equal to the constant decoderEsNoMetric. This assumption will + // generate the true intrinsic probabilities only when the actual Eb/No ratio is + // equal to this constant. As in all the other cases the probabilities are evaluated + // with a wrong scaling constant we can expect that the decoder performance at different + // Es/No will be worse. Anyway, since the EsNoMetric constant has been chosen so that the + // decoder error rate is about 50%, we obtain almost optimal error rates down to + // any useful Es/No ratio. + + const qracode *pQraCode; + int nN, nBits; + float EsNoMetric; + + if (pCodec==NULL) + return -1; // which codec? + + pQraCode = pCodec->pQraCode; + nN = _q65_get_codeword_length(pQraCode); + nBits = pQraCode->m; + + EsNoMetric = pCodec->decoderEsNoMetric; + qra_mfskbesselmetric(pIntrinsics,pInputEnergies,nBits,nN,EsNoMetric); + + return 1; // success +} + +int q65_esnodb(const q65_codec_ds *pCodec, float *pEsNodB, const int *ydec, const float *pInputEnergies) +{ + // compute average Es/No for the AWGN/Rayleigh channel cases + + int k,j; + float sigplusnoise=0; + float noise=0; + int nN, nM; + const float *pIn = pInputEnergies; + const int *py = ydec; + float EsNodB; + + nN = q65_get_codeword_length(pCodec); + nM = q65_get_alphabet_size(pCodec); + + for (k=0;k4) + return Q65_DECODE_INVPARAMS; // invalid submode + + // As the symbol duration in q65 is different than in QRA64, + // the fading tables continue to be valid if the B90Ts parameter + // is properly scaled to the QRA64 symbol interval + // Compute index to most appropriate weighting function coefficients + B90 = B90Ts/TS_QRA64; + hidx = (int)(logf(B90)/logf(1.09f) - 0.499f); + + // Unlike in QRA64 we accept any B90, anyway limiting it to + // the extreme cases (0.9 to 210 Hz approx.) + if (hidx<0) + hidx = 0; + else + if (hidx > 63) //Changed by K1JT: previously max was 64. + hidx=63; //Changed by K1JT: previously max was 64. + + // select the appropriate weighting fading coefficients array + if (fadingModel==0) { // gaussian fading model + // point to gaussian energy weighting taps + hlen = glen_tab_gauss[hidx]; // hlen = (L+1)/2 (where L=(odd) number of taps of w fun) + hptr = gptr_tab_gauss[hidx]; // pointer to the first (L+1)/2 coefficients of w fun + } + else if (fadingModel==1) { + // point to lorentzian energy weighting taps + hlen = glen_tab_lorentz[hidx]; // hlen = (L+1)/2 (where L=(odd) number of taps of w fun) + hptr = gptr_tab_lorentz[hidx]; // pointer to the first (L+1)/2 coefficients of w fun + } + else + return Q65_DECODE_INVPARAMS; // invalid fading model + + // compute (euristically) the optimal decoder metric accordingly the given spread amount + // We assume that the decoder 50% decoding threshold is: + // Es/No(dB) = Es/No(AWGN)(dB) + 8*log(B90)/log(240)(dB) + // that's to say, at the maximum Doppler spread bandwidth (240 Hz for QRA64) + // there's a ~8 dB Es/No degradation over the AWGN case + fTemp = 8.0f*logf(B90)/logf(240.0f); // assumed Es/No degradation for the given fading bandwidth + EsNoMetric = pCodec->decoderEsNoMetric*powf(10.0f,fTemp/10.0f); + + nM = q65_get_alphabet_size(pCodec); + nN = q65_get_codeword_length(pCodec); + nBinsPerTone = 1<ffNoiseVar = fNoiseVar; + pCodec->ffEsNoMetric = EsNoMetric; + pCodec->nBinsPerTone = nBinsPerTone; + pCodec->nBinsPerSymbol = nBinsPerSymbol; + pCodec->nWeights = hlen; + weight = pCodec->ffWeight; + + // compute the fast fading weights accordingly to the Es/No ratio + // for which we compute the exact intrinsics probabilities + for (k=0;kmaxlogp) // keep track of the max + maxlogp = fTemp; + pCurIx[k]=fTemp; + + pCurBin += nBinsPerTone; // next tone + } + + // exponentiate and accumulate the normalization constant + sumix = 0.0f; + for (k=0;k 85.0) x= 85.0; + fTemp = expf(x); + pCurIx[k]=fTemp; + sumix +=fTemp; + } + + // scale to a probability distribution + sumix = 1.0f/sumix; + for (k=0;knBinsPerTone; + nBinsPerSymbol = pCodec->nBinsPerSymbol; + nWeights = pCodec->nWeights; + ffNoiseVar = pCodec->ffNoiseVar; + ffEsNoMetric = pCodec->ffEsNoMetric; + nTotWeights = 2*nWeights-1; + + // compute symbols energy (noise included) summing the + // energies pertaining to the decoded symbols in the codeword + + EsPlusWNo = 0.0f; + pCurSym = pInputEnergies + nM; // point to first central bin of first symbol tone + for (n=0;npQraCode; + ix = pCodec->ix; + ex = pCodec->ex; + + nK = _q65_get_message_length(pQraCode); + nN = _q65_get_codeword_length(pQraCode); + nM = pQraCode->M; + nBits = pQraCode->m; + + px = pCodec->x; + py = pCodec->y; + + // Depuncture intrinsics observations as required by the code type + switch (pQraCode->type) { + case QRATYPE_CRCPUNCTURED: + memcpy(ix,pIntrinsics,nK*nM*sizeof(float)); // information symbols + pd_init(PD_ROWADDR(ix,nM,nK),pd_uniform(nBits),nM); // crc + memcpy(ix+(nK+1)*nM,pIntrinsics+nK*nM,(nN-nK)*nM*sizeof(float)); // parity checks + break; + case QRATYPE_CRCPUNCTURED2: + memcpy(ix,pIntrinsics,nK*nM*sizeof(float)); // information symbols + pd_init(PD_ROWADDR(ix,nM,nK),pd_uniform(nBits),nM); // crc + pd_init(PD_ROWADDR(ix,nM,nK+1),pd_uniform(nBits),nM); // crc + memcpy(ix+(nK+2)*nM,pIntrinsics+nK*nM,(nN-nK)*nM*sizeof(float)); // parity checks + break; + case QRATYPE_NORMAL: + case QRATYPE_CRC: + default: + // no puncturing + memcpy(ix,pIntrinsics,nN*nM*sizeof(float)); // as they are + } + + // mask the intrinsics with the available a priori knowledge + if (pAPMask!=NULL) + _q65_mask(pQraCode,ix,pAPMask,pAPSymbols); + + + // Compute the extrinsic symbols probabilities with the message-passing algorithm + // Stop if the extrinsics information does not converges to unity + // within the given number of iterations + rc = qra_extrinsic( pQraCode, + ex, + ix, + maxiters, + pCodec->qra_v2cmsg, + pCodec->qra_c2vmsg); + + if (rc<0) + // failed to converge to a solution + return Q65_DECODE_FAILED; + + // decode the information symbols (punctured information symbols included) + qra_mapdecode(pQraCode,px,ex,ix); + + // verify CRC match + + switch (pQraCode->type) { + case QRATYPE_CRC: + case QRATYPE_CRCPUNCTURED: + crc6=_q65_crc6(px,nK); // compute crc-6 + if (crc6!=px[nK]) + return Q65_DECODE_CRCMISMATCH; // crc doesn't match + break; + case QRATYPE_CRCPUNCTURED2: + _q65_crc12(crc12, px,nK); // compute crc-12 + if (crc12[0]!=px[nK] || + crc12[1]!=px[nK+1]) + return Q65_DECODE_CRCMISMATCH; // crc doesn't match + break; + case QRATYPE_NORMAL: + default: + // nothing to check + break; + } + + // copy the decoded msg to the user buffer (excluding punctured symbols) + if (pDecodedMsg) + memcpy(pDecodedMsg,px,nK*sizeof(int)); + +#ifndef Q65_CHECKLLH + if (pDecodedCodeword==NULL) // user is not interested in the decoded codeword + return rc; // return the number of iterations required to decode +#else + if (pDecodedCodeword==NULL) // we must have a buffer + return Q65_DECODE_INVPARAMS; // return error +#endif + + // crc matches therefore we can reconstruct the transmitted codeword + // reencoding the information available in px... + + qra_encode(pQraCode, py, px); + + // ...and strip the punctured symbols from the codeword + switch (pQraCode->type) { + case QRATYPE_CRCPUNCTURED: + memcpy(pDecodedCodeword,py,nK*sizeof(int)); + memcpy(pDecodedCodeword+nK,py+nK+1,(nN-nK)*sizeof(int)); // puncture crc-6 symbol + break; + case QRATYPE_CRCPUNCTURED2: + memcpy(pDecodedCodeword,py,nK*sizeof(int)); + memcpy(pDecodedCodeword+nK,py+nK+2,(nN-nK)*sizeof(int)); // puncture crc-12 symbols + break; + case QRATYPE_CRC: + case QRATYPE_NORMAL: + default: + memcpy(pDecodedCodeword,py,nN*sizeof(int)); // no puncturing + } + +#ifdef Q65_CHECKLLH + if (q65_check_llh(NULL,pDecodedCodeword, nN, nM, pIntrinsics)==0) // llh less than threshold + return Q65_DECODE_LLHLOW; +#endif + + return rc; // return the number of iterations required to decode + +} + + +// Compute and verify the loglikelihood of the decoded codeword +int q65_check_llh(float *llh, const int* ydec, const int nN, const int nM, const float *pIntrin) +{ + int k; + float t = 0; + + for (k=0;k=Q65_LLH_THRESHOLD); +} + +// Full AP decoding from a list of codewords +int q65_decode_fullaplist(q65_codec_ds *codec, + int *ydec, + int *xdec, + const float *pIntrinsics, + const int *pCodewords, + const int nCodewords) +{ + int k; + int nK, nN, nM; + + float llh, maxllh, llh_threshold; + int maxcw = -1; // index of the most likely codeword + const int *pCw; + + if (nCodewords<1 || nCodewords>Q65_FULLAPLIST_SIZE) + return Q65_DECODE_INVPARAMS; // invalid list length + + nK = q65_get_message_length(codec); + nN = q65_get_codeword_length(codec); + nM = q65_get_alphabet_size(codec); + + // we adjust the llh threshold in order to mantain the + // same false decode rate independently from the size + // of the list + llh_threshold = Q65_LLH_THRESHOLD + logf(1.0f*nCodewords/3); + maxllh = llh_threshold; // at least one llh should be larger than the threshold + + // compute codewords log likelihoods and find max + pCw = pCodewords; // start from the first codeword + for (k=0;kmaxllh) { + maxllh = llh; + maxcw = k; + } + // printf("BBB %d %f\n",k,llh); + // point to next codeword + pCw+=nN; + } + + q65_llh=maxllh; // save for Joe's use + + if (maxcw<0) // no llh larger than threshold found + return Q65_DECODE_FAILED; + + pCw = pCodewords+nN*maxcw; + memcpy(ydec,pCw,nN*sizeof(int)); + memcpy(xdec,pCw,nK*sizeof(int)); + + return maxcw; // index to the decoded message (>=0) + +} + + +// helper functions ------------------------------------------------------------- + +int _q65_get_message_length(const qracode *pCode) +{ + // return the actual information message length (in symbols) + // excluding any punctured symbol + + int nMsgLength; + + switch (pCode->type) { + case QRATYPE_NORMAL: + nMsgLength = pCode->K; + break; + case QRATYPE_CRC: + case QRATYPE_CRCPUNCTURED: + // one information symbol of the underlying qra code is reserved for CRC + nMsgLength = pCode->K-1; + break; + case QRATYPE_CRCPUNCTURED2: + // two code information symbols are reserved for CRC + nMsgLength = pCode->K-2; + break; + default: + nMsgLength = -1; + } + + return nMsgLength; +} + +int _q65_get_codeword_length(const qracode *pCode) +{ + // return the actual codeword length (in symbols) + // excluding any punctured symbol + + int nCwLength; + + switch (pCode->type) { + case QRATYPE_NORMAL: + case QRATYPE_CRC: + // no puncturing + nCwLength = pCode->N; + break; + case QRATYPE_CRCPUNCTURED: + // the CRC symbol is punctured + nCwLength = pCode->N-1; + break; + case QRATYPE_CRCPUNCTURED2: + // the two CRC symbols are punctured + nCwLength = pCode->N-2; + break; + default: + nCwLength = -1; + } + + return nCwLength; +} + +float _q65_get_code_rate(const qracode *pCode) +{ + return 1.0f*_q65_get_message_length(pCode)/_q65_get_codeword_length(pCode); +} + +int _q65_get_alphabet_size(const qracode *pCode) +{ + return pCode->M; +} +int _q65_get_bits_per_symbol(const qracode *pCode) +{ + return pCode->m; +} +static void _q65_mask(const qracode *pcode, float *ix, const int *mask, const int *x) +{ + // mask intrinsic information ix with available a priori knowledge + + int k,kk, smask; + const int nM=pcode->M; + const int nm=pcode->m; + int nK; + + // Exclude from masking the symbols which have been punctured. + // nK is the length of the mask and x arrays, which do + // not include any punctured symbol + nK = _q65_get_message_length(pcode); + + // for each symbol set to zero the probability + // of the values which are not allowed by + // the a priori information + + for (k=0;k>1) ^ CRC6_GEN_POL; + else + sr = (sr>>1); + t>>=1; + } + } + + return sr; +} + +static void _q65_crc12(int *y, int *x, int sz) +{ + int k,j,t,sr = 0; + for (k=0;k>1) ^ CRC12_GEN_POL; + else + sr = (sr>>1); + t>>=1; + } + } + + y[0] = sr&0x3F; + y[1] = (sr>>6); +} diff --git a/wsjtx_lib/lib/qra/q65/q65.f90 b/wsjtx_lib/lib/qra/q65/q65.f90 new file mode 100644 index 0000000..94eb60c --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65.f90 @@ -0,0 +1,928 @@ +module q65 + + parameter (NSTEP=8) !Number of time bins per symbol in s1, s1a, s1b + parameter (PLOG_MIN=-242.0) !List decoding threshold + integer iz0,jz0 +! integer listutc(10) + integer apsym0(58),aph10(10) + integer apmask1(78),apsymbols1(78) + integer apmask(13),apsymbols(13) + integer,dimension(22) :: isync = (/1,9,12,13,15,22,23,26,27,33,35, & + 38,46,50,55,60,62,66,69,74,76,85/) + integer codewords(63,206) + integer ibwa,ibwb,ncw,nsps,mode_q65,nfa,nfb,nqd + integer idfbest,idtbest,ibw,ndistbest,maxiters,max_drift + integer istep,nsmo,lag1,lag2,npasses,iseq,ncand,nrc + integer i0,j0 + integer navg(0:1) + logical lnewdat + real candidates(20,3) !snr, xdt, and f0 of top candidates + real, allocatable :: s1raw(:,:) !Symbol spectra, 1/8-symbol steps + real, allocatable :: s1(:,:) !Symbol spectra w/suppressed peaks + real, allocatable :: s1w(:,:) !Symbol spectra w/suppressed peaks (W3SZ) + real, allocatable,save :: s1a(:,:,:) !Cumulative symbol spectra + real, allocatable,save :: ccf2(:) !Max CCF(freq) at any lag (orange curve) + real, allocatable,save :: ccf2_avg(:) !Like ccf2, but for avg (red curve) + real sync(85) !sync vector + real df,dtstep,dtdec,f0dec,ftol,plog,drift + +contains + +subroutine q65_dec0(iavg,iwave,ntrperiod,nfqso,ntol,lclearave, & + emedelay,xdt,f0,snr1,width,dat4,snr2,idec,stageno) + +! Top-level routine in q65 module +! - Compute symbol spectra +! - Attempt sync and q3 decode using all 85 symbols +! - If that fails, try sync with 22 symbols and standard q[0124] decode + +! Input: iavg 0 for single-period decode, 1 for average +! iwave(0:nmax-1) Raw data +! ntrperiod T/R sequence length (s) +! nfqso Target frequency (Hz) +! ntol Search range around nfqso (Hz) +! lclearave Flag to clear the accumulating array +! emedelay Extra delay for EME signals +! Output: xdt Time offset from nominal (s) +! f0 Frequency of sync tone +! snr1 Relative SNR of sync signal +! width Estimated Doppler spread +! dat4(13) Decoded message as 13 six-bit integers +! snr2 Estimated SNR of decoded signal +! idec Flag for decoding results +! -1 No decode +! 0 No AP +! 1 "CQ ? ?" +! 2 "Mycall ? ?" +! 3 "MyCall HisCall ?" + + use packjt77 + use timer_module, only: timer + + parameter (LN=2176*63) !LN=LL*NN; LL=64*(mode_q65+2), NN=63 + integer*2 iwave(0:12000*ntrperiod-1) !Raw data + integer dat4(13) + character*37 decoded + logical first,lclearave + real, allocatable :: s3(:,:) !Data-symbol energies s3(LL,63) + real, allocatable :: ccf1(:) !CCF(freq) at fixed lag (red) + data first/.true./ + save first,LL0 + + integer w3t + integer w3f + integer mm + integer stageno + + NN=63 + +! Set some parameters and allocate storage for large arrays + irc=-2 + nrc=-2 + idec=-1 + snr1=0. + dat4=0 + LL=64*(2+mode_q65) + nfft=nsps + df=12000.0/nfft !Freq resolution = baud + istep=nsps/NSTEP + iz=5000.0/df !Uppermost frequency bin, at 5000 Hz + txt=85.0*nsps/12000.0 + jz=(txt+1.0)*12000.0/istep !Number of symbol/NSTEP bins + if(nsps.ge.6912) jz=(txt+2.0)*12000.0/istep !For TR 60 s and higher + ftol=ntol + ia=ntol/df + ia2=max(ia,10*mode_q65,nint(100.0/df)) +! nsmo=int(0.7*mode_q65*mode_q65) + nsmo=int(0.5*mode_q65*mode_q65) + if(nsmo.lt.1) nsmo=1 + if(first) then !Generate the sync vector + sync=-22.0/63.0 !Sync tone OFF + do k=1,22 + sync(isync(k))=1.0 !Sync tone ON + enddo + endif + + allocate(s3(-64:LL-65,63)) + allocate(ccf1(-ia2:ia2)) + if(LL.ne.LL0 .or. iz.ne.iz0 .or. jz.ne.jz0 .or. lclearave) then + if(allocated(s1raw)) deallocate(s1raw) + allocate(s1raw(iz,jz)) + if(allocated(s1)) deallocate(s1) + allocate(s1(iz,jz)) + if(allocated(s1a)) deallocate(s1a) + allocate(s1a(iz,jz,0:1)) + if(allocated(ccf2)) deallocate(ccf2) + allocate(ccf2(iz)) + if(allocated(ccf2_avg)) deallocate(ccf2_avg) + allocate(ccf2_avg(iz)) + s1=0. + s1a=0. + navg=0 + LL0=LL + iz0=iz + jz0=jz + lclearave=.false. + endif + ccf1=0. + if(iavg.eq.0) ccf2=0. + dtstep=nsps/(NSTEP*12000.0) !Step size in seconds + lag1=-1.0/dtstep + lag2=1.0/dtstep + 0.9999 + if(nsps.ge.3600 .and. emedelay.gt.0) lag2=5.5/dtstep + 0.9999 !Include EME + j0=0.5/dtstep + if(nsps.ge.7200) j0=1.0/dtstep !Nominal start-signal index + + s3=0. +! if(iavg.eq.0 .and. lnewdat) then + if(iavg.eq.0) then + call timer('q65_syms',0) +! Compute symbol spectra with NSTEP time bins per symbol + call q65_symspec(iwave,ntrperiod*12000,iz,jz,s1) + call timer('q65_syms',1) +! lnewdat=.false. + else + s1=s1a(:,:,iseq) + endif + + i0=nint(nfqso/df) !Target QSO frequency + ii1=max(1,i0-64) + ii2=i0-65+LL + call pctile(s1(ii1:ii2,1:jz),ii2-ii1+1*jz,45,base) +! s1=s1/base + s1raw=s1 + +! Apply fast AGC to the symbol spectra +! s1max=20.0 !Empirical choice +! do j=1,jz !### Maybe wrong way? ### +! smax=maxval(s1(ii1:ii2,j)) +! if(smax.gt.s1max) s1(ii1:ii2,j)=s1(ii1:ii2,j)*s1max/smax +! enddo + + dat4=0 + if(ncw.gt.0 .and. iavg.le.1) then +! Try list decoding via "Deep Likelihood". + call timer('ccf_85 ',0) +! Try to synchronize using all 85 symbols + call q65_ccf_85(s1,iz,jz,nfqso,ia,ia2,ipk,jpk,f0,xdt,imsg_best, & + better,ccf1) + call timer('ccf_85 ',1) + + if(better.ge.1.10 .or. mode_q65.ge.8) then + call timer('list_dec',0) + call q65_dec_q3(s1,iz,jz,s3,LL,ipk,jpk,snr2,dat4,idec,decoded) + call timer('list_dec',1) + endif +! If idec=3 we have a q3 decode. Continue to compute sync curve for plotting. + endif + +! Get 2d CCF and ccf2 using sync symbols only + if(iavg.eq.0) then + call timer('ccf_22a ',0) + call q65_ccf_22(s1,iz,jz,nfqso,ntol,iavg,ipk,jpk, & + f0a,xdta,ccf2) + call timer('ccf_22a ',1) + endif + +! Get 2d CCF and ccf2_avg using sync symbols only + if(iavg.ge.1) then + call timer('ccf_22b ',0) + call q65_ccf_22(s1,iz,jz,nfqso,ntol,iavg,ipk,jpk, & + f0a,xdta,ccf2_avg) + call timer('ccf_22b ',1) + endif + if(idec.lt.0) then + f0=f0a + xdt=xdta + endif + +! Estimate rms on ccf2 baseline + call q65_sync_curve(ccf2,1,iz,rms2) + smax=maxval(ccf2) + snr1=0. + if(rms2.gt.0) snr1=smax/rms2 + + if(idec.le.0) then +! The q3 decode attempt failed. Copy synchronized symbol energies from s1 +! into s3 and prepare to try a more general decode. + call q65_s1_to_s3(s1,iz,jz,ipk,jpk,LL,mode_q65,sync,s3) + endif + + smax=maxval(ccf1) + +! Estimate frequency spread + i1=-9999 + i2=-9999 + do i=-ia,ia + if(i1.eq.-9999 .and. ccf1(i).ge.0.5*smax) i1=i + if(i2.eq.-9999 .and. ccf1(-i).ge.0.5*smax) i2=-i + enddo + width=df*(i2-i1) + if(ncw.eq.0) ccf1=0. + call q65_write_red(iz,xdt,ccf2_avg,ccf2) !### Need this call for WSJT-X + + if(idec.lt.0 .and. (iavg.eq.0 .or. iavg.eq.2)) then + call q65_dec_q012(s3,LL,snr2,dat4,idec,decoded) + endif + + if(idec.lt.0 .and. max_drift.eq.50 .and. stageno.eq.5) then + + if(allocated(s1w)) deallocate(s1w) ! w3sz + allocate(s1w(iz,jz)) ! w3sz + + s1w=s1 + do w3t=1,jz + do w3f=1,iz + mm=w3f + nint(drift*w3t/(jz*df)) + if(mm.ge.1 .and. mm.le.iz) then + s1w(w3f,w3t)=s1(mm,w3t) + endif + end do + end do + + if(ncw.gt.0 .and. iavg.le.1) then + ! Try list decoding via "Deep Likelihood". + call timer('ccf_85 ',0) + ! Try to synchronize using all 85 symbols + call q65_ccf_85(s1w,iz,jz,nfqso,ia,ia2,ipk,jpk,f0,xdt,imsg_best, & + better,ccf1) + call timer('ccf_85 ',1) + +! nsubmode is Tone-spacing indicator, 0-4 for A-E: a 0; b 1; c 2; d 3; e 4. +! and mode_q65=2**nsubmode + if(better.ge.1.10) then + ! if(better.ge.1.04 .or. mode_q65.ge.8) then + ! if(better.ge.1.10 .or. mode_q65.ge.8) then ORIGINAL + call timer('list_dec',0) + call q65_dec_q3(s1w,iz,jz,s3,LL,ipk,jpk,snr2,dat4,idec,decoded) + call timer('list_dec',1) + endif ! if(better.ge.1.10) + endif ! if(ncw.gt.0 .and. iavg.le.1) + ! If idec=3 we have a q3 decode. Continue to compute sync curve for plotting. + + if(idec.eq.3) then + idec=5 + endif + + endif ! if(idec.lt.0 .and. max_drift.eq.50 .and. stageno.eq.5) + + return +end subroutine q65_dec0 + +subroutine q65_clravg + +! Clear the averaging array to start a new average. + + if(allocated(s1a)) s1a(:,:,iseq)=0. + navg(iseq)=0 + + return +end subroutine q65_clravg + +subroutine q65_symspec(iwave,nmax,iz,jz,s1) + +! Compute symbol spectra with NSTEP time-steps per symbol. + + integer*2 iwave(0:nmax-1) !Raw data + real s1(iz,jz) + complex, allocatable :: c0(:) !Complex spectrum of symbol + + allocate(c0(0:nsps-1)) + nfft=nsps + fac=1/32767.0 + do j=1,jz,2 !Compute symbol spectra at 2*step size + i1=(j-1)*istep + i2=i1+nsps-1 + k=-1 + do i=i1,i2,2 !Load iwave data into complex array c0, for r2c FFT + xx=iwave(i) + yy=iwave(i+1) + k=k+1 + c0(k)=fac*cmplx(xx,yy) + enddo + c0(k+1:)=0. + call four2a(c0,nfft,1,-1,0) !r2c FFT + do i=1,iz + s1(i,j)=real(c0(i))**2 + aimag(c0(i))**2 + enddo +! For large Doppler spreads, should we smooth the spectra here? + if(nsmo.le.1) nsmo=0 + do i=1,nsmo + call smo121(s1(1:iz,j),iz) + enddo +! Interpolate to fill in the skipped-over spectra. + if(j.ge.3) s1(1:iz,j-1)=0.5*(s1(1:iz,j-2)+s1(1:iz,j)) + enddo + if(lnewdat) then + navg(iseq)=navg(iseq) + 1 + ntc=min(navg(iseq),4) !Averaging time constant in sequences + u=1.0/ntc + s1a(:,:,iseq)=u*s1 + (1.0-u)*s1a(:,:,iseq) + endif + + return +end subroutine q65_symspec + +subroutine q65_dec_q3(s1,iz,jz,s3,LL,ipk,jpk,snr2,dat4,idec,decoded) + +! Copy synchronized symbol energies from s1 into s3, then attempt a q3 decode. + + character*37 decoded + integer dat4(13) + real s1(iz,jz) + real s3(-64:LL-65,63) + + call q65_s1_to_s3(s1,iz,jz,ipk,jpk,LL,mode_q65,sync,s3) + + nsubmode=0 + if(mode_q65.eq.2) nsubmode=1 + if(mode_q65.eq.4) nsubmode=2 + if(mode_q65.eq.8) nsubmode=3 + if(mode_q65.eq.16) nsubmode=4 + if(mode_q65.eq.32) nsubmode=5 + baud=12000.0/nsps + + do ibw=ibwa,ibwb + b90=1.72**ibw + b90ts=b90/baud + call q65_dec1(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) + nrc=irc + if(irc.ge.0) then + snr2=esnodb - db(2500.0/baud) + 3.0 !Empirical adjustment + idec=3 + exit + endif + enddo + + return +end subroutine q65_dec_q3 + +subroutine q65_dec_q012(s3,LL,snr2,dat4,idec,decoded) + +! Do separate passes attempting q0, q1, q2 decodes. + + character*37 decoded + character*78 c78 + integer dat4(13) + real s3(-64:LL-65,63) + logical lapcqonly + + nsubmode=0 + if(mode_q65.eq.2) nsubmode=1 + if(mode_q65.eq.4) nsubmode=2 + if(mode_q65.eq.8) nsubmode=3 + if(mode_q65.eq.16) nsubmode=4 + + baud=12000.0/nsps + iaptype=0 + nQSOprogress=0 !### TEMPORARY ? ### + ncontest=0 + lapcqonly=.false. + + do ipass=0,npasses !Loop over AP passes + apmask=0 !Try first with no AP information + apsymbols=0 + if(ipass.ge.1) then + ! Subsequent passes use AP information appropiate for nQSOprogress + call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype, & + apsym0,apmask1,apsymbols1) + write(c78,1050) apmask1 +1050 format(78i1) + read(c78,1060) apmask +1060 format(13b6.6) + write(c78,1050) apsymbols1 + read(c78,1060) apsymbols + endif + + do ibw=ibwa,ibwb + b90=1.72**ibw + b90ts=b90/baud + call q65_dec2(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) + nrc=irc + if(irc.ge.0) then + snr2=esnodb - db(2500.0/baud) + 3.0 !Empirical adjustment + idec=iaptype + go to 100 + endif + enddo + enddo + +100 return +end subroutine q65_dec_q012 + +subroutine q65_ccf_85(s1,iz,jz,nfqso,ia,ia2,ipk,jpk,f0,xdt,imsg_best, & + better,ccf1) + +! Attempt synchronization using all 85 symbols, in advance of an +! attempt at q3 decoding. Return ccf1 for the "red sync curve". + + real s1(iz,jz) + real, allocatable :: ccf(:,:) !CCF(freq,lag) + real, allocatable :: best(:) !best(imsg) -- for checking 2nd best + real ccf1(-ia2:ia2) + integer ijpk(2) + integer itone(85) + + allocate(ccf(-ia2:ia2,-53:214)) + allocate(best(ncw)) + ipk=0 + jpk=0 + ccf_best=0. + imsg_best=-1 + do imsg=1,ncw + i=1 + k=0 + do j=1,85 + if(j.eq.isync(i)) then + i=i+1 + itone(j)=0 + else + k=k+1 + itone(j)=codewords(k,imsg) + 1 + endif + enddo + +! Compute 2D ccf using all 85 symbols in the list message + ccf=0. + iia=200.0/df + + do lag=lag1,lag2 + do k=1,85 + j=j0 + NSTEP*(k-1) + 1 + lag + if(j.ge.1 .and. j.le.jz) then + do i=-ia2,ia2 + ii=i0+mode_q65*itone(k)+i + if(ii.ge.iia .and. ii.le.iz) ccf(i,lag)=ccf(i,lag) + s1(ii,j) + enddo + endif + enddo + enddo + + ccfmax=maxval(ccf(-ia:ia,:)) + if(ccfmax.gt.ccf_best) then + ccf_best=ccfmax + ijpk=maxloc(ccf(-ia:ia,:)) + ipk=ijpk(1)-ia-1 + jpk=ijpk(2)-53-1 + f0=nfqso + ipk*df + xdt=jpk*dtstep + imsg_best=imsg + ccf1=ccf(:,jpk) + endif + best(imsg)=ccfmax + enddo ! imsg + + deallocate(ccf) + better=0. + if(imsg_best.gt.0) then + best(imsg_best)=0. + better=ccf_best/maxval(best) + endif + + return +end subroutine q65_ccf_85 + +subroutine q65_ccf_22(s1,iz,jz,nfqso,ntol,iavg,ipk,jpk, & + f0,xdt,ccf2) + +! Attempt synchronization using only the 22 sync symbols. Return ccf2 +! for the "orange sync curve". + + real s1(iz,jz) + real ccf2(iz) !Orange sync curve + real tmp(20,3) + real, allocatable :: xdt2(:) + real, allocatable :: s1avg(:) + integer, allocatable :: indx(:) + + allocate(xdt2(iz)) + allocate(s1avg(iz)) + allocate(indx(iz)) + + ia=max(nfa,100)/df + ib=min(nfb,4900)/df +! if(nqd.ne.1 .or. iavg.ne.0) max_drift=0 !### Disabled March 22, 2023 + if(max_drift.ne.0) then + ia=max(nint(100/df),nint((nfqso-ntol)/df)) + ib=min(nint(4900/df),nint((nfqso+ntol)/df)) + endif + + do i=ia,ib + s1avg(i)=sum(s1(i,1:jz)) + enddo + + call pctile(s1avg(ia:ib),ib-ia+1,40,base0) + ccfbest=0. + ibest=0 + lagpk=0 + lagbest=0 + idrift_max=0 + idrift_best=0 + + do i=ia,ib + ccfmax=0. + do lag=lag1,lag2 + do idrift=-max_drift,max_drift + ccft=0. + do kk=1,22 + k=isync(kk) + ii=i + nint(idrift*(k-43)/85.0) + if(ii.lt.1 .or. ii.gt.iz) cycle + n=NSTEP*(k-1) + 1 + j=n+lag+j0 + if(j.ge.1 .and. j.le.jz) ccft=ccft + s1(ii,j) + enddo ! kk + ccft=ccft - (22.0/jz)*s1avg(i) + if(ccft.gt.ccfmax) then + ccfmax=ccft + lagpk=lag + idrift_max=idrift + endif + enddo ! idrift + enddo ! lag + + ccf2(i)=ccfmax + xdt2(i)=lagpk*dtstep + + if(ccfmax.gt.ccfbest .and. abs(i*df-nfqso).le.ftol) then + ccfbest=ccfmax + snrbest=snr + ibest=i + lagbest=lagpk + idrift_best=idrift_max + endif + enddo ! i + +! Parameters for the top candidate: + ipk=ibest - i0 + jpk=lagbest + f0=nfqso + ipk*df + xdt=jpk*dtstep + drift=df*idrift_best + ccf2(:ia)=0. + ccf2(ib:)=0. + +! Save parameters for best candidates + jzz=ib-ia+1 + call indexx(ccf2(ia:ib),jzz,indx) + + call pctile(ccf2(ia:ib),jzz,50,ave) + call pctile(ccf2(ia:ib),jzz,84,base) + rms=base-ave + ncand=0 + maxcand=20 + do j=1,20 + k=jzz-j+1 + if(k.lt.1 .or. k.gt.iz) cycle + i=indx(k)+ia-1 + f=i*df + i3=max(1, i-mode_q65) + i4=min(iz,i+mode_q65) + biggest=maxval(ccf2(i3:i4)) + if(ccf2(i).ne.biggest) cycle + snr=(ccf2(i)-ave)/rms + if(snr.lt.6.0) exit + ncand=ncand+1 + candidates(ncand,1)=snr + candidates(ncand,2)=xdt2(i) + candidates(ncand,3)=f + if(ncand.ge.maxcand) exit + enddo + +! Resort the candidates back into frequency order + tmp(1:ncand,1:3)=candidates(1:ncand,1:3) + candidates=0. + call indexx(tmp(1:ncand,3),ncand,indx) + do i=1,ncand + candidates(i,1:3)=tmp(indx(i),1:3) + enddo + + return +end subroutine q65_ccf_22 + +subroutine q65_dec1(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) + +! Attmpt a full-AP list decode. + + use packjt77 + real s3(1,1) !Silence compiler warning that wants to see a 2D array + real s3prob(0:63,63) !Symbol-value probabilities + integer dat4(13) + character c77*77,decoded*37 + logical unpk77_success + + nFadingModel=1 + decoded=' ' + call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob) + call q65_dec_fullaplist(s3,s3prob,codewords,ncw,esnodb,dat4,plog,irc) + if(sum(dat4).le.0) irc=-2 + if(irc.ge.0 .and. plog.gt.PLOG_MIN) then + write(c77,1000) dat4(1:12),dat4(13)/2 +1000 format(12b6.6,b5.5) + call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent + else + irc=-1 + endif + nrc=irc + + return +end subroutine q65_dec1 + +subroutine q65_dec2(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) + +! Attempt a q0, q1, or q2 decode using spcified AP information. + + use packjt77 + real s3(iz0,jz0) !Silence compiler warning that wants to see a 2D array + real s3prob(0:63,63) !Symbol-value probabilities + integer dat4(13) + character c77*77,decoded*37 + logical unpk77_success + + nFadingModel=1 + decoded=' ' + call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob) + call q65_dec(s3,s3prob,APmask,APsymbols,maxiters,esnodb,dat4,irc) + if(sum(dat4).le.0) irc=-2 + nrc=irc + if(irc.ge.0) then + write(c77,1000) dat4(1:12),dat4(13)/2 +1000 format(12b6.6,b5.5) + call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent + endif + + return +end subroutine q65_dec2 + +subroutine q65_s1_to_s3(s1,iz,jz,ipk,jpk,LL,mode_q65,sync,s3) + +! Copy synchronized symbol energies from s1 (or s1a) into s3. + + real s1(iz,jz) + real s3(-64:LL-65,63) + real sync(85) !sync vector + + i1=i0+ipk-64 + mode_q65 + i2=i1+LL-1 + if(i1.ge.1 .and. i2.le.iz) then + j=j0+jpk-7 + n=0 + do k=1,85 + j=j+8 + if(sync(k).gt.0.0) then + cycle + endif + n=n+1 + if(j.ge.1 .and. j.le.jz) s3(-64:LL-65,n)=s1(i1:i2,j) + enddo + endif + call q65_bzap(s3,LL) !Zap birdies + + return +end subroutine q65_s1_to_s3 + +subroutine q65_write_red(iz,xdt,ccf2_avg,ccf2) + +! Write data for the red and orange sync curves to LU 17. + + real ccf2_avg(iz) + real ccf2(iz) + + call q65_sync_curve(ccf2_avg,1,iz,rms1) + call q65_sync_curve(ccf2,1,iz,rms2) + + i1=max(1,nint(nfa/df)) + i2=min(iz,int(nfb/df)) + y0=minval(ccf2(i1:i2)) + y0_avg=minval(ccf2_avg(i1:i2)) + g=0.4 + g_avg=0. + if(navg(iseq).ge.2) g_avg=g + rewind 17 + write(17,1000) xdt,g_avg*minval(ccf2_avg),g_avg*maxval(ccf2_avg) + do i=i1,i2 + freq=i*df + y1=g_avg*(ccf2_avg(i)-y0_avg) + y2=g*(ccf2(i)-y0) + write(17,1000) freq,y1,y2 +1000 format(f10.3,2f15.6) + enddo + flush(17) + + return +end subroutine q65_write_red + +subroutine q65_sync_curve(ccf1,ia,ib,rms1) + +! Condition the red or orange sync curve for plotting. + + real ccf1(ia:ib) + + ic=(ib-ia)/8; + nsum=2*(ic+1) + + base1=(sum(ccf1(ia:ia+ic)) + sum(ccf1(ib-ic:ib)))/nsum + ccf1=ccf1-base1 + sq=dot_product(ccf1(ia:ia+ic),ccf1(ia:ia+ic)) + & + dot_product(ccf1(ib-ic:ib),ccf1(ib-ic:ib)) + rms1=0. + if(nsum.gt.0) rms1=sqrt(sq/nsum) + if(rms1.gt.0.0) ccf1=ccf1/rms1 +! smax1=maxval(ccf1) +! if(smax1.gt.10.0) ccf1=10.0*ccf1/smax1 + + return +end subroutine q65_sync_curve + +subroutine q65_bzap(s3,LL) + + parameter (NBZAP=15) + real s3(-64:LL-65,63) + integer ipk1(1) + integer, allocatable :: hist(:) + + allocate(hist(-64:LL-65)) + hist=0 + do j=1,63 + ipk1=maxloc(s3(:,j)) + i=ipk1(1) - 65 + hist(i)=hist(i)+1 + enddo + if(maxval(hist).gt.NBZAP) then + do i=-64,LL-65 + if(hist(i).gt.NBZAP) s3(i,1:63)=1.0 + enddo + endif + + return +end subroutine q65_bzap + +subroutine q65_snr(dat4,dtdec,f0dec,mode_q65,snr2) + +! Estimate SNR of a decoded transmission by aligning the spectra of +! all 85 symbols. + + integer dat4(13) + integer codeword(63) + integer itone(85) + real, allocatable :: spec(:) + + allocate(spec(iz0)) + call q65_enc(dat4,codeword) + i=1 + k=0 + do j=1,85 + if(j.eq.isync(i)) then + i=i+1 + itone(j)=0 + else + k=k+1 + itone(j)=codeword(k) + 1 + endif + enddo + + spec=0. + lagpk=nint(dtdec/dtstep) + do k=1,85 + j=j0 + NSTEP*(k-1) + 1 + lagpk + if(j.ge.1 .and. j.le.jz0) then + do i=1,iz0 + ii=i+mode_q65*itone(k) + if(ii.ge.1 .and. ii.le.iz0) spec(i)=spec(i) + s1raw(ii,j) + enddo + endif + enddo + + i0=nint(f0dec/df) + nsum=max(10*mode_q65,nint(50.0/df)) + ia=max(1,i0-2*nsum) + ib=min(iz0,i0+2*nsum) + sum1=sum(spec(ia:ia+nsum-1)) + sum2=sum(spec(ib-nsum+1:ib)) + avg=(sum1+sum2)/(2.0*nsum) + spec=spec/avg !Baseline level is now 1.0 + smax=maxval(spec(ia:ib)) + sig_area=sum(spec(ia+nsum:ib-nsum)-1.0) + w_equiv=sig_area/(smax-1.0) + snr2=db(max(1.0,sig_area)) - db(2500.0/df) + + return +end subroutine q65_snr + +subroutine q65_hist(if0,msg0,dxcall,dxgrid) + +! Save the MAXHIST most receent decodes, and their f0 values; or, if +! dxcall is present, look up the most recent dxcall and dxgrid at the +! specified f0. + + parameter (MAXHIST=100) + integer,intent(in) :: if0 !Audio freq of decode + character(len=37),intent(in),optional :: msg0 !Decoded message + character(len=12),intent(out),optional :: dxcall !Second callsign in message + character(len=6),intent(out),optional :: dxgrid !Third word in msg, if grid + + character*6 g1 + character*37 msg(MAXHIST) !Saved messages + integer nf0(MAXHIST) !Saved frequencies + logical isgrid !Statement function + data nhist/0/ + save nhist,nf0,msg + + isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & + g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & + g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' + + if(present(dxcall)) go to 100 !This is a lookup request + + if(nhist.eq.MAXHIST) then + nf0(1:MAXHIST-1)=nf0(2:MAXHIST) !List is full, must make room + msg(1:MAXHIST-1)=msg(2:MAXHIST) + nhist=MAXHIST-1 + endif + nhist=nhist+1 !Insert msg0 at end of list + nf0(nhist)=if0 + msg(nhist)=msg0 + go to 900 + +100 if(dxcall(1:3).ne.' ') go to 900 + dxcall=' ' !This is a lookup request + dxgrid=' ' +! Look for a decode close to if0, starting with most recent ones + do i=nhist,1,-1 + if(abs(nf0(i)-if0).gt.10) cycle + i1=index(msg(i),' ') + if(i1.ge.4 .and. i1.le.13) then + i2=index(msg(i)(i1+1:),' ') + i1 + dxcall=msg(i)(i1+1:i2-1) !Extract dxcall + g1=msg(i)(i2+1:i2+4) + if(isgrid(g1)) dxgrid=g1(1:4) !Extract dxgrid + exit + endif + enddo + +900 return +end subroutine q65_hist + +subroutine q65_hist2(nfreq,msg0,callers,nhist2) + + use types + use prog_args + parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode + character*37 msg0,msg + type(q3list) callers(MAX_CALLERS) + character*6 c6 + character*4 g4 + logical newcall,isgrid + + isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. & + g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. & + g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73' + + msg=msg0 + if(index(msg,'/').gt.0) goto 900 !Ignore messages with compound calls + i0=index(msg,' R ') + if(i0.ge.7) msg=msg(1:i0)//msg(i0+3:) + i1=index(msg,' ') + c6=' ' + g4=' ' + if(i1.ge.4 .and. i1.le.13) then + i2=index(msg(i1+1:),' ') + i1 + c6=msg(i1+1:i2-1) !Extract DX call + g4=msg(i2+1:i2+4) !Extract DX grid + endif + + newcall=.true. + do i=1,nhist2 + if(callers(i)%call .eq. c6) then + newcall=.false. + callers(i)%nsec=time() + callers(i)%nfreq=nfreq + exit + endif + enddo + + if(newcall .and. isgrid(g4)) then + if(nhist2.eq.MAX_CALLERS) then +! Purge the oldest caller + callers(1:MAX_CALLERS-1)=callers(2:MAX_CALLERS) + nhist2=nhist2-1 + endif + nhist2=nhist2+1 + callers(nhist2)%call=c6 + callers(nhist2)%grid=g4 + callers(nhist2)%nsec=time() + callers(nhist2)%nfreq=nfreq + endif + + if(nhist2.ge.1 .and. nhist2.le.40) then + open(24,file=trim(data_dir)//'/tsil.3q',status='unknown', & + form='unformatted') + write(24) nhist2 + write(24) callers(1:nhist2) + close(24) + endif + +900 return +end subroutine q65_hist2 + +end module q65 diff --git a/wsjtx_lib/lib/qra/q65/q65.h b/wsjtx_lib/lib/qra/q65/q65.h new file mode 100644 index 0000000..d0a04d4 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65.h @@ -0,0 +1,123 @@ +// q65.h +// Q65 modes encoding/decoding functions +// +// (c) 2020 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _q65_h +#define _q65_h + +#include "qracodes.h" + +// Error codes returned by q65_decode(...) +#define Q65_DECODE_INVPARAMS -1 +#define Q65_DECODE_FAILED -2 +#define Q65_DECODE_CRCMISMATCH -3 +#define Q65_DECODE_LLHLOW -4 +#define Q65_DECODE_UNDETERR -5 + +// Verify loglikelihood after successful decoding +#define Q65_CHECKLLH +// Max codeword list size in q65_decode_fullaplist +#define Q65_FULLAPLIST_SIZE 256 + +// maximum number of weights for the fast-fading metric evaluation +#define Q65_FASTFADING_MAXWEIGTHS 65 + +extern float q65_llh; + +typedef struct { + const qracode *pQraCode; // qra code to be used by the codec + float decoderEsNoMetric; // value for which we optimize the decoder metric + int *x; // codec input + int *y; // codec output + float *qra_v2cmsg; // decoder v->c messages + float *qra_c2vmsg; // decoder c->v messages + float *ix; // decoder intrinsic information + float *ex; // decoder extrinsic information + // variables used to compute the intrinsics in the fast-fading case + int nBinsPerTone; + int nBinsPerSymbol; + float ffNoiseVar; + float ffEsNoMetric; + int nWeights; + float ffWeight[Q65_FASTFADING_MAXWEIGTHS]; +} q65_codec_ds; + +int q65_init(q65_codec_ds *pCodec, const qracode *pQraCode); +void q65_free(q65_codec_ds *pCodec); + +int q65_encode(const q65_codec_ds *pCodec, int *pOutputCodeword, const int *pInputMsg); + +int q65_intrinsics(q65_codec_ds *pCodec, float *pIntrinsics, const float *pInputEnergies); + +int q65_intrinsics_fastfading(q65_codec_ds *pCodec, + float *pIntrinsics, // intrinsic symbol probabilities output + const float *pInputEnergies, // received energies input + const int submode, // submode idx (0=A ... 4=E) + const float B90Ts, // normalized spread bandwidth (90% fractional energy) + const int fadingModel); // 0=Gaussian 1=Lorentzian fade model + + +int q65_decode(q65_codec_ds *pCodec, + int* pDecodedCodeword, + int *pDecodedMsg, + const float *pIntrinsics, + const int *pAPMask, + const int *pAPSymbols, + const int maxiters); + +int q65_decode_fullaplist(q65_codec_ds *codec, + int *ydec, + int *xdec, + const float *pIntrinsics, + const int *pCodewords, + const int nCodewords); + +int q65_esnodb(const q65_codec_ds *pCodec, + float *pEsNodB, + const int *ydec, + const float *pInputEnergies); + +int q65_esnodb_fastfading( + const q65_codec_ds *pCodec, + float *pEsNodB, + const int *ydec, + const float *pInputEnergies); + + +// helper functions +#define q65_get_message_length(pCodec) _q65_get_message_length((pCodec)->pQraCode) +#define q65_get_codeword_length(pCodec) _q65_get_codeword_length((pCodec)->pQraCode) +#define q65_get_code_rate(pCodec) _q65_get_code_rate((pCodec)->pQraCode) +#define q65_get_alphabet_size(pCodec) _q65_get_alphabet_size((pCodec)->pQraCode) +#define q65_get_bits_per_symbol(pCodec) _q65_get_bits_per_symbol((pCodec)->pQraCode) + + +// internally used but made public for the above defines +int _q65_get_message_length(const qracode *pCode); +int _q65_get_codeword_length(const qracode *pCode); +float _q65_get_code_rate(const qracode *pCode); +static void _q65_mask(const qracode *pcode, float *ix, const int *mask, const int *x); +int _q65_get_alphabet_size(const qracode *pCode); +int _q65_get_bits_per_symbol(const qracode *pCode); + +// internally used but made public for threshold optimization +int q65_check_llh(float *llh, const int* ydec, const int nN, const int nM, const float *pIntrin); + +#endif // _qra65_h diff --git a/wsjtx_lib/lib/qra/q65/q65.sln b/wsjtx_lib/lib/qra/q65/q65.sln new file mode 100644 index 0000000..1ac03a6 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65.sln @@ -0,0 +1,20 @@ + +Microsoft Visual Studio Solution File, Format Version 10.00 +# Visual Studio 2008 +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "q65", "q65.vcproj", "{933A58F6-199B-4723-ACFE-3013E6DD9D0A}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Win32 = Debug|Win32 + Release|Win32 = Release|Win32 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {933A58F6-199B-4723-ACFE-3013E6DD9D0A}.Debug|Win32.ActiveCfg = Debug|Win32 + {933A58F6-199B-4723-ACFE-3013E6DD9D0A}.Debug|Win32.Build.0 = Debug|Win32 + {933A58F6-199B-4723-ACFE-3013E6DD9D0A}.Release|Win32.ActiveCfg = Release|Win32 + {933A58F6-199B-4723-ACFE-3013E6DD9D0A}.Release|Win32.Build.0 = Release|Win32 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/wsjtx_lib/lib/qra/q65/q65.vcproj b/wsjtx_lib/lib/qra/q65/q65.vcproj new file mode 100644 index 0000000..36b3235 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65.vcproj @@ -0,0 +1,255 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wsjtx_lib/lib/qra/q65/q65_ap.f90 b/wsjtx_lib/lib/qra/q65/q65_ap.f90 new file mode 100644 index 0000000..32e26a4 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_ap.f90 @@ -0,0 +1,166 @@ +subroutine q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype, & + apsym0,apmask,apsymbols) + + integer apsym0(58),aph10(10) + integer apmask(78),apsymbols(78) + integer naptypes(0:5,4) ! (nQSOProgress, ipass) maximum of 4 passes for now + integer mcqru(29),mcqfd(29),mcqtest(29),mcqww(29) + integer mcq(29),mrrr(19),m73(19),mrr73(19) + logical lapcqonly,first + data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ + data mcqru/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,0,1,1,0,0/ + data mcqfd/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,0,1,0/ + data mcqtest/0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,1,1,1,1,1,1,0,0,1,0/ + data mcqww/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,1,1,0/ + data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ + data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ + data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/ + data ncontest0/99/ + data first/.true./ + save naptypes,ncontest0 + +! nQSOprogress +! 0 CALLING +! 1 REPLYING +! 2 REPORT +! 3 ROGER_REPORT +! 4 ROGERS +! 5 SIGNOFF + + if(first.or.(ncontest.ne.ncontest0)) then +! iaptype +!------------------------ +! 1 CQ ??? ??? (29+4=33 ap bits) +! 2 MyCall ??? ??? (29+4=33 ap bits) +! 3 MyCall DxCall ??? (58+4=62 ap bits) +! 4 MyCall DxCall RRR (78 ap bits) +! 5 MyCall DxCall 73 (78 ap bits) +! 6 MyCall DxCall RR73 (78 ap bits) + + naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ) + naptypes(1,1:4)=(/2,3,0,0/) ! Tx1 + naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 + naptypes(3,1:4)=(/3,4,5,6/) ! Tx3 + naptypes(4,1:4)=(/3,4,5,6/) ! Tx4 + naptypes(5,1:4)=(/3,1,2,0/) ! Tx5 + first=.false. + ncontest0=ncontest + endif + + apsymbols=0 + iaptype=naptypes(nQSOProgress,ipass) + if(lapcqonly) iaptype=1 + +! ncontest=0 : NONE +! 1 : NA_VHF +! 2 : EU_VHF +! 3 : FIELD DAY +! 4 : RTTY +! 5 : WW_DIGI +! 6 : FOX +! 7 : HOUND + +! Conditions that cause us to bail out of AP decoding +! if(ncontest.le.5 .and. iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) goto 900 +! if(ncontest.eq.6) goto 900 !No AP for Foxes +! if(ncontest.eq.7.and.f1.gt.950.0) goto 900 !Hounds use AP only below 950 Hz + if(ncontest.ge.6) goto 900 + if(iaptype.ge.2 .and. apsym0(1).gt.1) goto 900 !No, or nonstandard, mycall + if(ncontest.eq.7 .and. iaptype.ge.2 .and. aph10(1).gt.1) goto 900 + if(iaptype.ge.3 .and. apsym0(30).gt.1) goto 900 !No, or nonstandard, dxcall + + if(iaptype.eq.1) then ! CQ or CQ RU or CQ TEST or CQ FD + apmask=0 + apmask(1:29)=1 + if(ncontest.eq.0) apsymbols(1:29)=mcq + if(ncontest.eq.1) apsymbols(1:29)=mcqtest + if(ncontest.eq.2) apsymbols(1:29)=mcqtest + if(ncontest.eq.3) apsymbols(1:29)=mcqfd + if(ncontest.eq.4) apsymbols(1:29)=mcqru + if(ncontest.eq.5) apsymbols(1:29)=mcqww + if(ncontest.eq.7) apsymbols(1:29)=mcq + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + endif + + if(iaptype.eq.2) then ! MyCall,???,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.5) then + apmask(1:29)=1 + apsymbols(1:29)=apsym0(1:29) + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + else if(ncontest.eq.2) then + apmask(1:28)=1 + apsymbols(1:28)=apsym0(1:28) + apmask(72:74)=1 + apsymbols(72)=0 + apsymbols(73)=(+1) + apsymbols(74)=0 + apmask(75:78)=1 + apsymbols(75:78)=0 + else if(ncontest.eq.3) then + apmask(1:28)=1 + apsymbols(1:28)=apsym0(1:28) + apmask(75:78)=1 + apsymbols(75:78)=0 + else if(ncontest.eq.4) then + apmask(2:29)=1 + apsymbols(2:29)=apsym0(1:28) + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + else if(ncontest.eq.7) then ! ??? RR73; MyCall ??? + apmask(29:56)=1 + apsymbols(29:56)=apsym0(1:28) + apmask(57:66)=1 + apsymbols(57:66)=aph10(1:10) + apmask(72:78)=1 + apsymbols(72:74)=(/0,0,1/) + apsymbols(75:78)=0 + endif + endif + + if(iaptype.eq.3) then ! MyCall,DxCall,??? + apmask=0 + if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2.or.ncontest.eq.5.or.ncontest.eq.7) then + apmask(1:58)=1 + apsymbols(1:58)=apsym0 + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + else if(ncontest.eq.3) then ! Field Day + apmask(1:56)=1 + apsymbols(1:28)=apsym0(1:28) + apsymbols(29:56)=apsym0(30:57) + apmask(72:78)=1 + apsymbols(75:78)=0 + else if(ncontest.eq.4) then + apmask(2:57)=1 + apsymbols(2:29)=apsym0(1:28) + apsymbols(30:57)=apsym0(30:57) + apmask(75:78)=1 + apsymbols(75:78)=(/0,0,1,0/) + endif + endif + + if(iaptype.eq.5.and.ncontest.eq.7) goto 900 !Hound + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then + apmask=0 + if(ncontest.le.5 .or. (ncontest.eq.7.and.iaptype.eq.6)) then + apmask(1:78)=1 !MyCall, HisCall, RRR|73|RR73 + apmask(72:74)=0 !Check for , RRR, RR73, 73 + apsymbols(1:58)=apsym0 + if(iaptype.eq.4) apsymbols(59:77)=mrrr + if(iaptype.eq.5) apsymbols(59:77)=m73 + if(iaptype.eq.6) apsymbols(59:77)=mrr73 + else if(ncontest.eq.7.and.iaptype.eq.4) then ! Hound listens for MyCall RR73;... + apmask(1:28)=1 + apsymbols(1:28)=apsym0(1:28) + apmask(57:66)=1 + apsymbols(57:66)=aph10(1:10) + apmask(72:78)=1 + apsymbols(72:78)=(/0,0,1,0,0,0,0/) + endif + endif + +900 return +end subroutine q65_ap diff --git a/wsjtx_lib/lib/qra/q65/q65_encoding_modules.f90 b/wsjtx_lib/lib/qra/q65/q65_encoding_modules.f90 new file mode 100644 index 0000000..4988dd4 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_encoding_modules.f90 @@ -0,0 +1,221 @@ +module gf64math +! add and subtract in GF(2^6) based on primitive polynomial x^6+x+1 + + implicit none + integer, private :: gf64log(0:63) + integer, private :: gf64antilog(0:62) + +! table of the logarithms of the elements of GF(M) (log(0) never used) + data gf64log/ & + -1, 0, 1, 6, 2, 12, 7, 26, 3, 32, & + 13, 35, 8, 48, 27, 18, 4, 24, 33, 16, & + 14, 52, 36, 54, 9, 45, 49, 38, 28, 41, & + 19, 56, 5, 62, 25, 11, 34, 31, 17, 47, & + 15, 23, 53, 51, 37, 44, 55, 40, 10, 61, & + 46, 30, 50, 22, 39, 43, 29, 60, 42, 21, & + 20, 59, 57, 58/ + +! table of GF(M) elements given their logarithm + data gf64antilog/ & + 1, 2, 4, 8, 16, 32, 3, 6, 12, 24, & + 48, 35, 5, 10, 20, 40, 19, 38, 15, 30, & + 60, 59, 53, 41, 17, 34, 7, 14, 28, 56, & + 51, 37, 9, 18, 36, 11, 22, 44, 27, 54, & + 47, 29, 58, 55, 45, 25, 50, 39, 13, 26, & + 52, 43, 21, 42, 23, 46, 31, 62, 63, 61, & + 57, 49, 33/ + +contains + + integer function gf64_add(i1,i2) + implicit none + integer::i1 + integer::i2 + gf64_add=iand(ieor(i1,i2),63) + end function gf64_add + + integer function gf64_mult(i1,i2) + implicit none + integer::i1 + integer::i2 + integer::j + + if(i1.eq.0 .or. i2.eq.0) then + gf64_mult=0 + elseif(i1.eq.1) then + gf64_mult=i2 + elseif(i2.eq.1) then + gf64_mult=i1 + else + j=mod(gf64log(i1)+gf64log(i2),63) + gf64_mult=gf64antilog(j) + endif + end function gf64_mult + +end module gf64math + +module q65_generator + + integer generator(15,50) + data generator/ & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0,20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0,20, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0,20, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0,20, 0, 1, 1, 0, 0, 0,10, 0, 0, 0, 0, 1, 0, & + 0,20, 0, 1, 1, 0, 0, 0,10, 0, 0, 0,44, 1, 0, & + 0,20, 0, 1, 1, 0, 0, 0,10, 1, 0, 0,44, 1, 0, & + 0,20, 0, 1, 1, 0, 0, 0,10, 1, 0, 0,44, 1,14, & + 0,20, 0, 1, 1, 0, 0, 0,10, 1,31, 0,44, 1,14, & + 0,20, 0, 1, 1,33, 0, 0,10, 1,31, 0,44, 1,14, & + 56,20, 0, 1, 1,33, 0, 0,10, 1,31, 0,44, 1,14, & + 56,20, 0, 1, 1,33, 0, 1,10, 1,31, 0,44, 1,14, & + 56, 1, 0, 1, 1,33, 0, 1,10, 1,31, 0,44, 1,14, & + 56, 1, 0, 1, 1,33, 0, 1,10, 1,31,36,44, 1,14, & + 56, 1, 0, 1, 1,33, 0, 1,43, 1,31,36,44, 1,14, & + 56, 1, 0, 1, 1,33, 0, 1,43,17,31,36,44, 1,14, & + 56, 1, 0, 1, 1,33, 0, 1,43,17,31,36,36, 1,14, & + 56, 1, 0, 1, 1,33,53, 1,43,17,31,36,36, 1,14, & + 56, 1, 0,35, 1,33,53, 1,43,17,31,36,36, 1,14, & + 56, 1, 0,35, 1,33,53, 1,43,17,30,36,36, 1,14, & + 56, 1, 0,35, 1,33,53,52,43,17,30,36,36, 1,14, & + 56, 1, 0,35, 1,32,53,52,43,17,30,36,36, 1,14, & + 56, 1,60,35, 1,32,53,52,43,17,30,36,36, 1,14, & + 56, 1,60,35, 1,32,53,52,43,17,30,36,36,49,14, & + 56, 1,60,35, 1,32,53,52,43,17,30,36,37,49,14, & + 56, 1,60,35,54,32,53,52,43,17,30,36,37,49,14, & + 56, 1,60,35,54,32,53,52, 1,17,30,36,37,49,14, & + 1, 1,60,35,54,32,53,52, 1,17,30,36,37,49,14, & + 1, 0,60,35,54,32,53,52, 1,17,30,36,37,49,14, & + 1, 0,60,35,54,32,53,52, 1,17,30,37,37,49,14, & + 1, 0,61,35,54,32,53,52, 1,17,30,37,37,49,14, & + 1, 0,61,35,54,32,53,52, 1,48,30,37,37,49,14, & + 1, 0,61,35,54,32,53,52, 1,48,30,37,37,49,15, & + 1, 0,61,35,54, 0,53,52, 1,48,30,37,37,49,15, & + 1, 0,61,35,54, 0,52,52, 1,48,30,37,37,49,15, & + 1, 0,61,35,54, 0,52,52, 1,48,30,37,37, 0,15, & + 1, 0,61,35,54, 0,52,34, 1,48,30,37,37, 0,15, & + 1, 0,61,35,54, 0,52,34, 1,48,30,37, 0, 0,15, & + 1, 0,61,35,54, 0,52,34, 1,48,30,20, 0, 0,15, & + 1, 0, 0,35,54, 0,52,34, 1,48,30,20, 0, 0,15, & + 1, 0, 0,35,54, 0,52,34, 1, 0,30,20, 0, 0,15, & + 0, 0, 0,35,54, 0,52,34, 1, 0,30,20, 0, 0,15, & + 0, 0, 0,35,54, 0,52,34, 1, 0,38,20, 0, 0,15, & + 0, 0, 0,35, 0, 0,52,34, 1, 0,38,20, 0, 0,15, & + 0, 0, 0,35, 0, 0,52, 0, 1, 0,38,20, 0, 0,15, & + 0, 0, 0,35, 0, 0,52, 0, 1, 0,38,20, 0, 0, 0, & + 0, 0, 0,35, 0, 0,52, 0, 0, 0,38,20, 0, 0, 0, & + 0, 0, 0,35, 0, 0,52, 0, 0, 0,38, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0,52, 0, 0, 0,38, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,38, 0, 0, 0, 0/ + +end module q65_generator + +module q65_encoding + +contains + +subroutine q65_encode(message,codeword) + use gf64math + use q65_generator + integer message(15) + integer codeword(65) + integer i,j + + codeword=0 + codeword(1:15)=message + do i=1,15 + do j=16,65 + codeword(j)=gf64_add(codeword(j),gf64_mult(message(i),generator(i,j-15))) + enddo + enddo + + return +end + +subroutine get_q65crc12(mc2,ncrc1,ncrc2) +! + character c6*6 + integer*1 mc(90),mc2(90),tmp(6) + integer*1 r(13),p(13) +! polynomial for 12-bit CRC 0xF01 + data p/1,1,0,0,0,0,0,0,0,1,1,1,1/ + +! flip bit order of each 6-bit symbol for consistency with Nico's calculation + do i=0,14 + tmp=mc2(i*6+1:i*6+6) + mc(i*6+1:i*6+6)=tmp(6:1:-1) + enddo + +! divide by polynomial + r=mc(1:13) + do i=0,77 + r(13)=mc(i+13) + r=mod(r+r(1)*p,2) + r=cshift(r,1) + enddo + + write(c6,'(6b1)') r(6:1:-1) + read(c6,'(b6.6)') ncrc1 + read(c6,'(6b1)') mc2(79:84) + write(c6,'(6b1)') r(12:7:-1) + read(c6,'(b6.6)') ncrc2 + read(c6,'(6b1)') mc2(85:90) + +end subroutine get_q65crc12 + +subroutine get_q65_tones(msg37,codeword,itone) + use packjt77 + implicit none + character*37 msg37 + character*77 c77 + character*6 c6 + integer codeword(65) + integer sync(22) + integer message(15) + integer shortcodeword(63) + integer itone(85) + integer i,j,k + integer*1 mbits(90) + integer i3,n3,ncrc1,ncrc2 + data sync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + + i3=-1 + n3=-1 + call pack77(msg37,i3,n3,c77) + mbits=0 + read(c77,'(77i1)') mbits(1:77) + +! Message is 77 bits long. Add a 0 bit to create a 78-bit message and pad with +! 12 zeros to create 90-bit mbit array for CRC calculation. + call get_q65crc12(mbits,ncrc1,ncrc2) + +! Now have message in bits 1:78 and CRC in bits 79:90. +! Group message bits into 15 6-bit symbols: + do i=0,14 + write(c6,'(6i1)') mbits( (i*6+1):(i*6+6) ) + read(c6,'(b6.6)') message(i+1) + enddo + +! Encode to create a 65-symbol codeword + call q65_encode(message,codeword) + +!Shorten the codeword by omitting the CRC symbols (symbols 14 and 15) + shortcodeword(1:13)=codeword(1:13) + shortcodeword(14:63)=codeword(16:65) + +!Insert sync symbols to create array of channel symbols + j=1 + k=0 + do i=1,85 + if(i.eq.sync(j)) then + j=j+1 + itone(i)=0 + else + k=k+1 + itone(i)=shortcodeword(k)+1 + endif + enddo +end subroutine get_q65_tones + +end module q65_encoding diff --git a/wsjtx_lib/lib/qra/q65/q65_ftn_test.f90 b/wsjtx_lib/lib/qra/q65/q65_ftn_test.f90 new file mode 100644 index 0000000..607d0f5 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_ftn_test.f90 @@ -0,0 +1,51 @@ +program q65_ftn_test + + use packjt77 + parameter (LL=192,NN=63) + integer x(13) !User's 78-bit message as 13 six-bit integers + integer y(63) !Q65 codeword for x + integer xdec(13) !Decoded message + integer APmask(13) + integer APsymbols(13) + real s3(0:LL-1,NN) + real s3prob(0:LL-1,NN) + character*37 msg0,msg,msgsent + character*77 c77 + logical unpk77_success + + narg=iargc() + if(narg.ne.1) then + print*,'Usage: q65_ftn_test "message"' + print*,'Example: q65_ftn_test "K1ABC W9XYZ EN37"' + go to 999 + endif + call getarg(1,msg0) + call pack77(msg0,i3,n3,c77) + call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent + read(c77,1000) x +1000 format(12b6.6,b5.5) + + call q65_enc(x,y) !Encode message, x(1:13) ==> y(1:63) + + write(*,1010) x,msg0 +1010 format('User message:'/13i3,2x,a) + write(*,1020) y +1020 format(/'Generated codeword:'/(20i3)) + + s3=0. + s3prob=0. + do j=1,NN + s3(y(j)+64,j)=1.0 + enddo + APmask=0 + APsymbols=0 + nsubmode=0 + b90=1.0 + nFadingModel=1 + call q65_dec(s3,APmask,APsymbols,nsubmode,b90,nFadingModel,s3prob,snr2500,xdec,irc) + write(c77,1000) xdec + call unpack77(c77,0,msg,unpk77_success) !Unpack to get msgsent + write(*,1100) xdec,trim(msg) +1100 format(/'Decoded message:'/13i3,2x,a) + +999 end program q65_ftn_test diff --git a/wsjtx_lib/lib/qra/q65/q65_loops.f90 b/wsjtx_lib/lib/qra/q65/q65_loops.f90 new file mode 100644 index 0000000..3220648 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_loops.f90 @@ -0,0 +1,101 @@ +subroutine q65_loops(c00,npts2,nsps2,nsubmode,ndepth,jpk0, & + xdt0,f0,iaptype,xdt1,f1,snr2,dat4,idec) + + use packjt77 + use timer_module, only: timer + use q65 + + parameter (NN=63) + parameter (LN=2176*63) !LN=LL*NN; LL=64*(mode_q65+2), NN=63 + complex c00(0:npts2-1) !Analytic representation of dd(), 6000 Hz + complex ,allocatable :: c0(:) !Ditto, with freq shift + character decoded*37 + real a(3) !twkfreq params f,f1,f2 + real,allocatable :: s3(:) !Symbol spectra + integer dat4(13) !Decoded message (as 13 six-bit integers) + integer nap(0:11) !AP return codes + data nap/0,2,3,2,3,4,2,3,6,4,6,6/ + + LL=64*(mode_q65+2) + allocate(s3(LL*NN)) + allocate(c0(0:npts2-1)) + idec=-1 + ircbest=9999 + irc=-99 + s3lim=20. + baud=6000.0/nsps2 + + idfmax=1 + idtmax=1 + maxdist=4 + ibw0=(ibwa+ibwb)/2 + if(iand(ndepth,3).eq.2) then + idfmax=3 + idtmax=3 + maxdist=5 + endif + if(iand(ndepth,3).eq.3) then + idfmax=5 + idtmax=5 + maxdist=5 + endif + + napmin=99 + xdt1=xdt0 + f1=f0 + idfbest=0 + idtbest=0 + ndistbest=0 + + do idf=1,idfmax + ndf=idf/2 + if(mod(idf,2).eq.0) ndf=-ndf + a=0. + a(1)=-(f0+0.5*baud*ndf) +! Variable 'drift' is frequency increase over full TxT. Therefore we want: + a(2)=-0.5*drift + call twkfreq(c00,c0,npts2,6000.0,a) + do idt=1,idtmax + ndt=idt/2 + if(mod(idt,2).eq.0) ndt=-ndt + jpk=jpk0 + nsps2*ndt/16 !tsym/16 + jpk=max(0,jpk) + jpk=min(29000,jpk) + call spec64(c0,npts2,nsps2,mode_q65,jpk,s3,LL,NN) + call pctile(s3,LL*NN,40,base) + s3=s3/base + where(s3(1:LL*NN)>s3lim) s3(1:LL*NN)=s3lim + call q65_bzap(s3,LL) !Zap birdies + do ibw=ibwa,ibwb + ndist=ndf**2 + ndt**2 + (ibw-ibw0)**2 + if(ndist.gt.maxdist) cycle + b90=1.72**ibw + if(b90.gt.345.0) cycle + b90ts = b90/baud + call timer('dec2 ',0) + call q65_dec2(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) + call timer('dec2 ',1) + ! irc > 0 ==> number of iterations required to decode + ! -1 = invalid params + ! -2 = decode failed + ! -3 = CRC mismatch + if(irc.ge.0) then + idfbest=idf + idtbest=idt + ndistbest=ndist + nrc=irc + go to 100 + endif + enddo ! ibw (b90 loop) + enddo ! idt (DT loop) + enddo ! idf (f0 loop) + +100 if(irc.ge.0) then + idec=iaptype + snr2=esnodb - db(2500.0/baud) + xdt1=xdt0 + nsps2*ndt/(16.0*6000.0) + f1=f0 + 0.5*baud*ndf + endif + + return +end subroutine q65_loops diff --git a/wsjtx_lib/lib/qra/q65/q65_set_list.f90 b/wsjtx_lib/lib/qra/q65/q65_set_list.f90 new file mode 100644 index 0000000..0b836bd --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_set_list.f90 @@ -0,0 +1,97 @@ +subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) + + parameter (MAX_NCW=206) + character*12 mycall,hiscall + character*6 hisgrid + character*37 msg,msgsent + logical my_std,his_std + integer codewords(63,MAX_NCW) + integer itone(85) + integer isync(22) + data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + + ncw=0 + if(hiscall(1:1).eq. ' ') return + call stdcall(mycall,my_std) + call stdcall(hiscall,his_std) + + ncw=MAX_NCW + do i=1,ncw + msg=trim(mycall)//' '//trim(hiscall) + if(.not.my_std) then + if(i.eq.1 .or. i.ge.6) msg='<'//trim(mycall)//'> '//trim(hiscall) + if(i.ge.2 .and. i.le.4) msg=trim(mycall)//' <'//trim(hiscall)//'>' + else if(.not.his_std) then + if(i.le.4 .or. i.eq.6) msg='<'//trim(mycall)//'> '//trim(hiscall) + if(i.ge.7) msg=trim(mycall)//' <'//trim(hiscall)//'>' + endif + j0=len(trim(msg))+2 + if(i.eq.2) msg(j0:j0+2)='RRR' + if(i.eq.3) msg(j0:j0+3)='RR73' + if(i.eq.4) msg(j0:j0+1)='73' + if(i.eq.5) then + if(his_std) msg='CQ '//trim(hiscall)//' '//hisgrid(1:4) + if(.not.his_std) msg='CQ '//trim(hiscall) + endif + if(i.eq.6 .and. his_std) msg(j0:j0+3)=hisgrid(1:4) + if(i.ge.7 .and. i.le.206) then + isnr = -50 + (i-7)/2 + if(iand(i,1).eq.1) then + write(msg(j0:j0+2),'(i3.2)') isnr + if(msg(j0:j0).eq.' ') msg(j0:j0)='+' + else + write(msg(j0:j0+3),'("R",i3.2)') isnr + if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+' + endif + endif + + call genq65(msg,0,msgsent,itone,i3,n3) + i0=1 + j=0 + do k=1,85 + if(k.eq.isync(i0)) then + i0=i0+1 + cycle + endif + j=j+1 + codewords(j,i)=itone(k) - 1 + enddo +! write(71,3001) i,isnr,codewords(1:13,i),trim(msg) +!3001 format(i3,2x,i3.2,2x,13i3,2x,a) + enddo + + return +end subroutine q65_set_list + +subroutine stdcall(callsign,std) + + character*12 callsign + character*1 c + logical is_digit,is_letter,std +!Statement functions: + is_digit(c)=c.ge.'0' .and. c.le.'9' + is_letter(c)=c.ge.'A' .and. c.le.'Z' + +! Check for standard callsign + iarea=-1 + n=len(trim(callsign)) + do i=n,2,-1 + if(is_digit(callsign(i:i))) exit + enddo + iarea=i !Right-most digit (call area) + npdig=0 !Digits before call area + nplet=0 !Letters before call area + do i=1,iarea-1 + if(is_digit(callsign(i:i))) npdig=npdig+1 + if(is_letter(callsign(i:i))) nplet=nplet+1 + enddo + nslet=0 !Letters in suffix + do i=iarea+1,n + if(is_letter(callsign(i:i))) nslet=nslet+1 + enddo + std=.true. + if(iarea.lt.2 .or. iarea.gt.3 .or. nplet.eq.0 .or. & + npdig.ge.iarea-1 .or. nslet.gt.3) std=.false. + + return +end subroutine stdcall diff --git a/wsjtx_lib/lib/qra/q65/q65_set_list2.f90 b/wsjtx_lib/lib/qra/q65/q65_set_list2.f90 new file mode 100644 index 0000000..39147e6 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_set_list2.f90 @@ -0,0 +1,70 @@ +subroutine q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2,codewords,ncw) + + use types + parameter (MAX_NCW=206) + parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode + character*12 mycall,hiscall + character*6 hisgrid,c6 + character*4 g4 + character*37 msg,msgsent + logical std,isgrid + integer codewords(63,MAX_NCW) + integer itone(85) + integer isync(22) + type(q3list) callers(MAX_CALLERS) + + data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + + isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. & + g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. & + g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73' + + call stdcall(hiscall,std) + jmax=nhist2 + if(std .and. isgrid(hisgrid(1:4))) then + jmax=min(MAX_CALLERS,nhist2+1) + do j=1,nhist2 + if(callers(j)%call .eq. hiscall(1:6)) then + jmax=nhist2 + exit + endif + enddo + endif + + codewords(:,1)=0 + i=1 + do j=1,jmax + c6=callers(j)%call + g4=callers(j)%grid + if(j.eq.nhist2+1) then + c6=hiscall(1:6) + g4=hisgrid(1:4) + endif + do k=1,5 + i=i+1 + msg=trim(mycall)//' '//trim(c6) + j0=len(trim(msg))+1 + if(k.eq.1) msg=msg(1:j0)//g4 + if(k.eq.2) msg=msg(1:j0)//'R '//g4 + if(k.eq.3) msg(j0:j0+3)=' RRR' + if(k.eq.4) msg(j0:j0+4)=' RR73' + if(k.eq.5) msg(j0:j0+2)=' 73' + call genq65(msg,0,msgsent,itone,i3,n3) + i0=1 + jj=0 + do kk=1,85 + if(kk.eq.isync(i0)) then + i0=i0+1 + cycle + endif + jj=jj+1 + codewords(jj,i)=itone(kk) - 1 + enddo +! write(71,3001) i,j,k,codewords(1:13,i),trim(msg) +!3001 format(3i3,2x,13i3,2x,a) + enddo + enddo + ncw=i + + return +end subroutine q65_set_list2 diff --git a/wsjtx_lib/lib/qra/q65/q65_subs.c b/wsjtx_lib/lib/qra/q65/q65_subs.c new file mode 100644 index 0000000..4311ba3 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65_subs.c @@ -0,0 +1,147 @@ +// q65_subs.c + +/* Fortran interface for Q65 codec + + To encode a Q65 message: + + integer x(13) !Message payload, 78 bits as 13 six-bit integers + integer y(63) !Codeword, 63 six-bit integers + call q65_enc(imsg,icodeword) + + To decode a Q65 message: + + parameter (LL=64,NN=63) + real s3(LL,NN) !Received energies + real s3prob(LL,NN) !Symbol-value probabilities + integer APmask(13) + integer APsymbols(13) + real snr2500 + integer xdec(13) !Decoded 78-bit message as 13 six-bit integers + integer irc !Return code from q65_decode() + + call q65_dec(s3,APmask,APsymbols,s3prob,snr2500,xdec,irc) +*/ + +#include "qra15_65_64_irr_e23.h" // QRA code used by Q65 +#include "q65.h" +#include +#include + +static q65_codec_ds codec; + +void q65_enc_(int x[], int y[]) +{ + + static int first=1; + if (first) { + // Set the QRA code, allocate memory, and initialize + int rc = q65_init(&codec,&qra15_65_64_irr_e23); + if (rc<0) { + printf("error in q65_init()\n"); + exit(0); + } + first=0; + } + // Encode message x[13], producing codeword y[63] + q65_encode(&codec,y,x); +} + +void q65_intrinsics_ff_(float s3[], int* submode, float* B90Ts, + int* fadingModel, float s3prob[]) +{ + +/* Input: s3[LL,NN] Received energies + * submode 0=A, 4=E + * B90 Spread bandwidth, 90% fractional energy + * fadingModel 0=Gaussian, 1=Lorentzian + * Output: s3prob[LL,NN] Symbol-value intrinsic probabilities + */ + + int rc; + static int first=1; + + if (first) { + // Set the QRA code, allocate memory, and initialize + int rc = q65_init(&codec,&qra15_65_64_irr_e23); + if (rc<0) { + printf("error in q65_init()\n"); + exit(0); + } + first=0; + } + rc = q65_intrinsics_fastfading(&codec,s3prob,s3,*submode,*B90Ts,*fadingModel); + if(rc<0) { + printf("error in q65_intrinsics()\n"); + exit(0); + } +} + +void q65_dec_(float s3[], float s3prob[], int APmask[], int APsymbols[], + int* maxiters0, float* esnodb0, int xdec[], int* rc0) +{ + +/* Input: s3[LL,NN] Symbol spectra + * s3prob[LL,NN] Symbol-value intrinsic probabilities + * APmask[13] AP information to be used in decoding + * APsymbols[13] Available AP informtion + * Output: + * esnodb0 Estimated Es/No (dB) + * xdec[13] Decoded 78-bit message as 13 six-bit integers + * rc0 Return code from q65_decode() + */ + + int rc; + int ydec[63]; + float esnodb; + int maxiters=*maxiters0; + + rc = q65_decode(&codec,ydec,xdec,s3prob,APmask,APsymbols,maxiters); + *rc0=rc; + // rc = -1: Invalid params + // rc = -2: Decode failed + // rc = -3: CRC mismatch + *esnodb0 = 0.0; //Default Es/No for a failed decode + if(rc<0) return; + + rc = q65_esnodb_fastfading(&codec,&esnodb,ydec,s3); + if(rc<0) { + printf("error in q65_esnodb_fastfading()\n"); + exit(0); + } + *esnodb0 = esnodb; +} + +void q65_dec_fullaplist_(float s3[], float s3prob[], int codewords[], + int* ncw, float* esnodb0, int xdec[], float* plog, int* rc0) +{ +/* Input: s3[LL,NN] Symbol spectra + * s3prob[LL,NN] Symbol-value intrinsic probabilities + * codewords[63,ncw] Full codewords to search for + * ncw Number of codewords + * Output: + * esnodb0 Estimated Es/No (dB) + * xdec[13] Decoded 78-bit message as 13 six-bit integers + * rc0 Return code from q65_decode() + */ + + int rc; + int ydec[63]; + float esnodb; + + rc = q65_decode_fullaplist(&codec,ydec,xdec,s3prob,codewords,*ncw); + *plog=q65_llh; + *rc0=rc; + + // rc = -1: Invalid params + // rc = -2: Decode failed + // rc = -3: CRC mismatch + *esnodb0 = 0.0; //Default Es/No for a failed decode + if(rc<0) return; + + rc = q65_esnodb_fastfading(&codec,&esnodb,ydec,s3); + if(rc<0) { + printf("error in q65_esnodb_fastfading()\n"); + exit(0); + } + *esnodb0 = esnodb; +} diff --git a/wsjtx_lib/lib/qra/q65/q65code.f90 b/wsjtx_lib/lib/qra/q65/q65code.f90 new file mode 100644 index 0000000..d61cba9 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65code.f90 @@ -0,0 +1,29 @@ +program q65code + use q65_encoding + + implicit none + character*37 msg37 + integer nargs + integer codeword(65),tones(85) + + nargs=iargc() + if(nargs .ne. 1) then + print*,'Usage: q65code "msg"' + goto 999 + endif + call getarg(1,msg37) + + call get_q65_tones(msg37,codeword,tones) + + write(*,*) 'Generated message plus CRC (90 bits)' + write(*,'(a8,15i4)') '6 bit : ',codeword(1:15) + write(*,'(a8,15b6.6)') 'binary: ',codeword(1:15) + write(*,*) ' ' + write(*,*) 'Codeword with CRC symbols (65 symbols)' + write(*,'(20i3)') codeword + + write(*,*) ' ' + write(*,*) 'Channel symbols (85 total)' + write(*,'(20i3)') tones + +999 end program q65code diff --git a/wsjtx_lib/lib/qra/q65/q65sim.f90 b/wsjtx_lib/lib/qra/q65/q65sim.f90 new file mode 100644 index 0000000..51cf479 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65sim.f90 @@ -0,0 +1,241 @@ +program q65sim + +! Generate simulated Q65 data for testing the decoder. + + use wavhdr + use packjt + parameter (NMAX=300*12000) !Total samples in .wav file + type(hdr) h !Header for .wav file + integer*2 iwave(NMAX) !Generated waveform + integer itone(85) !Channel symbols (values 0-65) + integer ntone(85,10) !Channel symbols for up to 10 messages + integer y(63) !Codeword + integer istart !averaging compatible start seconds + integer imins !minutes for 15s period timestamp + integer isecs !seconds for 15s period timestamp + real*4 xnoise(NMAX) !Generated random noise + real*4 dat(NMAX) !Generated real data + complex cdat(NMAX) !Generated complex waveform + complex cspread(0:NMAX-1) !Complex amplitude for Rayleigh fading + complex z + real*8 f00,f0,dt,twopi,phi,dphi,baud,fsample,freq + character fname*17,csubmode*1,arg*12,c2*2 + character*37 msg,msgsent,imsg(10) + + nargs=iargc() + if(nargs.ne.11) then + print*,'Usage: q65sim "msg" A-E freq fDop DT f1 Stp TRp Nsig Nfile SNR' + print*,'Example: q65sim "K1ABC W9XYZ EN37" A 1500 0.0 0.0 0.0 1 60 1 1 -26' + print*,'Example: q65sim "ST" A 1500 0.0 0.0 0.0 1 60 1 -26' + print*,' fDop = Doppler spread' + print*,' f1 = Drift or Doppler rate (Hz/min)' + print*,' Stp = Step size (Hz)' + print*,' Stp = 0 implies no Doppler tracking' + print*,' Nsig = number of generated signals, 1 - 10' + print*,' Creates filenames which increment to permit averaging in first period' + print*,' If msg = ST program produces a single tone at freq' + go to 999 + endif + call getarg(1,msg) + call getarg(2,csubmode) + mode65=2**(ichar(csubmode)-ichar('A')) + call getarg(3,arg) + read(arg,*) f00 + call getarg(4,arg) + read(arg,*) fspread + call getarg(5,arg) + read(arg,*) xdt + call getarg(6,arg) + read(arg,*) f1 + call getarg(7,arg) + read(arg,*) nstp + call getarg(8,arg) + read(arg,*) ntrperiod + call getarg(9,arg) + read(arg,*) nsig + call getarg(10,arg) + read(arg,*) nfiles + call getarg(11,arg) + read(arg,*) snrdb + + if(ntrperiod.eq.15) then + nsps=1800 + else if(ntrperiod.eq.30) then + nsps=3600 + else if(ntrperiod.eq.60) then + nsps=7200 + else if(ntrperiod.eq.120) then + nsps=16000 + else if(ntrperiod.eq.300) then + nsps=41472 + else + print*,'Invalid TR period' + go to 999 + endif + + rms=100. + fsample=12000.d0 !Sample rate (Hz) + npts=fsample*ntrperiod !Total samples in .wav file + nfft=npts + nh=nfft/2 + dt=1.d0/fsample !Sample interval (s) + twopi=8.d0*atan(1.d0) + nsym=85 !Number of channel symbols + mode65=2**(ichar(csubmode) - ichar('A')) + + + imsg(1)=msg + if(nsig.ge.2) then + i0=index(msg,' ') + i0=i0 + index(msg(i0+1:),' ')-2 + do i=1,nsig + c2=char(ichar('A')+i-1)//char(ichar('A')+i-1) + imsg(i)=msg(1:i0-1)//c2//msg(i0+2:) + enddo + endif + + ichk=0 + do i=1,nsig + msg=imsg(i) + call genq65(msg,ichk,msgsent,itone,i3,n3) + ntone(:,i)=itone + enddo + + if(nsig.eq.1) then + j=0 + do i=1,85 + if(itone(i).gt.0) then + j=j+1 + y(j)=itone(i)-1 + endif + enddo + write(*,1001) y(1:13),y(1:13) +1001 format('Generated message'/'6-bit: ',13i3/'binary: ',13b6.6) + write(*,1002) y +1002 format(/'Codeword:'/(20i3)) + write(*,1003) itone +1003 format(/'Channel symbols:'/(20i3)) + endif + + baud=12000.d0/nsps !Keying rate (6.67 baud fot 15-s sequences) + h=default_header(12000,npts) + + write(*,1004) +1004 format('File TR Freq Mode S/N Dop DT f1 Stp Message'/70('-')) + + do ifile=1,nfiles !Loop over requested number of files + istart = (ifile*ntrperiod*2) - (ntrperiod*2) + if(ntrperiod.lt.30) then !wdg was 60 + imins=istart/60 + isecs=istart-(60*imins) + write(fname,1005) imins,isecs !Construction of output filename for 15s periods with averaging +1005 format('000000_',i4.4, i2.2,'.wav') + else + write(fname,1106) istart/60 !Output filename to be compatible with averaging 30-300s periods +1106 format('000000_',i4.4,'.wav') + endif + + open(10,file=trim(fname),access='stream',status='unknown') + xnoise=0. + if(snrdb.lt.90) then + do i=1,npts + xnoise(i)=gran() !Generate gaussian noise + enddo + endif + cdat=0. + + bandwidth_ratio=2500.0/6000.0 + sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*snrdb) + if(snrdb.gt.90.0) sig=1.0 + write(*,1020) ifile,ntrperiod,f00,csubmode,snrdb,fspread,xdt,f1,nstp,trim(msgsent) +1020 format(i4,i6,f7.1,2x,a1,2x,f5.1,1x,f6.2,2f6.1,i4,2x,a) + + n=65.0*baud*mode65/100.0 + 0.9999 + nfstep=100*n + nf1=1500 - nfstep*(nsig-1)/2 + do n=1,nsig + f0=f00 + if(nsig.ge.2) then + f0=nf1 + (n-1)*nfstep + itone=ntone(:,n) + endif + phi=0.d0 + dphi=0.d0 + k=(xdt+0.5)*12000 !Start audio at t=xdt+0.5 s (TR=15 and 30 s) + if(ntrperiod.ge.60) k=(xdt+1.0)*12000 !TR 60+ at t = xdt + 1.0 s + isym0=-99 + do i=1,npts !Add this signal into cdat() + isym=i/nsps + 1 + if(isym.gt.nsym) exit + if(isym.ne.isym0) then + freq_drift=f1*i*dt/60.0 + if(nstp.ne.0) freq_drift=freq_drift - nstp*nint(freq_drift/nstp) + if (msg(1:2).eq.'ST') then + freq = f0 + freq_drift + else + freq = f0 + freq_drift + itone(isym)*baud*mode65 + endif + dphi=twopi*freq*dt + isym0=isym + endif + phi=phi + dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + z=cmplx(cos(xphi),sin(xphi)) + k=k+1 + if(k.ge.1) cdat(k)=cdat(k) + sig*z + enddo + enddo + + if(fspread.ne.0) then !Apply specified Doppler spread + df=12000.0/nfft + cspread(0)=1.0 + cspread(nh)=0. + b=6.0 !Use truncated Lorenzian shape for fspread + 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 amplitude + phi1=twopi*rran() !Random phase + z=a*cmplx(cos(phi1),sin(phi1)) + endif + cspread(i)=z + z=0. + if(x.lt.3.0) then !Same thing for negative freqs + phi2=twopi*rran() + z=a*cmplx(cos(phi2),sin(phi2)) + endif + cspread(nfft-i)=z + 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 + cdat=cspread*cdat !Apply Rayleigh fading + +! do i=0,nfft-1 +! p=real(cspread(i))**2 + aimag(cspread(i))**2 +! write(14,3010) i,p,cspread(i) +!3010 format(i8,3f12.6) +! enddo + endif + + dat=aimag(cdat) + xnoise !Add generated AWGN noise + fac=32767.0 + if(snrdb.ge.90.0) iwave(1:npts)=nint(fac*dat(1:npts)) + if(snrdb.lt.90.0) iwave(1:npts)=nint(rms*dat(1:npts)) + write(10) h,iwave(1:npts) !Save the .wav file + close(10) + enddo + +999 end program q65sim diff --git a/wsjtx_lib/lib/qra/q65/q65test.c b/wsjtx_lib/lib/qra/q65/q65test.c new file mode 100644 index 0000000..e907928 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/q65test.c @@ -0,0 +1,910 @@ +// q65test.c +// Word Error Rate test example for the Q65 mode +// Multi-threaded simulator version + +// (c) 2020 - Nico Palermo, IV3NWV +// +// +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// Dependencies: +// q65test.c - this file +// normrnd.c/.h - random gaussian number generator +// npfwht.c/.h - Fast Walsh-Hadamard Transforms +// pdmath.c/.h - Elementary math on probability distributions +// qra15_65_64_irr_e23.c/.h - Tables for the QRA(15,65) irregular RA code used by Q65 +// qracodes.c/.h - QRA codes encoding/decoding functions +// fadengauss.c - fading coefficients tables for gaussian shaped fast fading channels +// fadenlorenz.c - fading coefficients tables for lorenzian shaped fast fading channels +// +// ------------------------------------------------------------------------------- +// +// This is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . +// +// ------------------------------------------------------------------------------ + +// OS dependent defines and includes -------------------------------------------- + +#if _WIN32 // note the underscore: without it, it's not msdn official! + // Windows (x64 and x86) + #define _CRT_SECURE_NO_WARNINGS // we don't need warnings for sprintf/fopen function usage + #include // required only for GetTickCount(...) + #include // _beginthread +#endif + +#if defined(__linux__) + +// remove unwanted macros +#define __cdecl + +// implements Windows API +#include + + unsigned int GetTickCount(void) { + struct timespec ts; + unsigned int theTick = 0U; + clock_gettime( CLOCK_REALTIME, &ts ); + theTick = ts.tv_nsec / 1000000; + theTick += ts.tv_sec * 1000; + return theTick; +} + +// Convert Windows millisecond sleep +// +// VOID WINAPI Sleep(_In_ DWORD dwMilliseconds); +// +// to Posix usleep (in microseconds) +// +// int usleep(useconds_t usec); +// +#include +#define Sleep(x) usleep(x*1000) + +#endif + +#if defined(__linux__) || ( defined(__MINGW32__) || defined (__MIGW64__) ) +#include +#endif + +#if __APPLE__ +#endif + +#include +#include + +#include "qracodes.h" // basic qra encoding/decoding functions +#include "normrnd.h" // gaussian numbers generator +#include "pdmath.h" // operations on probability distributions + +#include "qra15_65_64_irr_e23.h" // QRA code used by Q65 +#include "q65.h" + +#define Q65_TS 0.640f // Q65 symbol time interval in seconds +#define Q65_REFBW 2500.0f // reference bandwidth in Hz for SNR estimates + +// ----------------------------------------------------------------------------------- + +#define NTHREADS_MAX 160 // if you have some big enterprise hardware + +// channel types +#define CHANNEL_AWGN 0 +#define CHANNEL_RAYLEIGH 1 +#define CHANNEL_FASTFADING 2 + +// amount of a-priori information provided to the decoder +#define AP_NONE 0 +#define AP_MYCALL 1 +#define AP_HISCALL 2 +#define AP_BOTHCALL 3 +#define AP_FULL 4 +#define AP_LAST AP_FULL + +const char ap_str[AP_LAST+1][16] = { + "None", + "32 bit", + "32 bit", + "62 bit", + "78 bit", +}; +const char fnameout_sfx[AP_LAST+1][64] = { + "-ap00.txt", + "-ap32m.txt", + "-ap32h.txt", + "-ap62.txt", + "-ap78.txt" +}; + +const char fnameout_pfx[3][64] = { + "wer-awgn-", + "wer-rayl-", + "wer-ff-" +}; + +// AP masks are computed assuming that the source message has been packed in 13 symbols s[0]..[s12] +// in a little indian format, that's to say: + +// s[0] = {src5 src4 src3 src2 src1 src0} +// s[1] = {src11 src10 src9 src8 src7 src6} +// ... +// s[12]= {src78 src77 src76 src75 src74 src73} +// +// where srcj is the j-th bit of the source message. +// +// It is also assumed that the source message is as indicated by the protocol specification of wsjt-x +// structured messages. src78 should be always set to a value known by the decoder (and masked as an AP bit) +// With this convention the field i3 of the structured message is mapped to bits src77 src76 src75, +// that's to say to the 3rd,4th and 5th bit of s[12]. +// Therefore, if i3 is known in advance, since src78 is always known, +// the AP mask for s[12] is 0x3C (4 most significant bits of s[12] are known) + +const int ap_masks_q65[AP_LAST+1][13] = { +// AP0 Mask +{ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}, +// Mask first(c28 r1) .... i3 src78 (AP32my MyCall ? ? StdMsg) +{ 0x3F, 0x3F, 0x3F, 0x3F, 0x1F, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3C}, +// Mask second(c28 r1) .... i3 src78 (AP32his ? HisCall ? StdMsg) +{ 0x00, 0x00, 0x00, 0x00, 0x20, 0x3F, 0x3F, 0x3F, 0x3F, 0x0F, 0x00, 0x00, 0x3C}, +// Mask (c28 r1 c28 r1) ... i3 src78 (AP62 MyCall HisCall ? StdMsg) +{ 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x0F, 0x00, 0x00, 0x3C}, +// Mask All (c28 r1 c28 r1 R g15 StdMsg src78) (AP78) +{ 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F, 0x3F}, +}; + +int verbose = 0; + +void printword(char *msg, int *x, int size) +{ + int k; + printf("\n%s ",msg); + for (k=0;kchannel_type; + + rc = q65_init(&codec,pdata->pcode); + + if (rc<0) { + printf("error in qra65_init\n"); + goto term_thread; + } + + nK = q65_get_message_length(&codec); + nN = q65_get_codeword_length(&codec); + nM = q65_get_alphabet_size(&codec); + nm = q65_get_bits_per_symbol(&codec); + R = q65_get_code_rate(&codec); + + nSamples = nN*nM; + + x = (int*)malloc(nK*sizeof(int)); + xdec = (int*)malloc(nK*sizeof(int)); + y = (int*)malloc(nN*sizeof(int)); + ydec = (int*)malloc(nN*sizeof(int)); + rsquared = (float*)malloc(nSamples*sizeof(float)); + pIntrinsics = (float*)malloc(nSamples*sizeof(float)); + + // sets the AP mask to be used for this simulation + if (pdata->ap_index==AP_NONE) + apMask = NULL; // we simply avoid masking if ap-index specifies no AP + else + apMask = ap_masks_q65[pdata->ap_index]; + + // Channel simulation variables -------------------- + rp = (float*)malloc(nSamples*sizeof(float)); + rq = (float*)malloc(nSamples*sizeof(float)); + chp = (float*)malloc(nN*sizeof(float)); + chq = (float*)malloc(nN*sizeof(float)); + + EbNo = (float)powf(10,pdata->EbNodB/10); + EsNo = 1.0f*nm*R*EbNo; + Es = EsNo*No; + A = (float)sqrt(Es); + + // Generate a (meaningless) test message + for (k=0;kstop==0) { + + // Channel simulation -------------------------------------------- + // Generate AWGN noise + normrnd_s(rp,nSamples,0,sigma); + normrnd_s(rq,nSamples,0,sigma); + + if (channel_type == CHANNEL_AWGN) + // add symbol amplitudes + for (k=0;k0 && verbose==1) { + float EbNodBestimated; + float SNRdBestimated; + q65_esnodb(&codec, &EsNodBestimated, ydec,rsquared); + EbNodBestimated = EsNodBestimated -10.0f*log10f(R*nm); + SNRdBestimated = EsNodBestimated -10.0f*log10f(Q65_TS*Q65_REFBW); + printf("\nEstimated Eb/No=%5.1fdB SNR2500=%5.1fdB", + EbNodBestimated, + SNRdBestimated); + } + + nt = nt+1; + pdata->nt=nt; + pdata->nerrs=nerrs; + pdata->ncrcwrong = ncrcwrong; + } + +term_thread: + + free(x); + free(xdec); + free(y); + free(ydec); + free(rsquared); + free(pIntrinsics); + + free(rp); + free(rq); + free(chp); + free(chq); + + q65_free(&codec); + + // signal the calling thread we are quitting + pdata->done=1; + #if _WIN32 + _endthread(); + #endif +} + +void wer_test_thread_ff(wer_test_ds *pdata) +{ + // We don't do a realistic simulation of the fading-channel here + // If required give a look to the simulator used in the QRA64 mode. + // For the purpose of testing the formal correctness of the Q65 decoder + // fast-fadind routines here we simulate the channel as a Rayleigh channel + // with no frequency spread but use the q65....-fastfading routines + // to check that they produce correct results also in this case. + + const int submode = 2; // Assume that we are using the Q65C tone spacing + const float B90 = 4.0f; // Configure the Q65 fast-fading decoder for a the given freq. spread + const int fadingModel = 1; // Assume a lorenzian frequency spread + + int nt = 0; // transmitted codewords + int nerrs = 0; // total number of errors + int ncrcwrong = 0; // number of decodes with wrong crc + + q65_codec_ds codec; + + int rc, k; + int nK, nN, nM, nm, nSamples; + int *x, *y, *xdec, *ydec; + const int *apMask; + float R; + float *rsquared, *pIntrinsics; + float EsNodBestimated; + + int nBinsPerTone, nBinsPerSymbol; + + + // for channel simulation + const float No = 1.0f; // noise spectral density + const float sigma = sqrtf(No/2.0f); // std dev of I/Q noise components + const float sigmach = sqrtf(1/2.0f); // std dev of I/Q channel gains (Rayleigh channel) + float EbNo, EsNo, Es, A; + float *rp, *rq, *chp, *chq; + int channel_type = pdata->channel_type; + + rc = q65_init(&codec,pdata->pcode); + + if (rc<0) { + printf("error in q65_init\n"); + goto term_thread; + } + + nK = q65_get_message_length(&codec); + nN = q65_get_codeword_length(&codec); + nM = q65_get_alphabet_size(&codec); + nm = q65_get_bits_per_symbol(&codec); + R = q65_get_code_rate(&codec); + + + nBinsPerTone = 1<ap_index==AP_NONE) + apMask = NULL; // we simply avoid masking if ap-index specifies no AP + else + apMask = ap_masks_q65[pdata->ap_index]; + + + x = (int*)malloc(nK*sizeof(int)); + xdec = (int*)malloc(nK*sizeof(int)); + y = (int*)malloc(nN*sizeof(int)); + ydec = (int*)malloc(nN*sizeof(int)); + rsquared = (float*)malloc(nSamples*sizeof(float)); + pIntrinsics = (float*)malloc(nN*nM*sizeof(float)); + + // Channel simulation variables -------------------- + rp = (float*)malloc(nSamples*sizeof(float)); + rq = (float*)malloc(nSamples*sizeof(float)); + chp = (float*)malloc(nN*sizeof(float)); + chq = (float*)malloc(nN*sizeof(float)); + + EbNo = (float)powf(10,pdata->EbNodB/10); + EsNo = 1.0f*nm*R*EbNo; + Es = EsNo*No; + A = (float)sqrt(Es); + // ------------------------------------------------- + + // generate a test message + for (k=0;kstop==0) { + + // Channel simulation -------------------------------------------- + // generate AWGN noise + normrnd_s(rp,nSamples,0,sigma); + normrnd_s(rq,nSamples,0,sigma); + + + // Generate Rayleigh distributed symbol amplitudes + normrnd_s(chp,nN,0,sigmach); + normrnd_s(chq,nN,0,sigmach); + // Don't simulate a really frequency spreaded signal. + // Just place the tones in the appropriate central bins + // ot the received signal + for (k=0;k0 && verbose==1) { + float EbNodBestimated; + float SNRdBestimated; + // use the fastfading version + q65_esnodb_fastfading(&codec, &EsNodBestimated, ydec,rsquared); + EbNodBestimated = EsNodBestimated -10.0f*log10f(R*nm); + SNRdBestimated = EsNodBestimated -10.0f*log10f(Q65_TS*Q65_REFBW); + printf("\nEstimated Eb/No=%5.1fdB SNR2500=%5.1fdB", + EbNodBestimated, + SNRdBestimated); + } + + nt = nt+1; + pdata->nt=nt; + pdata->nerrs=nerrs; + pdata->ncrcwrong = ncrcwrong; + } + +term_thread: + + free(x); + free(xdec); + free(y); + free(ydec); + free(rsquared); + free(pIntrinsics); + + free(rp); + free(rq); + free(chp); + free(chq); + + q65_free(&codec); + + // signal the calling thread we are quitting + pdata->done=1; + #if _WIN32 + _endthread(); + #endif +} + + +#if defined(__linux__) || ( defined(__MINGW32__) || defined (__MIGW64__) ) + +void *wer_test_pthread_awgnrayl(void *p) +{ + wer_test_thread_awgnrayl((wer_test_ds *)p); + return 0; +} + +void *wer_test_pthread_ff(void *p) +{ + wer_test_thread_ff((wer_test_ds *)p); + return 0; +} + +#endif + + +int wer_test_proc(const qracode *pcode, int nthreads, int chtype, int ap_index, float *EbNodB, int *nerrstgt, int nitems) +{ + int k,j,nt,nerrs,nerrsu,ncrcwrong,nd; + int cini,cend; + char fnameout[128]; + FILE *fout; + wer_test_ds wt[NTHREADS_MAX]; + float pe,peu,avgt; + + if (nthreads>NTHREADS_MAX) { + printf("Error: nthreads should be <=%d\n",NTHREADS_MAX); + return -1; + } + + sprintf(fnameout,"%s%s%s", + fnameout_pfx[chtype], + pcode->name, + fnameout_sfx[ap_index]); + + fout = fopen(fnameout,"w"); + fprintf(fout,"#Code Name: %s\n",pcode->name); + fprintf(fout,"#ChannelType (0=AWGN,1=Rayleigh,2=Fast-Fading)\n#Eb/No (dB)\n#Transmitted Codewords\n#Errors\n#CRC Errors\n#Undetected\n#Avg dec. time (ms)\n#WER\n#UER\n"); + + printf("\nTesting the code %s\nSimulation data will be saved to %s\n", + pcode->name, + fnameout); + fflush (stdout); + + // init fixed thread parameters and preallocate buffers + for (j=0;j=nerrstgt[k]) { + for (j=0;j] [-t] [-c] [-a] [-f[-h]\n"); + printf("Options: \n"); + printf(" -q: code to simulate. 0=qra_15_65_64_irr_e23 (default)\n"); + printf(" -t : number of threads to be used for the simulation [1..24]\n"); + printf(" (default=8)\n"); + printf(" -c : channel_type. 0=AWGN 1=Rayleigh 2=Fast-Fading\n"); + printf(" (default=AWGN)\n"); + printf(" -a : amount of a-priori information provided to decoder. \n"); + printf(" 0= No a-priori (default)\n"); + printf(" 1= 32 bit (Mycall)\n"); + printf(" 2= 32 bit (Hiscall)\n"); + printf(" 3= 62 bit (Bothcalls\n"); + printf(" 4= 78 bit (full AP)\n"); + printf(" -v : verbose (output SNRs of decoded messages\n"); + + printf(" -f : name of the file containing the Eb/No values to be simulated\n"); + printf(" (default=ebnovalues.txt)\n"); + printf(" This file should contain lines in this format:\n"); + printf(" # Eb/No(dB) Target Errors\n"); + printf(" 0.1 5000\n"); + printf(" 0.6 5000\n"); + printf(" 1.1 1000\n"); + printf(" 1.6 1000\n"); + printf(" ...\n"); + printf(" (lines beginning with a # are treated as comments\n\n"); +} + +#define SIM_POINTS_MAX 20 + +int main(int argc, char* argv[]) +{ + + float EbNodB[SIM_POINTS_MAX]; + int nerrstgt[SIM_POINTS_MAX]; + FILE *fin; + + char fnamein[128]= "ebnovalues.txt"; + char buf[128]; + + int nitems = 0; + int code_idx = 0; + int nthreads = 8; + int ch_type = CHANNEL_AWGN; + int ap_index = AP_NONE; + + // parse command line + while(--argc) { + argv++; + if (strncmp(*argv,"-h",2)==0) { + syntax(); + return 0; + } + else + if (strncmp(*argv,"-q",2)==0) { + code_idx = (int)atoi((*argv)+2); + if (code_idx>7) { + printf("Invalid code index\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-t",2)==0) { + nthreads = (int)atoi((*argv)+2); + +// printf("nthreads = %d\n",nthreads); + + if (nthreads>NTHREADS_MAX) { + printf("Invalid number of threads\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-c",2)==0) { + ch_type = (int)atoi((*argv)+2); + if (ch_type>CHANNEL_FASTFADING) { + printf("Invalid channel type\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-a",2)==0) { + ap_index = (int)atoi((*argv)+2); + if (ap_index>AP_LAST) { + printf("Invalid a-priori information index\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-f",2)==0) { + strncpy(fnamein,(*argv)+2,127); + } + else + if (strncmp(*argv,"-h",2)==0) { + syntax(); + return -1; + } + else + if (strncmp(*argv,"-v",2)==0) + verbose = TRUE; + else { + printf("Invalid option\n"); + syntax(); + return -1; + } + } + + // parse points to be simulated from the input file + fin = fopen(fnamein,"r"); + if (!fin) { + printf("Can't open file: %s\n",fnamein); + syntax(); + return -1; + } + + while (fgets(buf,128,fin)!=0) + if (*buf=='#' || *buf=='\n' ) + continue; + else + if (nitems==SIM_POINTS_MAX) + break; + else + if (sscanf(buf,"%f %u",&EbNodB[nitems],&nerrstgt[nitems])!=2) { + printf("Invalid input file format\n"); + syntax(); + return -1; + } + else + nitems++; + + fclose(fin); + + if (nitems==0) { + printf("No Eb/No point specified in file %s\n",fnamein); + syntax(); + return -1; + } + + printf("\nQ65 Word Error Rate Simulator\n"); + printf("(c) 2016-2020, Nico Palermo - IV3NWV\n\n"); + + printf("Nthreads = %d\n",nthreads); + switch(ch_type) { + case CHANNEL_AWGN: + printf("Channel = AWGN\n"); + break; + case CHANNEL_RAYLEIGH: + printf("Channel = Rayleigh\n"); + break; + case CHANNEL_FASTFADING: + printf("Channel = Fast Fading\n"); + break; + } + printf("Codename = %s\n",codetotest[code_idx]->name); + printf("A-priori = %s\n",ap_str[ap_index]); + printf("Eb/No input file = %s\n\n",fnamein); + + wer_test_proc(codetotest[code_idx], nthreads, ch_type, ap_index, EbNodB, nerrstgt, nitems); + + printf("\n\n\n"); + return 0; +} + diff --git a/wsjtx_lib/lib/qra/q65/qra15_65_64_irr_e23.c b/wsjtx_lib/lib/qra/q65/qra15_65_64_irr_e23.c new file mode 100644 index 0000000..8866716 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/qra15_65_64_irr_e23.c @@ -0,0 +1,558 @@ +// qra15_65_64_irr_e23.c +// Encoding/Decoding tables for Q-ary RA code (15,65) over GF(64) +// Code Name: qra15_65_64_irr_e23 +// (15,65) RA Code over GF(64) + +// (c) 2020 - Nico Palermo - IV3NWV - Microtelecom Srl, Italy + +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "qra15_65_64_irr_e23.h" + +// File generated by npiwnarsavehc.m + +#define qra_K 15 // number of information symbols +#define qra_N 65 // codeword length in symbols +#define qra_m 6 // bits/symbol +#define qra_M 64 // Symbol alphabet cardinality +#define qra_a 1 // grouping factor +#define qra_NC 50 // number of check symbols (N-K) + +// Defines used by the message passing decoder -------- + +#define qra_V 65 // number of variables in the code graph (N) +#define qra_C 116 // number of factors in the code graph (N +(N-K)+1) +#define qra_NMSG 216 // number of msgs in the code graph +#define qra_MAXVDEG 5 // maximum variable degree +#define qra_MAXCDEG 3 // maximum factor degree +#define qra_R 0.23077f // code rate (K/N) +#define CODE_NAME "qra15_65_64_irr_e23" // code name + +// table of the systematic symbols indexes in the accumulator chain +static const int qra_acc_input_idx[qra_NC+1] = { + 13, 1, 3, 4, 8, 12, 9, 14, 10, 5, + 0, 7, 1, 11, 8, 9, 12, 6, 3, 10, + 7, 5, 2, 13, 12, 4, 8, 0, 1, 11, + 2, 9, 14, 5, 6, 13, 7, 12, 11, 2, + 9, 0, 10, 4, 7, 14, 8, 11, 3, 6, + 10 +}; + +// table of the systematic symbols weight logarithms over GF(M) +static const int qra_acc_input_wlog[qra_NC+1] = { + 0, 14, 0, 0, 13, 37, 0, 27, 56, 62, + 29, 0, 52, 34, 62, 4, 3, 22, 25, 0, + 22, 0, 20, 10, 0, 43, 53, 60, 0, 0, + 0, 62, 0, 5, 0, 61, 36, 31, 61, 59, + 10, 0, 29, 39, 25, 18, 0, 14, 11, 50, + 17 +}; + +// table of the logarithms of the elements of GF(M) (log(0) never used) +static const int qra_log[qra_M] = { + -1, 0, 1, 6, 2, 12, 7, 26, 3, 32, + 13, 35, 8, 48, 27, 18, 4, 24, 33, 16, + 14, 52, 36, 54, 9, 45, 49, 38, 28, 41, + 19, 56, 5, 62, 25, 11, 34, 31, 17, 47, + 15, 23, 53, 51, 37, 44, 55, 40, 10, 61, + 46, 30, 50, 22, 39, 43, 29, 60, 42, 21, + 20, 59, 57, 58 +}; + +// table of GF(M) elements given their logarithm +static const int qra_exp[qra_M-1] = { + 1, 2, 4, 8, 16, 32, 3, 6, 12, 24, + 48, 35, 5, 10, 20, 40, 19, 38, 15, 30, + 60, 59, 53, 41, 17, 34, 7, 14, 28, 56, + 51, 37, 9, 18, 36, 11, 22, 44, 27, 54, + 47, 29, 58, 55, 45, 25, 50, 39, 13, 26, + 52, 43, 21, 42, 23, 46, 31, 62, 63, 61, + 57, 49, 33 +}; + +// table of the messages weight logarithms over GF(M) +static const int qra_msgw[qra_NMSG] = { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 14, 0, 0, 13, + 37, 0, 27, 56, 62, 29, 0, 52, 34, 62, + 4, 3, 22, 25, 0, 22, 0, 20, 10, 0, + 43, 53, 60, 0, 0, 0, 62, 0, 5, 0, + 61, 36, 31, 61, 59, 10, 0, 29, 39, 25, + 18, 0, 14, 11, 50, 17, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0 +}; + +// table of the degrees of the variable nodes +static const int qra_vdeg[qra_V] = { + 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, + 5, 5, 5, 4, 4, 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 +}; + +// table of the degrees of the factor nodes +static const int qra_cdeg[qra_C] = { + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 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, 2 +}; + +// table (uncompressed) of the v->c message indexes (-1=unused entry) +static const int qra_v2cmidx[qra_V*qra_MAXVDEG] = { + 0, 75, 92, 106, -1, + 1, 66, 77, 93, -1, + 2, 87, 95, 104, -1, + 3, 67, 83, 113, -1, + 4, 68, 90, 108, -1, + 5, 74, 86, 98, -1, + 6, 82, 99, 114, -1, + 7, 76, 85, 101, 109, + 8, 69, 79, 91, 111, + 9, 71, 80, 96, 105, + 10, 73, 84, 107, 115, + 11, 78, 94, 103, 112, + 12, 70, 81, 89, 102, + 13, 65, 88, 100, -1, + 14, 72, 97, 110, -1, + 15, 116, 117, -1, -1, + 16, 118, 119, -1, -1, + 17, 120, 121, -1, -1, + 18, 122, 123, -1, -1, + 19, 124, 125, -1, -1, + 20, 126, 127, -1, -1, + 21, 128, 129, -1, -1, + 22, 130, 131, -1, -1, + 23, 132, 133, -1, -1, + 24, 134, 135, -1, -1, + 25, 136, 137, -1, -1, + 26, 138, 139, -1, -1, + 27, 140, 141, -1, -1, + 28, 142, 143, -1, -1, + 29, 144, 145, -1, -1, + 30, 146, 147, -1, -1, + 31, 148, 149, -1, -1, + 32, 150, 151, -1, -1, + 33, 152, 153, -1, -1, + 34, 154, 155, -1, -1, + 35, 156, 157, -1, -1, + 36, 158, 159, -1, -1, + 37, 160, 161, -1, -1, + 38, 162, 163, -1, -1, + 39, 164, 165, -1, -1, + 40, 166, 167, -1, -1, + 41, 168, 169, -1, -1, + 42, 170, 171, -1, -1, + 43, 172, 173, -1, -1, + 44, 174, 175, -1, -1, + 45, 176, 177, -1, -1, + 46, 178, 179, -1, -1, + 47, 180, 181, -1, -1, + 48, 182, 183, -1, -1, + 49, 184, 185, -1, -1, + 50, 186, 187, -1, -1, + 51, 188, 189, -1, -1, + 52, 190, 191, -1, -1, + 53, 192, 193, -1, -1, + 54, 194, 195, -1, -1, + 55, 196, 197, -1, -1, + 56, 198, 199, -1, -1, + 57, 200, 201, -1, -1, + 58, 202, 203, -1, -1, + 59, 204, 205, -1, -1, + 60, 206, 207, -1, -1, + 61, 208, 209, -1, -1, + 62, 210, 211, -1, -1, + 63, 212, 213, -1, -1, + 64, 214, 215, -1, -1 +}; + +// table (uncompressed) of the c->v message indexes (-1=unused entry) +static const int qra_c2vmidx[qra_C*qra_MAXCDEG] = { + 0, -1, -1, 1, -1, -1, 2, -1, -1, 3, -1, -1, + 4, -1, -1, 5, -1, -1, 6, -1, -1, 7, -1, -1, + 8, -1, -1, 9, -1, -1, 10, -1, -1, 11, -1, -1, + 12, -1, -1, 13, -1, -1, 14, -1, -1, 15, -1, -1, + 16, -1, -1, 17, -1, -1, 18, -1, -1, 19, -1, -1, + 20, -1, -1, 21, -1, -1, 22, -1, -1, 23, -1, -1, + 24, -1, -1, 25, -1, -1, 26, -1, -1, 27, -1, -1, + 28, -1, -1, 29, -1, -1, 30, -1, -1, 31, -1, -1, + 32, -1, -1, 33, -1, -1, 34, -1, -1, 35, -1, -1, + 36, -1, -1, 37, -1, -1, 38, -1, -1, 39, -1, -1, + 40, -1, -1, 41, -1, -1, 42, -1, -1, 43, -1, -1, + 44, -1, -1, 45, -1, -1, 46, -1, -1, 47, -1, -1, + 48, -1, -1, 49, -1, -1, 50, -1, -1, 51, -1, -1, + 52, -1, -1, 53, -1, -1, 54, -1, -1, 55, -1, -1, + 56, -1, -1, 57, -1, -1, 58, -1, -1, 59, -1, -1, + 60, -1, -1, 61, -1, -1, 62, -1, -1, 63, -1, -1, + 64, -1, -1, 65, 116, -1, 66, 117, 118, 67, 119, 120, + 68, 121, 122, 69, 123, 124, 70, 125, 126, 71, 127, 128, + 72, 129, 130, 73, 131, 132, 74, 133, 134, 75, 135, 136, + 76, 137, 138, 77, 139, 140, 78, 141, 142, 79, 143, 144, + 80, 145, 146, 81, 147, 148, 82, 149, 150, 83, 151, 152, + 84, 153, 154, 85, 155, 156, 86, 157, 158, 87, 159, 160, + 88, 161, 162, 89, 163, 164, 90, 165, 166, 91, 167, 168, + 92, 169, 170, 93, 171, 172, 94, 173, 174, 95, 175, 176, + 96, 177, 178, 97, 179, 180, 98, 181, 182, 99, 183, 184, +100, 185, 186, 101, 187, 188, 102, 189, 190, 103, 191, 192, +104, 193, 194, 105, 195, 196, 106, 197, 198, 107, 199, 200, +108, 201, 202, 109, 203, 204, 110, 205, 206, 111, 207, 208, +112, 209, 210, 113, 211, 212, 114, 213, 214, 115, 215, -1 +}; + +// permutation matrix to compute Prob(x*alfa^logw) +static const int qra_pmat[qra_M*qra_M] = { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 0, 33, 1, 32, 2, 35, 3, 34, 4, 37, 5, 36, 6, 39, 7, 38, + 8, 41, 9, 40, 10, 43, 11, 42, 12, 45, 13, 44, 14, 47, 15, 46, + 16, 49, 17, 48, 18, 51, 19, 50, 20, 53, 21, 52, 22, 55, 23, 54, + 24, 57, 25, 56, 26, 59, 27, 58, 28, 61, 29, 60, 30, 63, 31, 62, + 0, 49, 33, 16, 1, 48, 32, 17, 2, 51, 35, 18, 3, 50, 34, 19, + 4, 53, 37, 20, 5, 52, 36, 21, 6, 55, 39, 22, 7, 54, 38, 23, + 8, 57, 41, 24, 9, 56, 40, 25, 10, 59, 43, 26, 11, 58, 42, 27, + 12, 61, 45, 28, 13, 60, 44, 29, 14, 63, 47, 30, 15, 62, 46, 31, + 0, 57, 49, 8, 33, 24, 16, 41, 1, 56, 48, 9, 32, 25, 17, 40, + 2, 59, 51, 10, 35, 26, 18, 43, 3, 58, 50, 11, 34, 27, 19, 42, + 4, 61, 53, 12, 37, 28, 20, 45, 5, 60, 52, 13, 36, 29, 21, 44, + 6, 63, 55, 14, 39, 30, 22, 47, 7, 62, 54, 15, 38, 31, 23, 46, + 0, 61, 57, 4, 49, 12, 8, 53, 33, 28, 24, 37, 16, 45, 41, 20, + 1, 60, 56, 5, 48, 13, 9, 52, 32, 29, 25, 36, 17, 44, 40, 21, + 2, 63, 59, 6, 51, 14, 10, 55, 35, 30, 26, 39, 18, 47, 43, 22, + 3, 62, 58, 7, 50, 15, 11, 54, 34, 31, 27, 38, 19, 46, 42, 23, + 0, 63, 61, 2, 57, 6, 4, 59, 49, 14, 12, 51, 8, 55, 53, 10, + 33, 30, 28, 35, 24, 39, 37, 26, 16, 47, 45, 18, 41, 22, 20, 43, + 1, 62, 60, 3, 56, 7, 5, 58, 48, 15, 13, 50, 9, 54, 52, 11, + 32, 31, 29, 34, 25, 38, 36, 27, 17, 46, 44, 19, 40, 23, 21, 42, + 0, 62, 63, 1, 61, 3, 2, 60, 57, 7, 6, 56, 4, 58, 59, 5, + 49, 15, 14, 48, 12, 50, 51, 13, 8, 54, 55, 9, 53, 11, 10, 52, + 33, 31, 30, 32, 28, 34, 35, 29, 24, 38, 39, 25, 37, 27, 26, 36, + 16, 46, 47, 17, 45, 19, 18, 44, 41, 23, 22, 40, 20, 42, 43, 21, + 0, 31, 62, 33, 63, 32, 1, 30, 61, 34, 3, 28, 2, 29, 60, 35, + 57, 38, 7, 24, 6, 25, 56, 39, 4, 27, 58, 37, 59, 36, 5, 26, + 49, 46, 15, 16, 14, 17, 48, 47, 12, 19, 50, 45, 51, 44, 13, 18, + 8, 23, 54, 41, 55, 40, 9, 22, 53, 42, 11, 20, 10, 21, 52, 43, + 0, 46, 31, 49, 62, 16, 33, 15, 63, 17, 32, 14, 1, 47, 30, 48, + 61, 19, 34, 12, 3, 45, 28, 50, 2, 44, 29, 51, 60, 18, 35, 13, + 57, 23, 38, 8, 7, 41, 24, 54, 6, 40, 25, 55, 56, 22, 39, 9, + 4, 42, 27, 53, 58, 20, 37, 11, 59, 21, 36, 10, 5, 43, 26, 52, + 0, 23, 46, 57, 31, 8, 49, 38, 62, 41, 16, 7, 33, 54, 15, 24, + 63, 40, 17, 6, 32, 55, 14, 25, 1, 22, 47, 56, 30, 9, 48, 39, + 61, 42, 19, 4, 34, 53, 12, 27, 3, 20, 45, 58, 28, 11, 50, 37, + 2, 21, 44, 59, 29, 10, 51, 36, 60, 43, 18, 5, 35, 52, 13, 26, + 0, 42, 23, 61, 46, 4, 57, 19, 31, 53, 8, 34, 49, 27, 38, 12, + 62, 20, 41, 3, 16, 58, 7, 45, 33, 11, 54, 28, 15, 37, 24, 50, + 63, 21, 40, 2, 17, 59, 6, 44, 32, 10, 55, 29, 14, 36, 25, 51, + 1, 43, 22, 60, 47, 5, 56, 18, 30, 52, 9, 35, 48, 26, 39, 13, + 0, 21, 42, 63, 23, 2, 61, 40, 46, 59, 4, 17, 57, 44, 19, 6, + 31, 10, 53, 32, 8, 29, 34, 55, 49, 36, 27, 14, 38, 51, 12, 25, + 62, 43, 20, 1, 41, 60, 3, 22, 16, 5, 58, 47, 7, 18, 45, 56, + 33, 52, 11, 30, 54, 35, 28, 9, 15, 26, 37, 48, 24, 13, 50, 39, + 0, 43, 21, 62, 42, 1, 63, 20, 23, 60, 2, 41, 61, 22, 40, 3, + 46, 5, 59, 16, 4, 47, 17, 58, 57, 18, 44, 7, 19, 56, 6, 45, + 31, 52, 10, 33, 53, 30, 32, 11, 8, 35, 29, 54, 34, 9, 55, 28, + 49, 26, 36, 15, 27, 48, 14, 37, 38, 13, 51, 24, 12, 39, 25, 50, + 0, 52, 43, 31, 21, 33, 62, 10, 42, 30, 1, 53, 63, 11, 20, 32, + 23, 35, 60, 8, 2, 54, 41, 29, 61, 9, 22, 34, 40, 28, 3, 55, + 46, 26, 5, 49, 59, 15, 16, 36, 4, 48, 47, 27, 17, 37, 58, 14, + 57, 13, 18, 38, 44, 24, 7, 51, 19, 39, 56, 12, 6, 50, 45, 25, + 0, 26, 52, 46, 43, 49, 31, 5, 21, 15, 33, 59, 62, 36, 10, 16, + 42, 48, 30, 4, 1, 27, 53, 47, 63, 37, 11, 17, 20, 14, 32, 58, + 23, 13, 35, 57, 60, 38, 8, 18, 2, 24, 54, 44, 41, 51, 29, 7, + 61, 39, 9, 19, 22, 12, 34, 56, 40, 50, 28, 6, 3, 25, 55, 45, + 0, 13, 26, 23, 52, 57, 46, 35, 43, 38, 49, 60, 31, 18, 5, 8, + 21, 24, 15, 2, 33, 44, 59, 54, 62, 51, 36, 41, 10, 7, 16, 29, + 42, 39, 48, 61, 30, 19, 4, 9, 1, 12, 27, 22, 53, 56, 47, 34, + 63, 50, 37, 40, 11, 6, 17, 28, 20, 25, 14, 3, 32, 45, 58, 55, + 0, 39, 13, 42, 26, 61, 23, 48, 52, 19, 57, 30, 46, 9, 35, 4, + 43, 12, 38, 1, 49, 22, 60, 27, 31, 56, 18, 53, 5, 34, 8, 47, + 21, 50, 24, 63, 15, 40, 2, 37, 33, 6, 44, 11, 59, 28, 54, 17, + 62, 25, 51, 20, 36, 3, 41, 14, 10, 45, 7, 32, 16, 55, 29, 58, + 0, 50, 39, 21, 13, 63, 42, 24, 26, 40, 61, 15, 23, 37, 48, 2, + 52, 6, 19, 33, 57, 11, 30, 44, 46, 28, 9, 59, 35, 17, 4, 54, + 43, 25, 12, 62, 38, 20, 1, 51, 49, 3, 22, 36, 60, 14, 27, 41, + 31, 45, 56, 10, 18, 32, 53, 7, 5, 55, 34, 16, 8, 58, 47, 29, + 0, 25, 50, 43, 39, 62, 21, 12, 13, 20, 63, 38, 42, 51, 24, 1, + 26, 3, 40, 49, 61, 36, 15, 22, 23, 14, 37, 60, 48, 41, 2, 27, + 52, 45, 6, 31, 19, 10, 33, 56, 57, 32, 11, 18, 30, 7, 44, 53, + 46, 55, 28, 5, 9, 16, 59, 34, 35, 58, 17, 8, 4, 29, 54, 47, + 0, 45, 25, 52, 50, 31, 43, 6, 39, 10, 62, 19, 21, 56, 12, 33, + 13, 32, 20, 57, 63, 18, 38, 11, 42, 7, 51, 30, 24, 53, 1, 44, + 26, 55, 3, 46, 40, 5, 49, 28, 61, 16, 36, 9, 15, 34, 22, 59, + 23, 58, 14, 35, 37, 8, 60, 17, 48, 29, 41, 4, 2, 47, 27, 54, + 0, 55, 45, 26, 25, 46, 52, 3, 50, 5, 31, 40, 43, 28, 6, 49, + 39, 16, 10, 61, 62, 9, 19, 36, 21, 34, 56, 15, 12, 59, 33, 22, + 13, 58, 32, 23, 20, 35, 57, 14, 63, 8, 18, 37, 38, 17, 11, 60, + 42, 29, 7, 48, 51, 4, 30, 41, 24, 47, 53, 2, 1, 54, 44, 27, + 0, 58, 55, 13, 45, 23, 26, 32, 25, 35, 46, 20, 52, 14, 3, 57, + 50, 8, 5, 63, 31, 37, 40, 18, 43, 17, 28, 38, 6, 60, 49, 11, + 39, 29, 16, 42, 10, 48, 61, 7, 62, 4, 9, 51, 19, 41, 36, 30, + 21, 47, 34, 24, 56, 2, 15, 53, 12, 54, 59, 1, 33, 27, 22, 44, + 0, 29, 58, 39, 55, 42, 13, 16, 45, 48, 23, 10, 26, 7, 32, 61, + 25, 4, 35, 62, 46, 51, 20, 9, 52, 41, 14, 19, 3, 30, 57, 36, + 50, 47, 8, 21, 5, 24, 63, 34, 31, 2, 37, 56, 40, 53, 18, 15, + 43, 54, 17, 12, 28, 1, 38, 59, 6, 27, 60, 33, 49, 44, 11, 22, + 0, 47, 29, 50, 58, 21, 39, 8, 55, 24, 42, 5, 13, 34, 16, 63, + 45, 2, 48, 31, 23, 56, 10, 37, 26, 53, 7, 40, 32, 15, 61, 18, + 25, 54, 4, 43, 35, 12, 62, 17, 46, 1, 51, 28, 20, 59, 9, 38, + 52, 27, 41, 6, 14, 33, 19, 60, 3, 44, 30, 49, 57, 22, 36, 11, + 0, 54, 47, 25, 29, 43, 50, 4, 58, 12, 21, 35, 39, 17, 8, 62, + 55, 1, 24, 46, 42, 28, 5, 51, 13, 59, 34, 20, 16, 38, 63, 9, + 45, 27, 2, 52, 48, 6, 31, 41, 23, 33, 56, 14, 10, 60, 37, 19, + 26, 44, 53, 3, 7, 49, 40, 30, 32, 22, 15, 57, 61, 11, 18, 36, + 0, 27, 54, 45, 47, 52, 25, 2, 29, 6, 43, 48, 50, 41, 4, 31, + 58, 33, 12, 23, 21, 14, 35, 56, 39, 60, 17, 10, 8, 19, 62, 37, + 55, 44, 1, 26, 24, 3, 46, 53, 42, 49, 28, 7, 5, 30, 51, 40, + 13, 22, 59, 32, 34, 57, 20, 15, 16, 11, 38, 61, 63, 36, 9, 18, + 0, 44, 27, 55, 54, 26, 45, 1, 47, 3, 52, 24, 25, 53, 2, 46, + 29, 49, 6, 42, 43, 7, 48, 28, 50, 30, 41, 5, 4, 40, 31, 51, + 58, 22, 33, 13, 12, 32, 23, 59, 21, 57, 14, 34, 35, 15, 56, 20, + 39, 11, 60, 16, 17, 61, 10, 38, 8, 36, 19, 63, 62, 18, 37, 9, + 0, 22, 44, 58, 27, 13, 55, 33, 54, 32, 26, 12, 45, 59, 1, 23, + 47, 57, 3, 21, 52, 34, 24, 14, 25, 15, 53, 35, 2, 20, 46, 56, + 29, 11, 49, 39, 6, 16, 42, 60, 43, 61, 7, 17, 48, 38, 28, 10, + 50, 36, 30, 8, 41, 63, 5, 19, 4, 18, 40, 62, 31, 9, 51, 37, + 0, 11, 22, 29, 44, 39, 58, 49, 27, 16, 13, 6, 55, 60, 33, 42, + 54, 61, 32, 43, 26, 17, 12, 7, 45, 38, 59, 48, 1, 10, 23, 28, + 47, 36, 57, 50, 3, 8, 21, 30, 52, 63, 34, 41, 24, 19, 14, 5, + 25, 18, 15, 4, 53, 62, 35, 40, 2, 9, 20, 31, 46, 37, 56, 51, + 0, 36, 11, 47, 22, 50, 29, 57, 44, 8, 39, 3, 58, 30, 49, 21, + 27, 63, 16, 52, 13, 41, 6, 34, 55, 19, 60, 24, 33, 5, 42, 14, + 54, 18, 61, 25, 32, 4, 43, 15, 26, 62, 17, 53, 12, 40, 7, 35, + 45, 9, 38, 2, 59, 31, 48, 20, 1, 37, 10, 46, 23, 51, 28, 56, + 0, 18, 36, 54, 11, 25, 47, 61, 22, 4, 50, 32, 29, 15, 57, 43, + 44, 62, 8, 26, 39, 53, 3, 17, 58, 40, 30, 12, 49, 35, 21, 7, + 27, 9, 63, 45, 16, 2, 52, 38, 13, 31, 41, 59, 6, 20, 34, 48, + 55, 37, 19, 1, 60, 46, 24, 10, 33, 51, 5, 23, 42, 56, 14, 28, + 0, 9, 18, 27, 36, 45, 54, 63, 11, 2, 25, 16, 47, 38, 61, 52, + 22, 31, 4, 13, 50, 59, 32, 41, 29, 20, 15, 6, 57, 48, 43, 34, + 44, 37, 62, 55, 8, 1, 26, 19, 39, 46, 53, 60, 3, 10, 17, 24, + 58, 51, 40, 33, 30, 23, 12, 5, 49, 56, 35, 42, 21, 28, 7, 14, + 0, 37, 9, 44, 18, 55, 27, 62, 36, 1, 45, 8, 54, 19, 63, 26, + 11, 46, 2, 39, 25, 60, 16, 53, 47, 10, 38, 3, 61, 24, 52, 17, + 22, 51, 31, 58, 4, 33, 13, 40, 50, 23, 59, 30, 32, 5, 41, 12, + 29, 56, 20, 49, 15, 42, 6, 35, 57, 28, 48, 21, 43, 14, 34, 7, + 0, 51, 37, 22, 9, 58, 44, 31, 18, 33, 55, 4, 27, 40, 62, 13, + 36, 23, 1, 50, 45, 30, 8, 59, 54, 5, 19, 32, 63, 12, 26, 41, + 11, 56, 46, 29, 2, 49, 39, 20, 25, 42, 60, 15, 16, 35, 53, 6, + 47, 28, 10, 57, 38, 21, 3, 48, 61, 14, 24, 43, 52, 7, 17, 34, + 0, 56, 51, 11, 37, 29, 22, 46, 9, 49, 58, 2, 44, 20, 31, 39, + 18, 42, 33, 25, 55, 15, 4, 60, 27, 35, 40, 16, 62, 6, 13, 53, + 36, 28, 23, 47, 1, 57, 50, 10, 45, 21, 30, 38, 8, 48, 59, 3, + 54, 14, 5, 61, 19, 43, 32, 24, 63, 7, 12, 52, 26, 34, 41, 17, + 0, 28, 56, 36, 51, 47, 11, 23, 37, 57, 29, 1, 22, 10, 46, 50, + 9, 21, 49, 45, 58, 38, 2, 30, 44, 48, 20, 8, 31, 3, 39, 59, + 18, 14, 42, 54, 33, 61, 25, 5, 55, 43, 15, 19, 4, 24, 60, 32, + 27, 7, 35, 63, 40, 52, 16, 12, 62, 34, 6, 26, 13, 17, 53, 41, + 0, 14, 28, 18, 56, 54, 36, 42, 51, 61, 47, 33, 11, 5, 23, 25, + 37, 43, 57, 55, 29, 19, 1, 15, 22, 24, 10, 4, 46, 32, 50, 60, + 9, 7, 21, 27, 49, 63, 45, 35, 58, 52, 38, 40, 2, 12, 30, 16, + 44, 34, 48, 62, 20, 26, 8, 6, 31, 17, 3, 13, 39, 41, 59, 53, + 0, 7, 14, 9, 28, 27, 18, 21, 56, 63, 54, 49, 36, 35, 42, 45, + 51, 52, 61, 58, 47, 40, 33, 38, 11, 12, 5, 2, 23, 16, 25, 30, + 37, 34, 43, 44, 57, 62, 55, 48, 29, 26, 19, 20, 1, 6, 15, 8, + 22, 17, 24, 31, 10, 13, 4, 3, 46, 41, 32, 39, 50, 53, 60, 59, + 0, 34, 7, 37, 14, 44, 9, 43, 28, 62, 27, 57, 18, 48, 21, 55, + 56, 26, 63, 29, 54, 20, 49, 19, 36, 6, 35, 1, 42, 8, 45, 15, + 51, 17, 52, 22, 61, 31, 58, 24, 47, 13, 40, 10, 33, 3, 38, 4, + 11, 41, 12, 46, 5, 39, 2, 32, 23, 53, 16, 50, 25, 59, 30, 60, + 0, 17, 34, 51, 7, 22, 37, 52, 14, 31, 44, 61, 9, 24, 43, 58, + 28, 13, 62, 47, 27, 10, 57, 40, 18, 3, 48, 33, 21, 4, 55, 38, + 56, 41, 26, 11, 63, 46, 29, 12, 54, 39, 20, 5, 49, 32, 19, 2, + 36, 53, 6, 23, 35, 50, 1, 16, 42, 59, 8, 25, 45, 60, 15, 30, + 0, 41, 17, 56, 34, 11, 51, 26, 7, 46, 22, 63, 37, 12, 52, 29, + 14, 39, 31, 54, 44, 5, 61, 20, 9, 32, 24, 49, 43, 2, 58, 19, + 28, 53, 13, 36, 62, 23, 47, 6, 27, 50, 10, 35, 57, 16, 40, 1, + 18, 59, 3, 42, 48, 25, 33, 8, 21, 60, 4, 45, 55, 30, 38, 15, + 0, 53, 41, 28, 17, 36, 56, 13, 34, 23, 11, 62, 51, 6, 26, 47, + 7, 50, 46, 27, 22, 35, 63, 10, 37, 16, 12, 57, 52, 1, 29, 40, + 14, 59, 39, 18, 31, 42, 54, 3, 44, 25, 5, 48, 61, 8, 20, 33, + 9, 60, 32, 21, 24, 45, 49, 4, 43, 30, 2, 55, 58, 15, 19, 38, + 0, 59, 53, 14, 41, 18, 28, 39, 17, 42, 36, 31, 56, 3, 13, 54, + 34, 25, 23, 44, 11, 48, 62, 5, 51, 8, 6, 61, 26, 33, 47, 20, + 7, 60, 50, 9, 46, 21, 27, 32, 22, 45, 35, 24, 63, 4, 10, 49, + 37, 30, 16, 43, 12, 55, 57, 2, 52, 15, 1, 58, 29, 38, 40, 19, + 0, 60, 59, 7, 53, 9, 14, 50, 41, 21, 18, 46, 28, 32, 39, 27, + 17, 45, 42, 22, 36, 24, 31, 35, 56, 4, 3, 63, 13, 49, 54, 10, + 34, 30, 25, 37, 23, 43, 44, 16, 11, 55, 48, 12, 62, 2, 5, 57, + 51, 15, 8, 52, 6, 58, 61, 1, 26, 38, 33, 29, 47, 19, 20, 40, + 0, 30, 60, 34, 59, 37, 7, 25, 53, 43, 9, 23, 14, 16, 50, 44, + 41, 55, 21, 11, 18, 12, 46, 48, 28, 2, 32, 62, 39, 57, 27, 5, + 17, 15, 45, 51, 42, 52, 22, 8, 36, 58, 24, 6, 31, 1, 35, 61, + 56, 38, 4, 26, 3, 29, 63, 33, 13, 19, 49, 47, 54, 40, 10, 20, + 0, 15, 30, 17, 60, 51, 34, 45, 59, 52, 37, 42, 7, 8, 25, 22, + 53, 58, 43, 36, 9, 6, 23, 24, 14, 1, 16, 31, 50, 61, 44, 35, + 41, 38, 55, 56, 21, 26, 11, 4, 18, 29, 12, 3, 46, 33, 48, 63, + 28, 19, 2, 13, 32, 47, 62, 49, 39, 40, 57, 54, 27, 20, 5, 10, + 0, 38, 15, 41, 30, 56, 17, 55, 60, 26, 51, 21, 34, 4, 45, 11, + 59, 29, 52, 18, 37, 3, 42, 12, 7, 33, 8, 46, 25, 63, 22, 48, + 53, 19, 58, 28, 43, 13, 36, 2, 9, 47, 6, 32, 23, 49, 24, 62, + 14, 40, 1, 39, 16, 54, 31, 57, 50, 20, 61, 27, 44, 10, 35, 5, + 0, 19, 38, 53, 15, 28, 41, 58, 30, 13, 56, 43, 17, 2, 55, 36, + 60, 47, 26, 9, 51, 32, 21, 6, 34, 49, 4, 23, 45, 62, 11, 24, + 59, 40, 29, 14, 52, 39, 18, 1, 37, 54, 3, 16, 42, 57, 12, 31, + 7, 20, 33, 50, 8, 27, 46, 61, 25, 10, 63, 44, 22, 5, 48, 35, + 0, 40, 19, 59, 38, 14, 53, 29, 15, 39, 28, 52, 41, 1, 58, 18, + 30, 54, 13, 37, 56, 16, 43, 3, 17, 57, 2, 42, 55, 31, 36, 12, + 60, 20, 47, 7, 26, 50, 9, 33, 51, 27, 32, 8, 21, 61, 6, 46, + 34, 10, 49, 25, 4, 44, 23, 63, 45, 5, 62, 22, 11, 35, 24, 48, + 0, 20, 40, 60, 19, 7, 59, 47, 38, 50, 14, 26, 53, 33, 29, 9, + 15, 27, 39, 51, 28, 8, 52, 32, 41, 61, 1, 21, 58, 46, 18, 6, + 30, 10, 54, 34, 13, 25, 37, 49, 56, 44, 16, 4, 43, 63, 3, 23, + 17, 5, 57, 45, 2, 22, 42, 62, 55, 35, 31, 11, 36, 48, 12, 24, + 0, 10, 20, 30, 40, 34, 60, 54, 19, 25, 7, 13, 59, 49, 47, 37, + 38, 44, 50, 56, 14, 4, 26, 16, 53, 63, 33, 43, 29, 23, 9, 3, + 15, 5, 27, 17, 39, 45, 51, 57, 28, 22, 8, 2, 52, 62, 32, 42, + 41, 35, 61, 55, 1, 11, 21, 31, 58, 48, 46, 36, 18, 24, 6, 12, + 0, 5, 10, 15, 20, 17, 30, 27, 40, 45, 34, 39, 60, 57, 54, 51, + 19, 22, 25, 28, 7, 2, 13, 8, 59, 62, 49, 52, 47, 42, 37, 32, + 38, 35, 44, 41, 50, 55, 56, 61, 14, 11, 4, 1, 26, 31, 16, 21, + 53, 48, 63, 58, 33, 36, 43, 46, 29, 24, 23, 18, 9, 12, 3, 6, + 0, 35, 5, 38, 10, 41, 15, 44, 20, 55, 17, 50, 30, 61, 27, 56, + 40, 11, 45, 14, 34, 1, 39, 4, 60, 31, 57, 26, 54, 21, 51, 16, + 19, 48, 22, 53, 25, 58, 28, 63, 7, 36, 2, 33, 13, 46, 8, 43, + 59, 24, 62, 29, 49, 18, 52, 23, 47, 12, 42, 9, 37, 6, 32, 3, + 0, 48, 35, 19, 5, 53, 38, 22, 10, 58, 41, 25, 15, 63, 44, 28, + 20, 36, 55, 7, 17, 33, 50, 2, 30, 46, 61, 13, 27, 43, 56, 8, + 40, 24, 11, 59, 45, 29, 14, 62, 34, 18, 1, 49, 39, 23, 4, 52, + 60, 12, 31, 47, 57, 9, 26, 42, 54, 6, 21, 37, 51, 3, 16, 32, + 0, 24, 48, 40, 35, 59, 19, 11, 5, 29, 53, 45, 38, 62, 22, 14, + 10, 18, 58, 34, 41, 49, 25, 1, 15, 23, 63, 39, 44, 52, 28, 4, + 20, 12, 36, 60, 55, 47, 7, 31, 17, 9, 33, 57, 50, 42, 2, 26, + 30, 6, 46, 54, 61, 37, 13, 21, 27, 3, 43, 51, 56, 32, 8, 16, + 0, 12, 24, 20, 48, 60, 40, 36, 35, 47, 59, 55, 19, 31, 11, 7, + 5, 9, 29, 17, 53, 57, 45, 33, 38, 42, 62, 50, 22, 26, 14, 2, + 10, 6, 18, 30, 58, 54, 34, 46, 41, 37, 49, 61, 25, 21, 1, 13, + 15, 3, 23, 27, 63, 51, 39, 43, 44, 32, 52, 56, 28, 16, 4, 8, + 0, 6, 12, 10, 24, 30, 20, 18, 48, 54, 60, 58, 40, 46, 36, 34, + 35, 37, 47, 41, 59, 61, 55, 49, 19, 21, 31, 25, 11, 13, 7, 1, + 5, 3, 9, 15, 29, 27, 17, 23, 53, 51, 57, 63, 45, 43, 33, 39, + 38, 32, 42, 44, 62, 56, 50, 52, 22, 16, 26, 28, 14, 8, 2, 4, + 0, 3, 6, 5, 12, 15, 10, 9, 24, 27, 30, 29, 20, 23, 18, 17, + 48, 51, 54, 53, 60, 63, 58, 57, 40, 43, 46, 45, 36, 39, 34, 33, + 35, 32, 37, 38, 47, 44, 41, 42, 59, 56, 61, 62, 55, 52, 49, 50, + 19, 16, 21, 22, 31, 28, 25, 26, 11, 8, 13, 14, 7, 4, 1, 2, + 0, 32, 3, 35, 6, 38, 5, 37, 12, 44, 15, 47, 10, 42, 9, 41, + 24, 56, 27, 59, 30, 62, 29, 61, 20, 52, 23, 55, 18, 50, 17, 49, + 48, 16, 51, 19, 54, 22, 53, 21, 60, 28, 63, 31, 58, 26, 57, 25, + 40, 8, 43, 11, 46, 14, 45, 13, 36, 4, 39, 7, 34, 2, 33, 1, + 0, 16, 32, 48, 3, 19, 35, 51, 6, 22, 38, 54, 5, 21, 37, 53, + 12, 28, 44, 60, 15, 31, 47, 63, 10, 26, 42, 58, 9, 25, 41, 57, + 24, 8, 56, 40, 27, 11, 59, 43, 30, 14, 62, 46, 29, 13, 61, 45, + 20, 4, 52, 36, 23, 7, 55, 39, 18, 2, 50, 34, 17, 1, 49, 33, + 0, 8, 16, 24, 32, 40, 48, 56, 3, 11, 19, 27, 35, 43, 51, 59, + 6, 14, 22, 30, 38, 46, 54, 62, 5, 13, 21, 29, 37, 45, 53, 61, + 12, 4, 28, 20, 44, 36, 60, 52, 15, 7, 31, 23, 47, 39, 63, 55, + 10, 2, 26, 18, 42, 34, 58, 50, 9, 1, 25, 17, 41, 33, 57, 49, + 0, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, + 3, 7, 11, 15, 19, 23, 27, 31, 35, 39, 43, 47, 51, 55, 59, 63, + 6, 2, 14, 10, 22, 18, 30, 26, 38, 34, 46, 42, 54, 50, 62, 58, + 5, 1, 13, 9, 21, 17, 29, 25, 37, 33, 45, 41, 53, 49, 61, 57, + 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, + 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56, 58, 60, 62, + 3, 1, 7, 5, 11, 9, 15, 13, 19, 17, 23, 21, 27, 25, 31, 29, + 35, 33, 39, 37, 43, 41, 47, 45, 51, 49, 55, 53, 59, 57, 63, 61 +}; +/* +// SO array +static const int SO[qra_N-qra_K+1] = { + 14, 2, 4, 5, 9, 13, 10, 15, 11, 6, 1, 8, 2, 12, 9, 10, + 13, 7, 4, 11, 8, 6, 3, 14, 13, 5, 9, 1, 2, 12, 3, 10, + 15, 6, 7, 14, 8, 13, 12, 3, 10, 1, 11, 5, 8, 15, 9, 12, + 4, 7, 11 +}; + +// LOGWO array +static const int LOGWO[qra_N-qra_K+1] = { + 0, 14, 0, 0, 13, 37, 0, 27, 56, 62, 29, 0, 52, 34, 62, 4, + 3, 22, 25, 0, 22, 0, 20, 10, 0, 43, 53, 60, 0, 0, 0, 62, + 0, 5, 0, 61, 36, 31, 61, 59, 10, 0, 29, 39, 25, 18, 0, 14, + 11, 50, 17 +}; + +// repfact array +static const int repfact[qra_K] = { + 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 3, 3 +}; +*/ + +const qracode qra15_65_64_irr_e23 = { + qra_K, + qra_N, + qra_m, + qra_M, + qra_a, + qra_NC, + qra_V, + qra_C, + qra_NMSG, + qra_MAXVDEG, + qra_MAXCDEG, + QRATYPE_CRCPUNCTURED2, + qra_R, + CODE_NAME, + qra_acc_input_idx, + qra_acc_input_wlog, + qra_log, + qra_exp, + qra_msgw, + qra_vdeg, + qra_cdeg, + qra_v2cmidx, + qra_c2vmidx, + qra_pmat +}; +#undef qra_K +#undef qra_N +#undef qra_m +#undef qra_M +#undef qra_a +#undef qra_NC +#undef qra_V +#undef qra_C +#undef qra_NMSG +#undef qra_MAXVDEG +#undef qra_MAXCDEG +#undef qra_R +#undef CODE_NAME diff --git a/wsjtx_lib/lib/qra/q65/qra15_65_64_irr_e23.h b/wsjtx_lib/lib/qra/q65/qra15_65_64_irr_e23.h new file mode 100644 index 0000000..4e4f601 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/qra15_65_64_irr_e23.h @@ -0,0 +1,41 @@ +// qra15_65_64_irr_e23.h +// Code tables and defines for Q-ary RA code (15,65) over GF(64) +// Code Name: qra15_65_64_irr_e23 +// (15,65) RA Code over GF(64) + +// (c) 2020 - Nico Palermo - IV3NWV - Microtelecom Srl, Italy + +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _qra15_65_64_irr_e23_h +#define _qra15_65_64_irr_e23_h + +// File generated by npiwnarsavehc.m + +#include "qracodes.h" + +#ifdef __cplusplus +extern "C" { +#endif + +extern const qracode qra15_65_64_irr_e23; + +#ifdef __cplusplus +} +#endif + +#endif // _qra15_65_64_irr_e23_h diff --git a/wsjtx_lib/lib/qra/q65/qracodes.c b/wsjtx_lib/lib/qra/q65/qracodes.c new file mode 100644 index 0000000..748a9c9 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/qracodes.c @@ -0,0 +1,474 @@ +// qracodes.c +// Q-ary RA codes encoding/decoding functions +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include +#include + +#include "npfwht.h" +#include "pdmath.h" + +#include "qracodes.h" + +int qra_encode(const qracode *pcode, int *y, const int *x) +{ + int k,j,kk,jj; + int t, chk = 0; + + const int K = pcode->K; + const int M = pcode->M; + const int NC= pcode->NC; + const int a = pcode->a; + const int *acc_input_idx = pcode->acc_input_idx; + const int *acc_input_wlog = pcode->acc_input_wlog; + const int *gflog = pcode->gflog; + const int *gfexp = pcode->gfexp; + + // copy the systematic symbols to destination + memcpy(y,x,K*sizeof(int)); + + y = y+K; // point to check symbols + + // compute the code check symbols as a weighted accumulation of a permutated + // sequence of the (repeated) systematic input symbols: + // chk(k+1) = x(idx(k))*alfa^(logw(k)) + chk(k) + // (all operations performed over GF(M)) + + if (a==1) { // grouping factor = 1 + for (k=0;k 1 + for (k=0;k80.f) // avoid floating point exp() overflows + v=80.f; + + src[nitems] = (float)exp(v); + } +} + + +float qra_mfskbesselmetric(float *pix, const float *rsq, const int m, const int N, float EsNoMetric) +{ + // Computes the codeword symbols intrinsic probabilities + // given the square of the received input amplitudes. + + // The input vector rqs must be a linear array of size M*N, where M=2^m, + // containing the squared amplitudes (rp*rp+rq*rq) of the input samples + + // First symbol amplitudes should be stored in the first M positions, + // second symbol amplitudes stored at positions [M ... 2*M-1], and so on. + + // Output vector is the intrinsic symbol metric (the probability distribution) + // assuming that symbols are transmitted using a M-FSK modulation + // and incoherent demodulation. + + // As the input Es/No is generally unknown (as it cannot be exstimated accurately + // when the codeword length is few tens symbols) but an exact metric requires it + // we simply fix it to a predefined EsNoMetric value so that the metric is what + // expected at that specific value. + // The metric computed in this way is optimal only at this predefined Es/No value, + // nevertheless it is usually better than a generic parameter-free metric which + // makes no assumptions on the input Es/No. + + // returns the estimated noise standard deviation + + int k; + float rsum = 0.f; + float sigmaest, cmetric; + + const int M = 1<M; + const int qra_m = pcode->m; + const int qra_V = pcode->V; + const int qra_MAXVDEG = pcode->MAXVDEG; + const int *qra_vdeg = pcode->vdeg; + const int qra_C = pcode->C; + const int qra_MAXCDEG = pcode->MAXCDEG; + const int *qra_cdeg = pcode->cdeg; + const int *qra_v2cmidx = pcode->v2cmidx; + const int *qra_c2vmidx = pcode->c2vmidx; + const int *qra_pmat = pcode->gfpmat; + const int *qra_msgw = pcode->msgw; + +// float msgout[qra_M]; // buffer to store temporary results + float msgout[QRACODE_MAX_M]; // we use a fixed size in order to avoid mallocs + + float totex; // total extrinsic information + int nit; // current iteration + int nv; // current variable + int nc; // current check + int k,kk; // loop indexes + + int ndeg; // current node degree + int msgbase; // current offset in the table of msg indexes + int imsg; // current message index + int wmsg; // current message weight + + int rc = -1; // rc>=0 extrinsic converged to 1 at iteration rc (rc=0..maxiter-1) + // rc=-1 no convergence in the given number of iterations + // rc=-2 error in the code tables (code checks degrees must be >1) + // rc=-3 M is larger than QRACODE_MAX_M + + + + if (qra_M>QRACODE_MAX_M) + return -3; + + // message initialization ------------------------------------------------------- + + // init c->v variable intrinsic msgs + pd_init(C2VMSG(0),pix,qra_M*qra_V); + + // init the v->c messages directed to code factors (k=1..ndeg) with the intrinsic info + for (nv=0;nvc + for (k=1;kv step ----------------------------------------------------- + // Computes messages from code checks to code variables. + // As the first qra_V checks are associated with intrinsic information + // (the code tables have been constructed in this way) + // we need to do this step only for code checks in the range [qra_V..qra_C) + + // The convolutions of probability distributions over the alphabet of a finite field GF(qra_M) + // are performed with a fast convolution algorithm over the given field. + // + // I.e. given the code check x1+x2+x3 = 0 (with x1,x2,x3 in GF(2^m)) + // and given Prob(x2) and Prob(x3), we have that: + // Prob(x1=X1) = Prob((x2+x3)=X1) = sum((Prob(x2=X2)*Prob(x3=(X1+X2))) for all the X2s in the field + // This translates to Prob(x1) = IWHT(WHT(Prob(x2))*WHT(Prob(x3))) + // where WHT and IWHT are the direct and inverse Walsh-Hadamard transforms of the argument. + // Note that the WHT and the IWHF differs only by a multiplicative coefficent and since in this step + // we don't need that the output distribution is normalized we use the relationship + // Prob(x1) =(proportional to) WH(WH(Prob(x2))*WH(Prob(x3))) + + // In general given the check code x1+x2+x3+..+xm = 0 + // the output distribution of a variable given the distributions of the other m-1 variables + // is the inverse WHT of the product of the WHTs of the distribution of the other m-1 variables + // The complexity of this algorithm scales with M*log2(M) instead of the M^2 complexity of + // the brute force approach (M=size of the alphabet) + + for (nc=qra_V;nc1) + return -2; // bad code tables + + msgbase = nc*qra_MAXCDEG; // base to msg index row for the current node + + // transforms inputs in the Walsh-Hadamard "frequency" domain + // v->c -> fwht(v->c) + for (k=0;kv = prod(fwht(v->c)) + // TODO: we assume that checks degrees are not larger than three but + // if they are larger the products can be computed more efficiently + for (kk=0;kkc steps when multipling + // small fp numbers + msgout[0]+=1E-7f; // TODO: define the bias accordingly to the field size + + np_fwht(qra_m,msgout,msgout); + + // inverse weight and output + imsg = qra_c2vmidx[msgbase+k]; // current output msg index + wmsg = qra_msgw[imsg]; // current msg weight + + if (wmsg==0) + pd_init(C2VMSG(imsg),msgout,qra_M); + else + // output p(alfa^(-w)*x) + pd_bwdperm(C2VMSG(imsg),msgout, MSGPERM(wmsg), qra_M); + + } // for (k=0;kc step ----------------------------------------------------- + for (nv=0;nvc msg = prod(c->v) + // TODO: factor factors to reduce the number of computations for high degree nodes + for (kk=0;kkc are null + // normalize output to a probability distribution + if (pd_norm(msgout,qra_m)<=0) { + // dump msgin; + printf("warning: v->c pd with invalid norm. nit=%d nv=%d k=%d\n",nit,nv,k); + for (kk=0;kk(1.*(qra_V)-0.01)) { + // the total maximum extrinsic information of each symbol in the codeword + // is very close to one. This means that we have reached the (1,1) point in the + // code EXIT chart(s) and we have successfully decoded the input. + rc = nit; + break; // remove the break to evaluate the decoder speed performance as a function of the max iterations number) + } + + } // for (nit=0;nitM; + const int qra_m = pcode->m; + const int qra_K = pcode->K; + + int k; + + for (k=0;k. + +#ifndef _qracodes_h_ +#define _qracodes_h_ + +// type of codes +#define QRATYPE_NORMAL 0x00 // normal code +#define QRATYPE_CRC 0x01 // code with crc - last information symbol is a CRC-6 +#define QRATYPE_CRCPUNCTURED 0x02 // the CRC-6 symbol is punctured (not sent along the channel) +#define QRATYPE_CRCPUNCTURED2 0x03 // code with CRC-12. The two crc symbols are punctured + + +typedef struct { + // code parameters + const int K; // number of information symbols + const int N; // codeword length in symbols + const int m; // bits/symbol + const int M; // Symbol alphabet cardinality (2^m) + const int a; // code grouping factor + const int NC; // number of check symbols (N-K) + const int V; // number of variables in the code graph (N) + const int C; // number of factors in the code graph (N +(N-K)+1) + const int NMSG; // number of msgs in the code graph + const int MAXVDEG; // maximum variable degree + const int MAXCDEG; // maximum factor degree + const int type; // see QRATYPE_xx defines + const float R; // code rate (K/N) + const char name[64]; // code name + // tables used by the encoder + const int *acc_input_idx; + const int *acc_input_wlog; + const int *gflog; + const int *gfexp; + // tables used by the decoder ------------------------- + const int *msgw; + const int *vdeg; + const int *cdeg; + const int *v2cmidx; + const int *c2vmidx; + const int *gfpmat; +} qracode; +// Uncomment the header file of the code which needs to be tested + +//#include "qra12_63_64_irr_b.h" // irregular code (12,63) over GF(64) +//#include "qra13_64_64_irr_e.h" // irregular code with good performance and best UER protection at AP56 +//#include "qra13_64_64_reg_a.h" // regular code with good UER but perf. inferior to that of code qra12_63_64_irr_b + +#ifdef __cplusplus +extern "C" { +#endif + +int qra_encode(const qracode *pcode, int *y, const int *x); +float qra_mfskbesselmetric(float *pix, const float *rsq, const int m, const int N, float EsNoMetric); +int qra_extrinsic(const qracode *pcode, float *pex, const float *pix, int maxiter,float *qra_v2cmsg,float *qra_c2vmsg); +void qra_mapdecode(const qracode *pcode, int *xdec, float *pex, const float *pix); + +#ifdef __cplusplus +} +#endif + +#endif // _qracodes_h_ diff --git a/wsjtx_lib/lib/qra/q65/wer-ff-qra15_65_64_irr_e23-ap00.txt b/wsjtx_lib/lib/qra/q65/wer-ff-qra15_65_64_irr_e23-ap00.txt new file mode 100644 index 0000000..b087ad9 --- /dev/null +++ b/wsjtx_lib/lib/qra/q65/wer-ff-qra15_65_64_irr_e23-ap00.txt @@ -0,0 +1,19 @@ +#Code Name: qra15_65_64_irr_e23 +#ChannelType (0=AWGN,1=Rayleigh,2=Fast-Fading) +#Eb/No (dB) +#Transmitted Codewords +#Errors +#CRC Errors +#Undetected +#Avg dec. time (ms) +#WER +#UER +2 -30.00 106 106 0 0 4.87 1.00e+000 0.00e+000 +2 0.50 1006 1006 0 0 4.91 1.00e+000 0.00e+000 +2 1.00 1007 1006 0 0 4.98 9.99e-001 0.00e+000 +2 1.50 1009 1007 0 0 4.97 9.98e-001 0.00e+000 +2 2.00 1017 1007 1 0 4.84 9.90e-001 2.40e-007 +2 2.50 1047 1006 1 0 4.79 9.61e-001 2.33e-007 +2 3.00 1148 1006 3 0 4.61 8.76e-001 6.38e-007 +2 3.50 1338 1006 6 0 4.43 7.52e-001 1.10e-006 +2 4.00 1902 1006 7 0 3.94 5.29e-001 8.99e-007 diff --git a/wsjtx_lib/lib/qra/qracodes/Makefile.Win b/wsjtx_lib/lib/qra/qracodes/Makefile.Win new file mode 100644 index 0000000..fb30504 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/Makefile.Win @@ -0,0 +1,33 @@ +CC = gcc +CFLAGS = -O2 -Wall -I. -D_WIN32 + +# 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: libqra64.a qracodes.exe + +OBJS1 = normrnd.o npfwht.o pdmath.o qra12_63_64_irr_b.o \ + qra13_64_64_irr_e.o qracodes.o + +libqra64.a: $(OBJS1) + ar cr libqra64.a $(OBJS1) + ranlib libqra64.a + +OBJS2 = main.o + +qracodes.exe: $(OBJS2) + ${CC} -o qracodes.exe $(OBJS2) libqra64.a -lm + +.PHONY : clean + +clean: + $(RM) *.o libqra64.a qracodes.exe diff --git a/wsjtx_lib/lib/qra/qracodes/ebno10000.txt b/wsjtx_lib/lib/qra/qracodes/ebno10000.txt new file mode 100644 index 0000000..c41174b --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/ebno10000.txt @@ -0,0 +1,7 @@ +# Eb/No Values to be used during the code simulation +# Each line of this file indicates the Eb/No value to be simulated (in dB) +# and the number of errors to be detected by the decoder +0.6 10000 +1.1 10000 +1.6 10000 +2.1 10000 diff --git a/wsjtx_lib/lib/qra/qracodes/ebnovalues.txt b/wsjtx_lib/lib/qra/qracodes/ebnovalues.txt new file mode 100644 index 0000000..7dba138 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/ebnovalues.txt @@ -0,0 +1,15 @@ +# Eb/No Values to be used during the code simulation +# Each line of this file indicates the Eb/No value to be simulated (in dB) +# and the number of errors to be detected by the decoder +1.1 1000 +1.6 1000 +2.1 1000 +2.6 1000 +3.1 1000 +3.6 1000 +4.1 1000 +4.6 1000 +5.1 500 +5.6 200 +6.1 100 +6.6 50 \ No newline at end of file diff --git a/wsjtx_lib/lib/qra/qracodes/ebnovaluesfast.txt b/wsjtx_lib/lib/qra/qracodes/ebnovaluesfast.txt new file mode 100644 index 0000000..b057b31 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/ebnovaluesfast.txt @@ -0,0 +1,11 @@ +# Eb/No Values to be used during the code simulation +# Each line of this file indicates the Eb/No value to be simulated (in dB) +# and the number of errors to be detected by the decoder +1.1 500 +1.6 500 +2.1 500 +2.6 500 +3.1 500 +3.6 500 +4.1 200 +4.6 50 diff --git a/wsjtx_lib/lib/qra/qracodes/main.c b/wsjtx_lib/lib/qra/qracodes/main.c new file mode 100644 index 0000000..5f9f067 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/main.c @@ -0,0 +1,737 @@ +// main.c +// Word Error Rate test example for Q-ary RA codes over GF(64) +// +// (c) 2016 - Nico Palermo, IV3NWV +// +// Thanks to Andrea Montefusco IW0HDV for his help on adapting the sources +// to OSs other than MS Windows +// +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// Files in this package: +// main.c - this file +// normrnd.c/.h - random gaussian number generator +// npfwht.c/.h - Fast Walsh-Hadamard Transforms +// pdmath.c/.h - Elementary math on probability distributions +// qra12_63_64_irr_b.c/.h - Tables for a QRA(12,63) irregular RA code over GF(64) +// qra13_64_64_irr_e.c/.h - Tables for a QRA(13,64) irregular RA code " " +// qracodes.c/.h - QRA codes encoding/decoding functions +// +// ------------------------------------------------------------------------------- +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +// ----------------------------------------------------------------------------- + +// Two codes are available for simulations in this sowftware release: + +// QRA12_63_64_IRR_B: K=12 N=63 Q=64 irregular QRA code (defined in qra12_63_64_irr_b.h /.c) +// QRA13_64_64_IRR_E: K=13 N=64 Q=64 irregular QRA code (defined in qra13_64_64_irr_b.h /.c) + +// Codes with K=13 are designed to include a CRC as the 13th information symbol +// and improve the code UER (Undetected Error Rate). +// The CRC symbol is not sent along the channel (the codes are punctured) and the +// resulting code is still a (12,63) code with an effective code rate of R = 12/63. + +// ------------------------------------------------------------------------------ + +// OS dependent defines and includes -------------------------------------------- + +#if _WIN32 // note the underscore: without it, it's not msdn official! + // Windows (x64 and x86) + #include // required only for GetTickCount(...) + #include // _beginthread +#endif + +#if defined(__linux__) + +// remove unwanted macros +#define __cdecl + +// implements Windows API +#include + + unsigned int GetTickCount(void) { + struct timespec ts; + unsigned int theTick = 0U; + clock_gettime( CLOCK_REALTIME, &ts ); + theTick = ts.tv_nsec / 1000000; + theTick += ts.tv_sec * 1000; + return theTick; +} + +// Convert Windows millisecond sleep +// +// VOID WINAPI Sleep(_In_ DWORD dwMilliseconds); +// +// to Posix usleep (in microseconds) +// +// int usleep(useconds_t usec); +// +#include +#define Sleep(x) usleep(x*1000) + +#endif + +#if defined(__linux__) || ( defined(__MINGW32__) || defined (__MIGW64__) ) +#include +#endif + +#if __APPLE__ +#endif + +#include +#include + +#include "qracodes.h" +#include "normrnd.h" // gaussian numbers generator +#include "pdmath.h" // operations on probability distributions + +// defined codes +#include "qra12_63_64_irr_b.h" +#include "qra13_64_64_irr_e.h" + +// ----------------------------------------------------------------------------------- + +#define NTHREADS_MAX 160 + +// channel types +#define CHANNEL_AWGN 0 +#define CHANNEL_RAYLEIGH 1 + +// amount of a-priori information provided to the decoder +#define AP_NONE 0 +#define AP_28 1 +#define AP_44 2 +#define AP_56 3 + +const char ap_str[4][16] = { + "None", + "28 bit", + "44 bit", + "56 bit" +}; + +const char fnameout_pfx[2][64] = { + "wer-awgn-", + "wer-rayleigh-" +}; +const char fnameout_sfx[4][64] = { + "-ap00.txt", + "-ap28.txt", + "-ap44.txt", + "-ap56.txt" +}; + +const int ap_masks_jt65[4][13] = { +// Each row must be 13 entries long (to handle puntc. codes 13,64) +// The mask of 13th symbol (crc) is alway initializated to 0 + // AP0 - no a-priori knowledge + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, + // AP28 - 1st field known [cq ? ?] or [dst ? ?] + {0x3F,0x3F,0x3F,0x3F,0x3C, 0, 0, 0, 0, 0, 0, 0}, + // AP44 - 1st and 3rd fields known [cq ? 0] or [dst ? 0] + {0x3F,0x3F,0x3F,0x3F,0x3C, 0, 0, 0, 0,0x0F,0x3F,0x3F}, + // AP56 - 1st and 2nd fields known [dst src ?] + {0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0x3F,0x30, 0, 0} +}; + +void ix_mask(const qracode *pcode, float *r, const int *mask, const int *x); + +void printword(char *msg, int *x, int size) +{ + int k; + printf("\n%s ",msg); + for (k=0;kc msg buffer + float *qra_c2vmsg; //[qra_NMSG*qra_M]; MP decoder c->v msg buffer + float *rp; // [qra_N*qra_M]; received samples (real component) buffer + float *rq; // [qra_N*qra_M]; received samples (imag component) buffer + float *chp; //[qra_N]; channel gains (real component) buffer + float *chq; //[qra_N]; channel gains (imag component) buffer + float *r; //[qra_N*qra_M]; received samples (amplitude) buffer + float *ix; // [qra_N*qra_M]; // intrinsic information to the MP algorithm + float *ex; // [qra_N*qra_M]; // extrinsic information from the MP algorithm + +} wer_test_ds; + +typedef void( __cdecl *pwer_test_thread)(wer_test_ds*); + +// crc-6 generator polynomial +// g(x) = x^6 + a5*x^5 + ... + a1*x + a0 + +// g(x) = x^6 + x + 1 +#define CRC6_GEN_POL 0x30 // MSB=a0 LSB=a5 + +// g(x) = x^6 + x^2 + x + 1 (as suggested by Joe. See: https://users.ece.cmu.edu/~koopman/crc/) +// #define CRC6_GEN_POL 0x38 // MSB=a0 LSB=a5. Simulation results are similar + +int calc_crc6(int *x, int sz) +{ + int k,j,t,sr = 0; + for (k=0;k>1) ^ CRC6_GEN_POL; + else + sr = (sr>>1); + t>>=1; + } + } + return sr; +} + +void wer_test_thread(wer_test_ds *pdata) +{ + const qracode *pcode=pdata->pcode; + const int qra_K = pcode->K; + const int qra_N = pcode->N; + const int qra_M = pcode->M; + const int qra_m = pcode->m; + const int NSAMPLES = pcode->N*pcode->M; + + const float No = 1.0f; // noise spectral density + const float sigma = (float)sqrt(No/2.0f); // std dev of noise I/Q components + const float sigmach = (float)sqrt(1/2.0f); // std dev of channel I/Q gains + + // Eb/No value for which we optimize the bessel metric + const float EbNodBMetric = 2.8f; + const float EbNoMetric = (float)pow(10,EbNodBMetric/10); + + int k,t,j,diff; + float R; + float EsNoMetric; + float EbNo, EsNo, Es, A; + int channel_type, code_type; + int nt=0; // transmitted codewords + int nerrs = 0; // total number of errors + int nerrsu = 0; // number of undetected errors + int rc; + + + // inizialize pointer to required buffers + int *x=pdata->x; // message buffer + int *y=pdata->y, *ydec=pdata->ydec; // encoded/decoded codeword buffers + float *qra_v2cmsg=pdata->qra_v2cmsg; // table of the v->c messages + float *qra_c2vmsg=pdata->qra_c2vmsg; // table of the c->v messages + float *rp=pdata->rp; // received samples (real component) + float *rq=pdata->rq; // received samples (imag component) + float *chp=pdata->chp; // channel gains (real component) + float *chq=pdata->chq; // channel gains (imag component) + float *r=pdata->r; // received samples amplitudes + float *ix=pdata->ix; // intrinsic information to the MP algorithm + float *ex=pdata->ex; // extrinsic information from the MP algorithm + + channel_type = pdata->channel_type; + code_type = pcode->type; + + // define the (true) code rate accordingly to the code type + switch(code_type) { + case QRATYPE_CRC: + R = 1.0f*(qra_K-1)/qra_N; + break; + case QRATYPE_CRCPUNCTURED: + R = 1.0f*(qra_K-1)/(qra_N-1); + break; + case QRATYPE_NORMAL: + default: + R = 1.0f*(qra_K)/(qra_N); + } + + EsNoMetric = 1.0f*qra_m*R*EbNoMetric; + + EbNo = (float)pow(10,pdata->EbNodB/10); + EsNo = 1.0f*qra_m*R*EbNo; + Es = EsNo*No; + A = (float)sqrt(Es); + + + // encode the input + if (code_type==QRATYPE_CRC || code_type==QRATYPE_CRCPUNCTURED) { + // compute the information message symbol check as the (negated) xor of all the + // information message symbols + for (k=0;k<(qra_K-1);k++) + x[k]=k%qra_M; + x[k]=calc_crc6(x,qra_K-1); + } + else + for (k=0;kstop==0) { + + // simulate the channel + // NOTE: in the case that the code is punctured, for simplicity + // we compute the channel outputs and the metric also for the crc symbol + // then we ignore its observation. + normrnd_s(rp,NSAMPLES,0,sigma); + normrnd_s(rq,NSAMPLES,0,sigma); + + if (channel_type == CHANNEL_AWGN) { + for (k=0;kdone = 1; + return; // unknown channel type + } + + // compute the squares of the amplitudes of the received samples + for (k=0;km,pcode->N,EsNoMetric); + + if (code_type==QRATYPE_CRCPUNCTURED) { + // ignore observations of the CRC symbol as it is not actually sent + // over the channel + pd_init(PD_ROWADDR(ix,qra_M,qra_K),pd_uniform(qra_m),qra_M); + } + + + if (pdata->ap_index!=0) + // mask channel observations with a priori knowledge + ix_mask(pcode,ix,ap_masks_jt65[pdata->ap_index],x); + + + // compute the extrinsic symbols probabilities with the message-passing algorithm + // stop if extrinsic information does not converges to 1 within the given number of iterations + rc = qra_extrinsic(pcode,ex,ix,100,qra_v2cmsg,qra_c2vmsg); + + if (rc>=0) { // the MP algorithm converged to Iex~1 in rc iterations + + // decode the codeword + qra_mapdecode(pcode,ydec,ex,ix); + + // look for undetected errors + if (code_type==QRATYPE_CRC || code_type==QRATYPE_CRCPUNCTURED) { + + j = 0; diff = 0; + for (k=0;k<(qra_K-1);k++) + diff |= (ydec[k]!=x[k]); + t = calc_crc6(ydec,qra_K-1); + if (t!=ydec[k]) // error detected - crc doesn't matches + nerrs += 1; + else + if (diff) { // decoded message is not equal to the transmitted one but + // the crc test passed + // add as undetected error + nerrsu += 1; + nerrs += 1; + // uncomment to see what the undetected error pattern looks like + //printword("U", ydec); + } + } + else + for (k=0;knt=nt; + pdata->nerrs=nerrs; + pdata->nerrsu=nerrsu; + + } + + pdata->done=1; + + #if _WIN32 + _endthread(); + #endif +} + +#if defined(__linux__) || ( defined(__MINGW32__) || defined (__MIGW64__) ) + +void *wer_test_pthread(void *p) +{ + wer_test_thread ((wer_test_ds *)p); + return 0; +} + +#endif + +void ix_mask(const qracode *pcode, float *r, const int *mask, const int *x) +{ + // mask intrinsic information (channel observations) with a priori knowledge + + int k,kk, smask; + const int qra_K=pcode->K; + const int qra_M=pcode->M; + const int qra_m=pcode->m; + + for (k=0;kNTHREADS_MAX) { + printf("Error: nthreads should be <=%d\n",NTHREADS_MAX); + return -1; + } + + sprintf(fnameout,"%s%s%s", + fnameout_pfx[chtype], + pcode->name, + fnameout_sfx[ap_index]); + + fout = fopen(fnameout,"w"); + fprintf(fout,"# Channel (0=AWGN,1=Rayleigh), Eb/No (dB), Transmitted codewords, Errors, Undetected Errors, Avg dec. time (ms), WER\n"); + + printf("\nTesting the code %s over the %s channel\nSimulation data will be saved to %s\n", + pcode->name, + chtype==CHANNEL_AWGN?"AWGN":"Rayleigh", + fnameout); + fflush (stdout); + + // init fixed thread parameters and preallocate buffers + for (j=0;jK*sizeof(int)); + wt[j].y = (int*)malloc(pcode->N*sizeof(int)); + wt[j].ydec = (int*)malloc(pcode->N*sizeof(int)); + wt[j].qra_v2cmsg = (float*)malloc(pcode->NMSG*pcode->M*sizeof(float)); + wt[j].qra_c2vmsg = (float*)malloc(pcode->NMSG*pcode->M*sizeof(float)); + wt[j].rp = (float*)malloc(pcode->N*pcode->M*sizeof(float)); + wt[j].rq = (float*)malloc(pcode->N*pcode->M*sizeof(float)); + wt[j].chp = (float*)malloc(pcode->N*sizeof(float)); + wt[j].chq = (float*)malloc(pcode->N*sizeof(float)); + wt[j].r = (float*)malloc(pcode->N*pcode->M*sizeof(float)); + wt[j].ix = (float*)malloc(pcode->N*pcode->M*sizeof(float)); + wt[j].ex = (float*)malloc(pcode->N*pcode->M*sizeof(float)); + } + + + for (k=0;k=nerrstgt[k]) { + for (j=0;j] [-t] [-c] [-a] [-f[-h]\n"); + printf("Options: \n"); + printf(" -q: code to simulate. 0=qra_12_63_64_irr_b\n"); + printf(" 1=qra_13_64_64_irr_e (default)\n"); + printf(" -t : number of threads to be used for the simulation [1..24]\n"); + printf(" (default=8)\n"); + printf(" -c : channel_type. 0=AWGN 1=Rayleigh \n"); + printf(" (default=AWGN)\n"); + printf(" -a : amount of a-priori information provided to decoder. \n"); + printf(" 0= No a-priori (default)\n"); + printf(" 1= 28 bit \n"); + printf(" 2= 44 bit \n"); + printf(" 3= 56 bit \n"); + printf(" -f : name of the file containing the Eb/No values to be simulated\n"); + printf(" (default=ebnovalues.txt)\n"); + printf(" This file should contain lines in this format:\n"); + printf(" # Eb/No(dB) Target Errors\n"); + printf(" 0.1 5000\n"); + printf(" 0.6 5000\n"); + printf(" 1.1 1000\n"); + printf(" 1.6 1000\n"); + printf(" ...\n"); + printf(" (lines beginning with a # are treated as comments\n\n"); +} + +#define SIM_POINTS_MAX 20 + +int main(int argc, char* argv[]) +{ + + float EbNodB[SIM_POINTS_MAX]; + int nerrstgt[SIM_POINTS_MAX]; + FILE *fin; + + char fnamein[128]= "ebnovalues.txt"; + char buf[128]; + + int nitems = 0; + int code_idx = 1; + int nthreads = 8; + int ch_type = CHANNEL_AWGN; + int ap_index = AP_NONE; + + // parse command line + while(--argc) { + argv++; + if (strncmp(*argv,"-h",2)==0) { + syntax(); + return 0; + } + else + if (strncmp(*argv,"-q",2)==0) { + code_idx = (int)atoi((*argv)+2); + if (code_idx>1) { + printf("Invalid code index\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-t",2)==0) { + nthreads = (int)atoi((*argv)+2); + printf("nthreads = %d\n",nthreads); + if (nthreads>NTHREADS_MAX) { + printf("Invalid number of threads\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-c",2)==0) { + ch_type = (int)atoi((*argv)+2); + if (ch_type>CHANNEL_RAYLEIGH) { + printf("Invalid channel type\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-a",2)==0) { + ap_index = (int)atoi((*argv)+2); + if (ap_index>AP_56) { + printf("Invalid a-priori information index\n"); + syntax(); + return -1; + } + } + else + if (strncmp(*argv,"-f",2)==0) { + strncpy(fnamein,(*argv)+2,127); + } + else + if (strncmp(*argv,"-h",2)==0) { + syntax(); + return -1; + } + else { + printf("Invalid option\n"); + syntax(); + return -1; + } + } + + // parse points to be simulated from the input file + fin = fopen(fnamein,"r"); + if (!fin) { + printf("Can't open file: %s\n",fnamein); + syntax(); + } + + while (fgets(buf,128,fin)!=0) + if (*buf=='#' || *buf=='\n' ) + continue; + else + if (nitems==SIM_POINTS_MAX) + break; + else + if (sscanf(buf,"%f %u",&EbNodB[nitems],&nerrstgt[nitems])!=2) { + printf("Invalid input file format\n"); + syntax(); + return -1; + } + else + nitems++; + + fclose(fin); + + if (nitems==0) { + printf("No Eb/No point specified in file %s\n",fnamein); + syntax(); + return -1; + } + + printf("\nQ-ary Repeat-Accumulate Code Word Error Rate Simulator\n"); + printf("2016, Nico Palermo - IV3NWV\n\n"); + + printf("Nthreads = %d\n",nthreads); + printf("Channel = %s\n",ch_type==CHANNEL_AWGN?"AWGN":"Rayleigh"); + printf("Codename = %s\n",codetotest[code_idx]->name); + printf("A-priori = %s\n",ap_str[ap_index]); + printf("Eb/No input file = %s\n\n",fnamein); + + wer_test_proc(codetotest[code_idx], nthreads, ch_type, ap_index, EbNodB, nerrstgt, nitems); + + return 0; +} + diff --git a/wsjtx_lib/lib/qra/qracodes/normrnd.c b/wsjtx_lib/lib/qra/qracodes/normrnd.c new file mode 100644 index 0000000..90abfa4 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/normrnd.c @@ -0,0 +1,82 @@ +// normrnd.c +// functions to generate gaussian distributed numbers +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// +// Credits to Andrea Montefusco - IW0HDV for his help on adapting the sources +// to OSs other than MS Windows +// +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + + +#include "normrnd.h" + +#if _WIN32 // note the underscore: without it, it's not msdn official! + // Windows (x64 and x86) + #include // required only for GetTickCount(...) + #define K_RAND_MAX UINT_MAX +#elif _SVID_SOURCE || _XOPEN_SOURCE || __unix__ || (defined (__APPLE__) && defined(__MACH__)) /* POSIX or Unix or Apple */ + #include + #define rand_s(x) (*x)=(unsigned int)lrand48() // returns unsigned integers in the range 0..0x7FFFFFFF + #define K_RAND_MAX 0x7FFFFFFF // that's the max number + // generated by lrand48 +#else + #error "No good quality PRNG found" +#endif + + +// use MS rand_s(...) function +void normrnd_s(float *dst, int nitems, float mean, float stdev) +{ + unsigned int r; + float phi=0, u=0; + int set = 0; + + while (nitems--) + if (set==1) { + *dst++ = (float)sin(phi)*u*stdev+mean; + set = 0; + } + else { + rand_s((unsigned int*)&r); phi = (M_2PI/(1.0f+K_RAND_MAX))*r; + rand_s((unsigned int*)&r); u = (float)sqrt(-2.0f* log( (1.0f/(1.0f+K_RAND_MAX))*(1.0f+r) ) ); + *dst++ = (float)cos(phi)*u*stdev+mean; + set=1; + } +} + +/* NOT USED +// use MS rand() function +void normrnd(float *dst, int nitems, float mean, float stdev) +{ + float phi=0, u=0; + int set = 0; + + while (nitems--) + if (set==1) { + *dst++ = (float)sin(phi)*u*stdev+mean; + set = 0; + } + else { + phi = (M_2PI/(1.0f+RAND_MAX))*rand(); + u = (float)sqrt(-2.0f* log( (1.0f/(1.0f+RAND_MAX))*(1.0f+rand()) ) ); + *dst++ = (float)cos(phi)*u*stdev+mean; + set=1; + } +} +*/ diff --git a/wsjtx_lib/lib/qra/qracodes/normrnd.h b/wsjtx_lib/lib/qra/qracodes/normrnd.h new file mode 100644 index 0000000..dd4b65b --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/normrnd.h @@ -0,0 +1,51 @@ +// normrnd.h +// Functions to generate gaussian distributed numbers +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _normrnd_h_ +#define _normrnd_h_ + +#define _CRT_RAND_S +#include + +#define _USE_MATH_DEFINES +#include +#define M_2PI (2.0f*(float)M_PI) + +#ifdef __cplusplus +extern "C" { +#endif + +void normrnd_s(float *dst, int nitems, float mean, float stdev); +// generate a random array of numbers with a gaussian distribution of given mean and stdev +// use MS rand_s(...) function + +/* not used +void normrnd(float *dst, int nitems, float mean, float stdev); +// generate a random array of numbers with a gaussian distribution of given mean and stdev +// use MS rand() function +*/ + +#ifdef __cplusplus +} +#endif + +#endif // _normrnd_h_ + diff --git a/wsjtx_lib/lib/qra/qracodes/npfwht.c b/wsjtx_lib/lib/qra/qracodes/npfwht.c new file mode 100644 index 0000000..5732ce9 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/npfwht.c @@ -0,0 +1,216 @@ +// npfwht.c +// Basic implementation of the Fast Walsh-Hadamard Transforms +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (repeat and accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "npfwht.h" + +#define WHBFY(dst,src,base,offs,dist) { dst[base+offs]=src[base+offs]+src[base+offs+dist]; dst[base+offs+dist]=src[base+offs]-src[base+offs+dist]; } + +typedef void (*pnp_fwht)(float*,float*); + +static void np_fwht2(float *dst, float *src); + +static void np_fwht1(float *dst, float *src); +static void np_fwht2(float *dst, float *src); +static void np_fwht4(float *dst, float *src); +static void np_fwht8(float *dst, float *src); +static void np_fwht16(float *dst, float *src); +static void np_fwht32(float *dst, float *src); +static void np_fwht64(float *dst, float *src); + +static pnp_fwht np_fwht_tab[7] = { + np_fwht1, + np_fwht2, + np_fwht4, + np_fwht8, + np_fwht16, + np_fwht32, + np_fwht64 +}; + +void np_fwht(int nlogdim, float *dst, float *src) +{ + np_fwht_tab[nlogdim](dst,src); +} + +static void np_fwht1(float *dst, float *src) +{ + dst[0] = src[0]; +} + + +static void np_fwht2(float *dst, float *src) +{ + float t[2]; + + WHBFY(t,src,0,0,1); + dst[0]= t[0]; + dst[1]= t[1]; +} + +static void np_fwht4(float *dst, float *src) +{ + float t[4]; + + // group 1 + WHBFY(t,src,0,0,2); WHBFY(t,src,0,1,2); + // group 2 + WHBFY(dst,t,0,0,1); WHBFY(dst,t,2,0,1); +}; + + +static void np_fwht8(float *dst, float *src) +{ + float t[16]; + float *t1=t, *t2=t+8; + + // group 1 + WHBFY(t1,src,0,0,4); WHBFY(t1,src,0,1,4); WHBFY(t1,src,0,2,4); WHBFY(t1,src,0,3,4); + // group 2 + WHBFY(t2,t1,0,0,2); WHBFY(t2,t1,0,1,2); WHBFY(t2,t1,4,0,2); WHBFY(t2,t1,4,1,2); + // group 3 + WHBFY(dst,t2,0,0,1); WHBFY(dst,t2,2,0,1); WHBFY(dst,t2,4,0,1); WHBFY(dst,t2,6,0,1); +}; + + +static void np_fwht16(float *dst, float *src) +{ + float t[32]; + float *t1=t, *t2=t+16; + + // group 1 + WHBFY(t1,src,0,0,8); WHBFY(t1,src,0,1,8); WHBFY(t1,src,0,2,8); WHBFY(t1,src,0,3,8); + WHBFY(t1,src,0,4,8); WHBFY(t1,src,0,5,8); WHBFY(t1,src,0,6,8); WHBFY(t1,src,0,7,8); + // group 2 + WHBFY(t2,t1,0,0,4); WHBFY(t2,t1,0,1,4); WHBFY(t2,t1,0,2,4); WHBFY(t2,t1,0,3,4); + WHBFY(t2,t1,8,0,4); WHBFY(t2,t1,8,1,4); WHBFY(t2,t1,8,2,4); WHBFY(t2,t1,8,3,4); + // group 3 + WHBFY(t1,t2,0,0,2); WHBFY(t1,t2,0,1,2); WHBFY(t1,t2,4,0,2); WHBFY(t1,t2,4,1,2); + WHBFY(t1,t2,8,0,2); WHBFY(t1,t2,8,1,2); WHBFY(t1,t2,12,0,2); WHBFY(t1,t2,12,1,2); + // group 4 + WHBFY(dst,t1,0,0,1); WHBFY(dst,t1,2,0,1); WHBFY(dst,t1,4,0,1); WHBFY(dst,t1,6,0,1); + WHBFY(dst,t1,8,0,1); WHBFY(dst,t1,10,0,1); WHBFY(dst,t1,12,0,1); WHBFY(dst,t1,14,0,1); + +} + +static void np_fwht32(float *dst, float *src) +{ + float t[64]; + float *t1=t, *t2=t+32; + + // group 1 + WHBFY(t1,src,0,0,16); WHBFY(t1,src,0,1,16); WHBFY(t1,src,0,2,16); WHBFY(t1,src,0,3,16); + WHBFY(t1,src,0,4,16); WHBFY(t1,src,0,5,16); WHBFY(t1,src,0,6,16); WHBFY(t1,src,0,7,16); + WHBFY(t1,src,0,8,16); WHBFY(t1,src,0,9,16); WHBFY(t1,src,0,10,16); WHBFY(t1,src,0,11,16); + WHBFY(t1,src,0,12,16); WHBFY(t1,src,0,13,16); WHBFY(t1,src,0,14,16); WHBFY(t1,src,0,15,16); + + // group 2 + WHBFY(t2,t1,0,0,8); WHBFY(t2,t1,0,1,8); WHBFY(t2,t1,0,2,8); WHBFY(t2,t1,0,3,8); + WHBFY(t2,t1,0,4,8); WHBFY(t2,t1,0,5,8); WHBFY(t2,t1,0,6,8); WHBFY(t2,t1,0,7,8); + WHBFY(t2,t1,16,0,8); WHBFY(t2,t1,16,1,8); WHBFY(t2,t1,16,2,8); WHBFY(t2,t1,16,3,8); + WHBFY(t2,t1,16,4,8); WHBFY(t2,t1,16,5,8); WHBFY(t2,t1,16,6,8); WHBFY(t2,t1,16,7,8); + + // group 3 + WHBFY(t1,t2,0,0,4); WHBFY(t1,t2,0,1,4); WHBFY(t1,t2,0,2,4); WHBFY(t1,t2,0,3,4); + WHBFY(t1,t2,8,0,4); WHBFY(t1,t2,8,1,4); WHBFY(t1,t2,8,2,4); WHBFY(t1,t2,8,3,4); + WHBFY(t1,t2,16,0,4); WHBFY(t1,t2,16,1,4); WHBFY(t1,t2,16,2,4); WHBFY(t1,t2,16,3,4); + WHBFY(t1,t2,24,0,4); WHBFY(t1,t2,24,1,4); WHBFY(t1,t2,24,2,4); WHBFY(t1,t2,24,3,4); + + // group 4 + WHBFY(t2,t1,0,0,2); WHBFY(t2,t1,0,1,2); WHBFY(t2,t1,4,0,2); WHBFY(t2,t1,4,1,2); + WHBFY(t2,t1,8,0,2); WHBFY(t2,t1,8,1,2); WHBFY(t2,t1,12,0,2); WHBFY(t2,t1,12,1,2); + WHBFY(t2,t1,16,0,2); WHBFY(t2,t1,16,1,2); WHBFY(t2,t1,20,0,2); WHBFY(t2,t1,20,1,2); + WHBFY(t2,t1,24,0,2); WHBFY(t2,t1,24,1,2); WHBFY(t2,t1,28,0,2); WHBFY(t2,t1,28,1,2); + + // group 5 + WHBFY(dst,t2,0,0,1); WHBFY(dst,t2,2,0,1); WHBFY(dst,t2,4,0,1); WHBFY(dst,t2,6,0,1); + WHBFY(dst,t2,8,0,1); WHBFY(dst,t2,10,0,1); WHBFY(dst,t2,12,0,1); WHBFY(dst,t2,14,0,1); + WHBFY(dst,t2,16,0,1); WHBFY(dst,t2,18,0,1); WHBFY(dst,t2,20,0,1); WHBFY(dst,t2,22,0,1); + WHBFY(dst,t2,24,0,1); WHBFY(dst,t2,26,0,1); WHBFY(dst,t2,28,0,1); WHBFY(dst,t2,30,0,1); + +} + +static void np_fwht64(float *dst, float *src) +{ + float t[128]; + float *t1=t, *t2=t+64; + + + // group 1 + WHBFY(t1,src,0,0,32); WHBFY(t1,src,0,1,32); WHBFY(t1,src,0,2,32); WHBFY(t1,src,0,3,32); + WHBFY(t1,src,0,4,32); WHBFY(t1,src,0,5,32); WHBFY(t1,src,0,6,32); WHBFY(t1,src,0,7,32); + WHBFY(t1,src,0,8,32); WHBFY(t1,src,0,9,32); WHBFY(t1,src,0,10,32); WHBFY(t1,src,0,11,32); + WHBFY(t1,src,0,12,32); WHBFY(t1,src,0,13,32); WHBFY(t1,src,0,14,32); WHBFY(t1,src,0,15,32); + WHBFY(t1,src,0,16,32); WHBFY(t1,src,0,17,32); WHBFY(t1,src,0,18,32); WHBFY(t1,src,0,19,32); + WHBFY(t1,src,0,20,32); WHBFY(t1,src,0,21,32); WHBFY(t1,src,0,22,32); WHBFY(t1,src,0,23,32); + WHBFY(t1,src,0,24,32); WHBFY(t1,src,0,25,32); WHBFY(t1,src,0,26,32); WHBFY(t1,src,0,27,32); + WHBFY(t1,src,0,28,32); WHBFY(t1,src,0,29,32); WHBFY(t1,src,0,30,32); WHBFY(t1,src,0,31,32); + + // group 2 + WHBFY(t2,t1,0,0,16); WHBFY(t2,t1,0,1,16); WHBFY(t2,t1,0,2,16); WHBFY(t2,t1,0,3,16); + WHBFY(t2,t1,0,4,16); WHBFY(t2,t1,0,5,16); WHBFY(t2,t1,0,6,16); WHBFY(t2,t1,0,7,16); + WHBFY(t2,t1,0,8,16); WHBFY(t2,t1,0,9,16); WHBFY(t2,t1,0,10,16); WHBFY(t2,t1,0,11,16); + WHBFY(t2,t1,0,12,16); WHBFY(t2,t1,0,13,16); WHBFY(t2,t1,0,14,16); WHBFY(t2,t1,0,15,16); + + WHBFY(t2,t1,32,0,16); WHBFY(t2,t1,32,1,16); WHBFY(t2,t1,32,2,16); WHBFY(t2,t1,32,3,16); + WHBFY(t2,t1,32,4,16); WHBFY(t2,t1,32,5,16); WHBFY(t2,t1,32,6,16); WHBFY(t2,t1,32,7,16); + WHBFY(t2,t1,32,8,16); WHBFY(t2,t1,32,9,16); WHBFY(t2,t1,32,10,16); WHBFY(t2,t1,32,11,16); + WHBFY(t2,t1,32,12,16); WHBFY(t2,t1,32,13,16); WHBFY(t2,t1,32,14,16); WHBFY(t2,t1,32,15,16); + + // group 3 + WHBFY(t1,t2,0,0,8); WHBFY(t1,t2,0,1,8); WHBFY(t1,t2,0,2,8); WHBFY(t1,t2,0,3,8); + WHBFY(t1,t2,0,4,8); WHBFY(t1,t2,0,5,8); WHBFY(t1,t2,0,6,8); WHBFY(t1,t2,0,7,8); + WHBFY(t1,t2,16,0,8); WHBFY(t1,t2,16,1,8); WHBFY(t1,t2,16,2,8); WHBFY(t1,t2,16,3,8); + WHBFY(t1,t2,16,4,8); WHBFY(t1,t2,16,5,8); WHBFY(t1,t2,16,6,8); WHBFY(t1,t2,16,7,8); + WHBFY(t1,t2,32,0,8); WHBFY(t1,t2,32,1,8); WHBFY(t1,t2,32,2,8); WHBFY(t1,t2,32,3,8); + WHBFY(t1,t2,32,4,8); WHBFY(t1,t2,32,5,8); WHBFY(t1,t2,32,6,8); WHBFY(t1,t2,32,7,8); + WHBFY(t1,t2,48,0,8); WHBFY(t1,t2,48,1,8); WHBFY(t1,t2,48,2,8); WHBFY(t1,t2,48,3,8); + WHBFY(t1,t2,48,4,8); WHBFY(t1,t2,48,5,8); WHBFY(t1,t2,48,6,8); WHBFY(t1,t2,48,7,8); + + // group 4 + WHBFY(t2,t1,0,0,4); WHBFY(t2,t1,0,1,4); WHBFY(t2,t1,0,2,4); WHBFY(t2,t1,0,3,4); + WHBFY(t2,t1,8,0,4); WHBFY(t2,t1,8,1,4); WHBFY(t2,t1,8,2,4); WHBFY(t2,t1,8,3,4); + WHBFY(t2,t1,16,0,4); WHBFY(t2,t1,16,1,4); WHBFY(t2,t1,16,2,4); WHBFY(t2,t1,16,3,4); + WHBFY(t2,t1,24,0,4); WHBFY(t2,t1,24,1,4); WHBFY(t2,t1,24,2,4); WHBFY(t2,t1,24,3,4); + WHBFY(t2,t1,32,0,4); WHBFY(t2,t1,32,1,4); WHBFY(t2,t1,32,2,4); WHBFY(t2,t1,32,3,4); + WHBFY(t2,t1,40,0,4); WHBFY(t2,t1,40,1,4); WHBFY(t2,t1,40,2,4); WHBFY(t2,t1,40,3,4); + WHBFY(t2,t1,48,0,4); WHBFY(t2,t1,48,1,4); WHBFY(t2,t1,48,2,4); WHBFY(t2,t1,48,3,4); + WHBFY(t2,t1,56,0,4); WHBFY(t2,t1,56,1,4); WHBFY(t2,t1,56,2,4); WHBFY(t2,t1,56,3,4); + + // group 5 + WHBFY(t1,t2,0,0,2); WHBFY(t1,t2,0,1,2); WHBFY(t1,t2,4,0,2); WHBFY(t1,t2,4,1,2); + WHBFY(t1,t2,8,0,2); WHBFY(t1,t2,8,1,2); WHBFY(t1,t2,12,0,2); WHBFY(t1,t2,12,1,2); + WHBFY(t1,t2,16,0,2); WHBFY(t1,t2,16,1,2); WHBFY(t1,t2,20,0,2); WHBFY(t1,t2,20,1,2); + WHBFY(t1,t2,24,0,2); WHBFY(t1,t2,24,1,2); WHBFY(t1,t2,28,0,2); WHBFY(t1,t2,28,1,2); + WHBFY(t1,t2,32,0,2); WHBFY(t1,t2,32,1,2); WHBFY(t1,t2,36,0,2); WHBFY(t1,t2,36,1,2); + WHBFY(t1,t2,40,0,2); WHBFY(t1,t2,40,1,2); WHBFY(t1,t2,44,0,2); WHBFY(t1,t2,44,1,2); + WHBFY(t1,t2,48,0,2); WHBFY(t1,t2,48,1,2); WHBFY(t1,t2,52,0,2); WHBFY(t1,t2,52,1,2); + WHBFY(t1,t2,56,0,2); WHBFY(t1,t2,56,1,2); WHBFY(t1,t2,60,0,2); WHBFY(t1,t2,60,1,2); + + // group 6 + WHBFY(dst,t1,0,0,1); WHBFY(dst,t1,2,0,1); WHBFY(dst,t1,4,0,1); WHBFY(dst,t1,6,0,1); + WHBFY(dst,t1,8,0,1); WHBFY(dst,t1,10,0,1); WHBFY(dst,t1,12,0,1); WHBFY(dst,t1,14,0,1); + WHBFY(dst,t1,16,0,1); WHBFY(dst,t1,18,0,1); WHBFY(dst,t1,20,0,1); WHBFY(dst,t1,22,0,1); + WHBFY(dst,t1,24,0,1); WHBFY(dst,t1,26,0,1); WHBFY(dst,t1,28,0,1); WHBFY(dst,t1,30,0,1); + WHBFY(dst,t1,32,0,1); WHBFY(dst,t1,34,0,1); WHBFY(dst,t1,36,0,1); WHBFY(dst,t1,38,0,1); + WHBFY(dst,t1,40,0,1); WHBFY(dst,t1,42,0,1); WHBFY(dst,t1,44,0,1); WHBFY(dst,t1,46,0,1); + WHBFY(dst,t1,48,0,1); WHBFY(dst,t1,50,0,1); WHBFY(dst,t1,52,0,1); WHBFY(dst,t1,54,0,1); + WHBFY(dst,t1,56,0,1); WHBFY(dst,t1,58,0,1); WHBFY(dst,t1,60,0,1); WHBFY(dst,t1,62,0,1); +} \ No newline at end of file diff --git a/wsjtx_lib/lib/qra/qracodes/npfwht.h b/wsjtx_lib/lib/qra/qracodes/npfwht.h new file mode 100644 index 0000000..9452e20 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/npfwht.h @@ -0,0 +1,45 @@ +// np_fwht.h +// Basic implementation of the Fast Walsh-Hadamard Transforms +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (repeat and accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _npfwht_h_ +#define _npfwht_h_ + +#ifdef __cplusplus +extern "C" { +#endif + +void np_fwht(int nlogdim, float *dst, float *src); +// Compute the Walsh-Hadamard transform of the given data up to a +// 64-dimensional transform +// +// Input parameters: +// nlogdim: log2 of the transform size. Must be in the range [0..6] +// src : pointer to the input data buffer. +// dst : pointer to the output data buffer. +// +// src and dst must point to preallocated data buffers of size 2^nlogdim*sizeof(float) +// src and dst buffers can overlap + +#ifdef __cplusplus +} +#endif + +#endif // _npfwht_ diff --git a/wsjtx_lib/lib/qra/qracodes/pdmath.c b/wsjtx_lib/lib/qra/qracodes/pdmath.c new file mode 100644 index 0000000..47ecab9 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/pdmath.c @@ -0,0 +1,385 @@ +// pdmath.c +// Elementary math on probability distributions +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "pdmath.h" + +typedef const float *ppd_uniform; +typedef void (*ppd_imul)(float*,const float*); +typedef float (*ppd_norm)(float*); + +// define vector size in function of its logarithm in base 2 +static const int pd_log2dim[7] = { + 1,2,4,8,16,32,64 +}; + +// define uniform distributions of given size +static const float pd_uniform1[1] = { + 1. +}; +static const float pd_uniform2[2] = { + 1./2., 1./2. +}; +static const float pd_uniform4[4] = { + 1./4., 1./4.,1./4., 1./4. +}; +static const float pd_uniform8[8] = { + 1./8., 1./8.,1./8., 1./8.,1./8., 1./8.,1./8., 1./8. +}; +static const float pd_uniform16[16] = { + 1./16., 1./16., 1./16., 1./16.,1./16., 1./16.,1./16., 1./16., + 1./16., 1./16., 1./16., 1./16.,1./16., 1./16.,1./16., 1./16. +}; +static const float pd_uniform32[32] = { + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32., + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32., + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32., + 1./32., 1./32., 1./32., 1./32.,1./32., 1./32.,1./32., 1./32. +}; +static const float pd_uniform64[64] = { + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64., + 1./64., 1./64., 1./64., 1./64.,1./64., 1./64.,1./64., 1./64. + +}; + +static const ppd_uniform pd_uniform_tab[7] = { + pd_uniform1, + pd_uniform2, + pd_uniform4, + pd_uniform8, + pd_uniform16, + pd_uniform32, + pd_uniform64 +}; + +// returns a pointer to the uniform distribution of the given logsize +const float *pd_uniform(int nlogdim) +{ + return pd_uniform_tab[nlogdim]; +} + +// in-place multiplication functions +// compute dst = dst*src for any element of the distrib + +static void pd_imul1(float *dst, const float *src) +{ + dst[0] *= src[0]; +} + +static void pd_imul2(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; +} +static void pd_imul4(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; + dst[2] *= src[2]; dst[3] *= src[3]; +} +static void pd_imul8(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; dst[2] *= src[2]; dst[3] *= src[3]; + dst[4] *= src[4]; dst[5] *= src[5]; dst[6] *= src[6]; dst[7] *= src[7]; +} +static void pd_imul16(float *dst, const float *src) +{ + dst[0] *= src[0]; dst[1] *= src[1]; dst[2] *= src[2]; dst[3] *= src[3]; + dst[4] *= src[4]; dst[5] *= src[5]; dst[6] *= src[6]; dst[7] *= src[7]; + dst[8] *= src[8]; dst[9] *= src[9]; dst[10]*= src[10]; dst[11]*= src[11]; + dst[12]*= src[12]; dst[13]*= src[13]; dst[14]*= src[14]; dst[15]*= src[15]; +} +static void pd_imul32(float *dst, const float *src) +{ + pd_imul16(dst,src); + pd_imul16(dst+16,src+16); +} +static void pd_imul64(float *dst, const float *src) +{ + pd_imul16(dst, src); + pd_imul16(dst+16, src+16); + pd_imul16(dst+32, src+32); + pd_imul16(dst+48, src+48); +} + +static const ppd_imul pd_imul_tab[7] = { + pd_imul1, + pd_imul2, + pd_imul4, + pd_imul8, + pd_imul16, + pd_imul32, + pd_imul64 +}; + +// in place multiplication +// compute dst = dst*src for any element of the distrib give their log2 size +// arguments must be pointers to array of floats of the given size +void pd_imul(float *dst, const float *src, int nlogdim) +{ + pd_imul_tab[nlogdim](dst,src); +} + +static float pd_norm1(float *ppd) +{ + float t = ppd[0]; + ppd[0] = 1.f; + return t; +} + +static float pd_norm2(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; + + if (t<=0) { + pd_init(ppd,pd_uniform(1),pd_log2dim[1]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; + return to; + +} + +static float pd_norm4(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + + if (t<=0) { + pd_init(ppd,pd_uniform(2),pd_log2dim[2]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + return to; +} + +static float pd_norm8(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + + if (t<=0) { + pd_init(ppd,pd_uniform(3),pd_log2dim[3]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + return to; +} +static float pd_norm16(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + t +=ppd[8]; t +=ppd[9]; t +=ppd[10]; t +=ppd[11]; + t +=ppd[12]; t +=ppd[13]; t +=ppd[14]; t +=ppd[15]; + + if (t<=0) { + pd_init(ppd,pd_uniform(4),pd_log2dim[4]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + ppd[8] *=t; ppd[9] *=t; ppd[10] *=t; ppd[11] *=t; + ppd[12] *=t; ppd[13] *=t; ppd[14] *=t; ppd[15] *=t; + + return to; +} +static float pd_norm32(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + t +=ppd[8]; t +=ppd[9]; t +=ppd[10]; t +=ppd[11]; + t +=ppd[12]; t +=ppd[13]; t +=ppd[14]; t +=ppd[15]; + t +=ppd[16]; t +=ppd[17]; t +=ppd[18]; t +=ppd[19]; + t +=ppd[20]; t +=ppd[21]; t +=ppd[22]; t +=ppd[23]; + t +=ppd[24]; t +=ppd[25]; t +=ppd[26]; t +=ppd[27]; + t +=ppd[28]; t +=ppd[29]; t +=ppd[30]; t +=ppd[31]; + + if (t<=0) { + pd_init(ppd,pd_uniform(5),pd_log2dim[5]); + return t; + } + + to = t; + t = 1.f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + ppd[8] *=t; ppd[9] *=t; ppd[10] *=t; ppd[11] *=t; + ppd[12] *=t; ppd[13] *=t; ppd[14] *=t; ppd[15] *=t; + ppd[16] *=t; ppd[17] *=t; ppd[18] *=t; ppd[19] *=t; + ppd[20] *=t; ppd[21] *=t; ppd[22] *=t; ppd[23] *=t; + ppd[24] *=t; ppd[25] *=t; ppd[26] *=t; ppd[27] *=t; + ppd[28] *=t; ppd[29] *=t; ppd[30] *=t; ppd[31] *=t; + + return to; +} + +static float pd_norm64(float *ppd) +{ + float t,to; + + t =ppd[0]; t +=ppd[1]; t +=ppd[2]; t +=ppd[3]; + t +=ppd[4]; t +=ppd[5]; t +=ppd[6]; t +=ppd[7]; + t +=ppd[8]; t +=ppd[9]; t +=ppd[10]; t +=ppd[11]; + t +=ppd[12]; t +=ppd[13]; t +=ppd[14]; t +=ppd[15]; + t +=ppd[16]; t +=ppd[17]; t +=ppd[18]; t +=ppd[19]; + t +=ppd[20]; t +=ppd[21]; t +=ppd[22]; t +=ppd[23]; + t +=ppd[24]; t +=ppd[25]; t +=ppd[26]; t +=ppd[27]; + t +=ppd[28]; t +=ppd[29]; t +=ppd[30]; t +=ppd[31]; + + t +=ppd[32]; t +=ppd[33]; t +=ppd[34]; t +=ppd[35]; + t +=ppd[36]; t +=ppd[37]; t +=ppd[38]; t +=ppd[39]; + t +=ppd[40]; t +=ppd[41]; t +=ppd[42]; t +=ppd[43]; + t +=ppd[44]; t +=ppd[45]; t +=ppd[46]; t +=ppd[47]; + t +=ppd[48]; t +=ppd[49]; t +=ppd[50]; t +=ppd[51]; + t +=ppd[52]; t +=ppd[53]; t +=ppd[54]; t +=ppd[55]; + t +=ppd[56]; t +=ppd[57]; t +=ppd[58]; t +=ppd[59]; + t +=ppd[60]; t +=ppd[61]; t +=ppd[62]; t +=ppd[63]; + + if (t<=0) { + pd_init(ppd,pd_uniform(6),pd_log2dim[6]); + return t; + } + + to = t; + t = 1.0f/t; + ppd[0] *=t; ppd[1] *=t; ppd[2] *=t; ppd[3] *=t; + ppd[4] *=t; ppd[5] *=t; ppd[6] *=t; ppd[7] *=t; + ppd[8] *=t; ppd[9] *=t; ppd[10] *=t; ppd[11] *=t; + ppd[12] *=t; ppd[13] *=t; ppd[14] *=t; ppd[15] *=t; + ppd[16] *=t; ppd[17] *=t; ppd[18] *=t; ppd[19] *=t; + ppd[20] *=t; ppd[21] *=t; ppd[22] *=t; ppd[23] *=t; + ppd[24] *=t; ppd[25] *=t; ppd[26] *=t; ppd[27] *=t; + ppd[28] *=t; ppd[29] *=t; ppd[30] *=t; ppd[31] *=t; + + ppd[32] *=t; ppd[33] *=t; ppd[34] *=t; ppd[35] *=t; + ppd[36] *=t; ppd[37] *=t; ppd[38] *=t; ppd[39] *=t; + ppd[40] *=t; ppd[41] *=t; ppd[42] *=t; ppd[43] *=t; + ppd[44] *=t; ppd[45] *=t; ppd[46] *=t; ppd[47] *=t; + ppd[48] *=t; ppd[49] *=t; ppd[50] *=t; ppd[51] *=t; + ppd[52] *=t; ppd[53] *=t; ppd[54] *=t; ppd[55] *=t; + ppd[56] *=t; ppd[57] *=t; ppd[58] *=t; ppd[59] *=t; + ppd[60] *=t; ppd[61] *=t; ppd[62] *=t; ppd[63] *=t; + + return to; +} + + +static const ppd_norm pd_norm_tab[7] = { + pd_norm1, + pd_norm2, + pd_norm4, + pd_norm8, + pd_norm16, + pd_norm32, + pd_norm64 +}; + +float pd_norm(float *pd, int nlogdim) +{ + return pd_norm_tab[nlogdim](pd); +} + +void pd_memset(float *dst, const float *src, int ndim, int nitems) +{ + int size = PD_SIZE(ndim); + while(nitems--) { + memcpy(dst,src,size); + dst +=ndim; + } +} + +void pd_fwdperm(float *dst, float *src, const int *perm, int ndim) +{ + // TODO: non-loop implementation + while (ndim--) + dst[ndim] = src[perm[ndim]]; +} + +void pd_bwdperm(float *dst, float *src, const int *perm, int ndim) +{ + // TODO: non-loop implementation + while (ndim--) + dst[perm[ndim]] = src[ndim]; +} + +float pd_max(float *src, int ndim) +{ + // TODO: faster implementation + + float cmax=0; // we assume that prob distributions are always positive + float cval; + + while (ndim--) { + cval = src[ndim]; + if (cval>=cmax) { + cmax = cval; + } + } + + return cmax; +} + +int pd_argmax(float *pmax, float *src, int ndim) +{ + // TODO: faster implementation + + float cmax=0; // we assume that prob distributions are always positive + float cval; + int idxmax=-1; // indicates that all pd elements are <0 + + while (ndim--) { + cval = src[ndim]; + if (cval>=cmax) { + cmax = cval; + idxmax = ndim; + } + } + + if (pmax) + *pmax = cmax; + + return idxmax; +} diff --git a/wsjtx_lib/lib/qra/qracodes/pdmath.h b/wsjtx_lib/lib/qra/qracodes/pdmath.h new file mode 100644 index 0000000..bbd1210 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/pdmath.h @@ -0,0 +1,85 @@ +// pdmath.h +// Elementary math on probability distributions +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (repeat and accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + + +#ifndef _pdmath_h_ +#define _pdmath_h_ + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#define PD_NDIM(nlogdim) ((1<<(nlogdim)) +#define PD_SIZE(ndim) ((ndim)*sizeof(float)) +#define PD_ROWADDR(fp,ndim,idx) (fp+((ndim)*(idx))) + +const float *pd_uniform(int nlogdim); +// Returns a pointer to a (constant) uniform distribution of the given log2 size + +#define pd_init(dst,src,ndim) memcpy(dst,src,PD_SIZE(ndim)) +// Distribution copy + +void pd_memset(float *dst, const float *src, int ndim, int nitems); +// Copy the distribution pointed by src to the array of distributions dst +// src is a pointer to the input distribution (a vector of size ndim) +// dst is a pointer to a linear array of distributions (a vector of size ndim*nitems) + +void pd_imul(float *dst, const float *src, int nlogdim); +// In place multiplication +// Compute dst = dst*src for any element of the distrib give their log2 size +// src and dst arguments must be pointers to array of floats of the given size + +float pd_norm(float *pd, int nlogdim); +// In place normalizazion +// Normalizes the input vector so that the sum of its components are one +// pd must be a pointer to an array of floats of the given size. +// If the norm of the input vector is non-positive the vector components +// are replaced with a uniform distribution +// Returns the norm of the distribution prior to the normalization + +void pd_fwdperm(float *dst, float *src, const int *perm, int ndim); +// Forward permutation of a distribution +// Computes dst[k] = src[perm[k]] for every element in the distribution +// perm must be a pointer to an array of integers of length ndim + +void pd_bwdperm(float *dst, float *src, const int *perm, int ndim); +// Backward permutation of a distribution +// Computes dst[perm[k]] = src[k] for every element in the distribution +// perm must be a pointer to an array of integers of length ndim + +float pd_max(float *src, int ndim); +// Return the maximum of the elements of the given distribution +// Assumes that the input vector is a probability distribution and that each element in the +// distribution is non negative + +int pd_argmax(float *pmax, float *src, int ndim); +// Return the index of the maximum element of the given distribution +// The maximum is stored in the variable pointed by pmax if pmax is not null +// Same note of pd_max applies. +// Return -1 if all the elements in the distribution are negative + +#ifdef __cplusplus +} +#endif + +#endif // _pdmath_h_ diff --git a/wsjtx_lib/lib/qra/qracodes/qra12_63_64_irr_b.c b/wsjtx_lib/lib/qra/qracodes/qra12_63_64_irr_b.c new file mode 100644 index 0000000..d69443b --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/qra12_63_64_irr_b.c @@ -0,0 +1,534 @@ +// qra12_63_64_irr_b.c +// Encoding/Decoding tables for Q-ary RA code (12,63) over GF(64) +// Code Name: qra12_63_64_irr_b +// (12,63) RA Code over GF(64) - RF=333344455567 + +// (c) 2016 - Nico Palermo - IV3NWV - Microtelecom Srl, Italy + +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "qra12_63_64_irr_b.h" + +#define qra_K 12 // number of information symbols +#define qra_N 63 // codeword length in symbols +#define qra_m 6 // bits/symbol +#define qra_M 64 // Symbol alphabet cardinality +#define qra_a 1 // grouping factor +#define qra_NC 51 // number of check symbols (N-K) + +// Defines used by the message passing decoder -------- + +#define qra_V 63 // number of variables in the code graph (N) +#define qra_C 115 // number of factors in the code graph (N +(N-K)+1) +#define qra_NMSG 217 // number of msgs in the code graph +#define qra_MAXVDEG 8 // maximum variable degree +#define qra_MAXCDEG 3 // maximum factor degree +#define qra_R 0.19048f // code rate (K/N) +#define CODE_NAME "qra_12_63_64_irr_b" + + +// table of the systematic symbols indexes in the accumulator chain +static const int qra_acc_input_idx[qra_NC+1] = { + 3, 11, 0, 1, 7, 8, 6, 5, 10, 4, + 11, 9, 0, 2, 6, 7, 8, 4, 11, 5, + 10, 2, 1, 9, 3, 8, 4, 11, 5, 7, + 10, 9, 6, 3, 11, 5, 8, 10, 0, 7, + 9, 11, 4, 2, 10, 6, 8, 1, 9, 7, + 11, 10 +}; + +// table of the systematic symbols weight logarithms over GF(M) +static const int qra_acc_input_wlog[qra_NC+1] = { + 39, 0, 34, 16, 25, 0, 34, 48, 19, 13, + 29, 56, 0, 5, 39, 42, 31, 0, 10, 0, + 57, 62, 33, 43, 0, 14, 22, 48, 28, 20, + 5, 45, 16, 43, 17, 4, 32, 0, 31, 0, + 0, 28, 57, 0, 18, 0, 60, 0, 10, 31, + 57, 27 +}; + +// table of the logarithms of the elements of GF(M) (log(0) never used) +static const int qra_log[qra_M] = { + -1, 0, 1, 6, 2, 12, 7, 26, 3, 32, + 13, 35, 8, 48, 27, 18, 4, 24, 33, 16, + 14, 52, 36, 54, 9, 45, 49, 38, 28, 41, + 19, 56, 5, 62, 25, 11, 34, 31, 17, 47, + 15, 23, 53, 51, 37, 44, 55, 40, 10, 61, + 46, 30, 50, 22, 39, 43, 29, 60, 42, 21, + 20, 59, 57, 58 +}; + +// table of GF(M) elements given their logarithm +static const int qra_exp[qra_M-1] = { + 1, 2, 4, 8, 16, 32, 3, 6, 12, 24, + 48, 35, 5, 10, 20, 40, 19, 38, 15, 30, + 60, 59, 53, 41, 17, 34, 7, 14, 28, 56, + 51, 37, 9, 18, 36, 11, 22, 44, 27, 54, + 47, 29, 58, 55, 45, 25, 50, 39, 13, 26, + 52, 43, 21, 42, 23, 46, 31, 62, 63, 61, + 57, 49, 33 +}; + +// table of the messages weight logarithms over GF(M) +static const int qra_msgw[qra_NMSG] = { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 39, 0, 34, 16, 25, 0, 34, + 48, 19, 13, 29, 56, 0, 5, 39, 42, 31, + 0, 10, 0, 57, 62, 33, 43, 0, 14, 22, + 48, 28, 20, 5, 45, 16, 43, 17, 4, 32, + 0, 31, 0, 0, 28, 57, 0, 18, 0, 60, + 0, 10, 31, 57, 27, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0 +}; + +// table of the degrees of the variable nodes +static const int qra_vdeg[qra_V] = { + 4, 4, 4, 4, 5, 5, 5, 6, 6, 6, + 7, 8, 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 +}; + +// table of the degrees of the factor nodes +static const int qra_cdeg[qra_C] = { + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 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, 2 +}; + +// table (uncompressed) of the v->c message indexes (-1=unused entry) +static const int qra_v2cmidx[qra_V*qra_MAXVDEG] = { + 0, 65, 75, 101, -1, -1, -1, -1, + 1, 66, 85, 110, -1, -1, -1, -1, + 2, 76, 84, 106, -1, -1, -1, -1, + 3, 63, 87, 96, -1, -1, -1, -1, + 4, 72, 80, 89, 105, -1, -1, -1, + 5, 70, 82, 91, 98, -1, -1, -1, + 6, 69, 77, 95, 108, -1, -1, -1, + 7, 67, 78, 92, 102, 112, -1, -1, + 8, 68, 79, 88, 99, 109, -1, -1, + 9, 74, 86, 94, 103, 111, -1, -1, + 10, 71, 83, 93, 100, 107, 114, -1, + 11, 64, 73, 81, 90, 97, 104, 113, + 12, 115, 116, -1, -1, -1, -1, -1, + 13, 117, 118, -1, -1, -1, -1, -1, + 14, 119, 120, -1, -1, -1, -1, -1, + 15, 121, 122, -1, -1, -1, -1, -1, + 16, 123, 124, -1, -1, -1, -1, -1, + 17, 125, 126, -1, -1, -1, -1, -1, + 18, 127, 128, -1, -1, -1, -1, -1, + 19, 129, 130, -1, -1, -1, -1, -1, + 20, 131, 132, -1, -1, -1, -1, -1, + 21, 133, 134, -1, -1, -1, -1, -1, + 22, 135, 136, -1, -1, -1, -1, -1, + 23, 137, 138, -1, -1, -1, -1, -1, + 24, 139, 140, -1, -1, -1, -1, -1, + 25, 141, 142, -1, -1, -1, -1, -1, + 26, 143, 144, -1, -1, -1, -1, -1, + 27, 145, 146, -1, -1, -1, -1, -1, + 28, 147, 148, -1, -1, -1, -1, -1, + 29, 149, 150, -1, -1, -1, -1, -1, + 30, 151, 152, -1, -1, -1, -1, -1, + 31, 153, 154, -1, -1, -1, -1, -1, + 32, 155, 156, -1, -1, -1, -1, -1, + 33, 157, 158, -1, -1, -1, -1, -1, + 34, 159, 160, -1, -1, -1, -1, -1, + 35, 161, 162, -1, -1, -1, -1, -1, + 36, 163, 164, -1, -1, -1, -1, -1, + 37, 165, 166, -1, -1, -1, -1, -1, + 38, 167, 168, -1, -1, -1, -1, -1, + 39, 169, 170, -1, -1, -1, -1, -1, + 40, 171, 172, -1, -1, -1, -1, -1, + 41, 173, 174, -1, -1, -1, -1, -1, + 42, 175, 176, -1, -1, -1, -1, -1, + 43, 177, 178, -1, -1, -1, -1, -1, + 44, 179, 180, -1, -1, -1, -1, -1, + 45, 181, 182, -1, -1, -1, -1, -1, + 46, 183, 184, -1, -1, -1, -1, -1, + 47, 185, 186, -1, -1, -1, -1, -1, + 48, 187, 188, -1, -1, -1, -1, -1, + 49, 189, 190, -1, -1, -1, -1, -1, + 50, 191, 192, -1, -1, -1, -1, -1, + 51, 193, 194, -1, -1, -1, -1, -1, + 52, 195, 196, -1, -1, -1, -1, -1, + 53, 197, 198, -1, -1, -1, -1, -1, + 54, 199, 200, -1, -1, -1, -1, -1, + 55, 201, 202, -1, -1, -1, -1, -1, + 56, 203, 204, -1, -1, -1, -1, -1, + 57, 205, 206, -1, -1, -1, -1, -1, + 58, 207, 208, -1, -1, -1, -1, -1, + 59, 209, 210, -1, -1, -1, -1, -1, + 60, 211, 212, -1, -1, -1, -1, -1, + 61, 213, 214, -1, -1, -1, -1, -1, + 62, 215, 216, -1, -1, -1, -1, -1 +}; + +// table (uncompressed) of the c->v message indexes (-1=unused entry) +static const int qra_c2vmidx[qra_C*qra_MAXCDEG] = { + 0, -1, -1, 1, -1, -1, 2, -1, -1, 3, -1, -1, + 4, -1, -1, 5, -1, -1, 6, -1, -1, 7, -1, -1, + 8, -1, -1, 9, -1, -1, 10, -1, -1, 11, -1, -1, + 12, -1, -1, 13, -1, -1, 14, -1, -1, 15, -1, -1, + 16, -1, -1, 17, -1, -1, 18, -1, -1, 19, -1, -1, + 20, -1, -1, 21, -1, -1, 22, -1, -1, 23, -1, -1, + 24, -1, -1, 25, -1, -1, 26, -1, -1, 27, -1, -1, + 28, -1, -1, 29, -1, -1, 30, -1, -1, 31, -1, -1, + 32, -1, -1, 33, -1, -1, 34, -1, -1, 35, -1, -1, + 36, -1, -1, 37, -1, -1, 38, -1, -1, 39, -1, -1, + 40, -1, -1, 41, -1, -1, 42, -1, -1, 43, -1, -1, + 44, -1, -1, 45, -1, -1, 46, -1, -1, 47, -1, -1, + 48, -1, -1, 49, -1, -1, 50, -1, -1, 51, -1, -1, + 52, -1, -1, 53, -1, -1, 54, -1, -1, 55, -1, -1, + 56, -1, -1, 57, -1, -1, 58, -1, -1, 59, -1, -1, + 60, -1, -1, 61, -1, -1, 62, -1, -1, 63, 115, -1, + 64, 116, 117, 65, 118, 119, 66, 120, 121, 67, 122, 123, + 68, 124, 125, 69, 126, 127, 70, 128, 129, 71, 130, 131, + 72, 132, 133, 73, 134, 135, 74, 136, 137, 75, 138, 139, + 76, 140, 141, 77, 142, 143, 78, 144, 145, 79, 146, 147, + 80, 148, 149, 81, 150, 151, 82, 152, 153, 83, 154, 155, + 84, 156, 157, 85, 158, 159, 86, 160, 161, 87, 162, 163, + 88, 164, 165, 89, 166, 167, 90, 168, 169, 91, 170, 171, + 92, 172, 173, 93, 174, 175, 94, 176, 177, 95, 178, 179, + 96, 180, 181, 97, 182, 183, 98, 184, 185, 99, 186, 187, +100, 188, 189, 101, 190, 191, 102, 192, 193, 103, 194, 195, +104, 196, 197, 105, 198, 199, 106, 200, 201, 107, 202, 203, +108, 204, 205, 109, 206, 207, 110, 208, 209, 111, 210, 211, +112, 212, 213, 113, 214, 215, 114, 216, -1 +}; + +// permutation matrix to compute Prob(x*alfa^logw) +static const int qra_pmat[qra_M*qra_M] = { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 0, 33, 1, 32, 2, 35, 3, 34, 4, 37, 5, 36, 6, 39, 7, 38, + 8, 41, 9, 40, 10, 43, 11, 42, 12, 45, 13, 44, 14, 47, 15, 46, + 16, 49, 17, 48, 18, 51, 19, 50, 20, 53, 21, 52, 22, 55, 23, 54, + 24, 57, 25, 56, 26, 59, 27, 58, 28, 61, 29, 60, 30, 63, 31, 62, + 0, 49, 33, 16, 1, 48, 32, 17, 2, 51, 35, 18, 3, 50, 34, 19, + 4, 53, 37, 20, 5, 52, 36, 21, 6, 55, 39, 22, 7, 54, 38, 23, + 8, 57, 41, 24, 9, 56, 40, 25, 10, 59, 43, 26, 11, 58, 42, 27, + 12, 61, 45, 28, 13, 60, 44, 29, 14, 63, 47, 30, 15, 62, 46, 31, + 0, 57, 49, 8, 33, 24, 16, 41, 1, 56, 48, 9, 32, 25, 17, 40, + 2, 59, 51, 10, 35, 26, 18, 43, 3, 58, 50, 11, 34, 27, 19, 42, + 4, 61, 53, 12, 37, 28, 20, 45, 5, 60, 52, 13, 36, 29, 21, 44, + 6, 63, 55, 14, 39, 30, 22, 47, 7, 62, 54, 15, 38, 31, 23, 46, + 0, 61, 57, 4, 49, 12, 8, 53, 33, 28, 24, 37, 16, 45, 41, 20, + 1, 60, 56, 5, 48, 13, 9, 52, 32, 29, 25, 36, 17, 44, 40, 21, + 2, 63, 59, 6, 51, 14, 10, 55, 35, 30, 26, 39, 18, 47, 43, 22, + 3, 62, 58, 7, 50, 15, 11, 54, 34, 31, 27, 38, 19, 46, 42, 23, + 0, 63, 61, 2, 57, 6, 4, 59, 49, 14, 12, 51, 8, 55, 53, 10, + 33, 30, 28, 35, 24, 39, 37, 26, 16, 47, 45, 18, 41, 22, 20, 43, + 1, 62, 60, 3, 56, 7, 5, 58, 48, 15, 13, 50, 9, 54, 52, 11, + 32, 31, 29, 34, 25, 38, 36, 27, 17, 46, 44, 19, 40, 23, 21, 42, + 0, 62, 63, 1, 61, 3, 2, 60, 57, 7, 6, 56, 4, 58, 59, 5, + 49, 15, 14, 48, 12, 50, 51, 13, 8, 54, 55, 9, 53, 11, 10, 52, + 33, 31, 30, 32, 28, 34, 35, 29, 24, 38, 39, 25, 37, 27, 26, 36, + 16, 46, 47, 17, 45, 19, 18, 44, 41, 23, 22, 40, 20, 42, 43, 21, + 0, 31, 62, 33, 63, 32, 1, 30, 61, 34, 3, 28, 2, 29, 60, 35, + 57, 38, 7, 24, 6, 25, 56, 39, 4, 27, 58, 37, 59, 36, 5, 26, + 49, 46, 15, 16, 14, 17, 48, 47, 12, 19, 50, 45, 51, 44, 13, 18, + 8, 23, 54, 41, 55, 40, 9, 22, 53, 42, 11, 20, 10, 21, 52, 43, + 0, 46, 31, 49, 62, 16, 33, 15, 63, 17, 32, 14, 1, 47, 30, 48, + 61, 19, 34, 12, 3, 45, 28, 50, 2, 44, 29, 51, 60, 18, 35, 13, + 57, 23, 38, 8, 7, 41, 24, 54, 6, 40, 25, 55, 56, 22, 39, 9, + 4, 42, 27, 53, 58, 20, 37, 11, 59, 21, 36, 10, 5, 43, 26, 52, + 0, 23, 46, 57, 31, 8, 49, 38, 62, 41, 16, 7, 33, 54, 15, 24, + 63, 40, 17, 6, 32, 55, 14, 25, 1, 22, 47, 56, 30, 9, 48, 39, + 61, 42, 19, 4, 34, 53, 12, 27, 3, 20, 45, 58, 28, 11, 50, 37, + 2, 21, 44, 59, 29, 10, 51, 36, 60, 43, 18, 5, 35, 52, 13, 26, + 0, 42, 23, 61, 46, 4, 57, 19, 31, 53, 8, 34, 49, 27, 38, 12, + 62, 20, 41, 3, 16, 58, 7, 45, 33, 11, 54, 28, 15, 37, 24, 50, + 63, 21, 40, 2, 17, 59, 6, 44, 32, 10, 55, 29, 14, 36, 25, 51, + 1, 43, 22, 60, 47, 5, 56, 18, 30, 52, 9, 35, 48, 26, 39, 13, + 0, 21, 42, 63, 23, 2, 61, 40, 46, 59, 4, 17, 57, 44, 19, 6, + 31, 10, 53, 32, 8, 29, 34, 55, 49, 36, 27, 14, 38, 51, 12, 25, + 62, 43, 20, 1, 41, 60, 3, 22, 16, 5, 58, 47, 7, 18, 45, 56, + 33, 52, 11, 30, 54, 35, 28, 9, 15, 26, 37, 48, 24, 13, 50, 39, + 0, 43, 21, 62, 42, 1, 63, 20, 23, 60, 2, 41, 61, 22, 40, 3, + 46, 5, 59, 16, 4, 47, 17, 58, 57, 18, 44, 7, 19, 56, 6, 45, + 31, 52, 10, 33, 53, 30, 32, 11, 8, 35, 29, 54, 34, 9, 55, 28, + 49, 26, 36, 15, 27, 48, 14, 37, 38, 13, 51, 24, 12, 39, 25, 50, + 0, 52, 43, 31, 21, 33, 62, 10, 42, 30, 1, 53, 63, 11, 20, 32, + 23, 35, 60, 8, 2, 54, 41, 29, 61, 9, 22, 34, 40, 28, 3, 55, + 46, 26, 5, 49, 59, 15, 16, 36, 4, 48, 47, 27, 17, 37, 58, 14, + 57, 13, 18, 38, 44, 24, 7, 51, 19, 39, 56, 12, 6, 50, 45, 25, + 0, 26, 52, 46, 43, 49, 31, 5, 21, 15, 33, 59, 62, 36, 10, 16, + 42, 48, 30, 4, 1, 27, 53, 47, 63, 37, 11, 17, 20, 14, 32, 58, + 23, 13, 35, 57, 60, 38, 8, 18, 2, 24, 54, 44, 41, 51, 29, 7, + 61, 39, 9, 19, 22, 12, 34, 56, 40, 50, 28, 6, 3, 25, 55, 45, + 0, 13, 26, 23, 52, 57, 46, 35, 43, 38, 49, 60, 31, 18, 5, 8, + 21, 24, 15, 2, 33, 44, 59, 54, 62, 51, 36, 41, 10, 7, 16, 29, + 42, 39, 48, 61, 30, 19, 4, 9, 1, 12, 27, 22, 53, 56, 47, 34, + 63, 50, 37, 40, 11, 6, 17, 28, 20, 25, 14, 3, 32, 45, 58, 55, + 0, 39, 13, 42, 26, 61, 23, 48, 52, 19, 57, 30, 46, 9, 35, 4, + 43, 12, 38, 1, 49, 22, 60, 27, 31, 56, 18, 53, 5, 34, 8, 47, + 21, 50, 24, 63, 15, 40, 2, 37, 33, 6, 44, 11, 59, 28, 54, 17, + 62, 25, 51, 20, 36, 3, 41, 14, 10, 45, 7, 32, 16, 55, 29, 58, + 0, 50, 39, 21, 13, 63, 42, 24, 26, 40, 61, 15, 23, 37, 48, 2, + 52, 6, 19, 33, 57, 11, 30, 44, 46, 28, 9, 59, 35, 17, 4, 54, + 43, 25, 12, 62, 38, 20, 1, 51, 49, 3, 22, 36, 60, 14, 27, 41, + 31, 45, 56, 10, 18, 32, 53, 7, 5, 55, 34, 16, 8, 58, 47, 29, + 0, 25, 50, 43, 39, 62, 21, 12, 13, 20, 63, 38, 42, 51, 24, 1, + 26, 3, 40, 49, 61, 36, 15, 22, 23, 14, 37, 60, 48, 41, 2, 27, + 52, 45, 6, 31, 19, 10, 33, 56, 57, 32, 11, 18, 30, 7, 44, 53, + 46, 55, 28, 5, 9, 16, 59, 34, 35, 58, 17, 8, 4, 29, 54, 47, + 0, 45, 25, 52, 50, 31, 43, 6, 39, 10, 62, 19, 21, 56, 12, 33, + 13, 32, 20, 57, 63, 18, 38, 11, 42, 7, 51, 30, 24, 53, 1, 44, + 26, 55, 3, 46, 40, 5, 49, 28, 61, 16, 36, 9, 15, 34, 22, 59, + 23, 58, 14, 35, 37, 8, 60, 17, 48, 29, 41, 4, 2, 47, 27, 54, + 0, 55, 45, 26, 25, 46, 52, 3, 50, 5, 31, 40, 43, 28, 6, 49, + 39, 16, 10, 61, 62, 9, 19, 36, 21, 34, 56, 15, 12, 59, 33, 22, + 13, 58, 32, 23, 20, 35, 57, 14, 63, 8, 18, 37, 38, 17, 11, 60, + 42, 29, 7, 48, 51, 4, 30, 41, 24, 47, 53, 2, 1, 54, 44, 27, + 0, 58, 55, 13, 45, 23, 26, 32, 25, 35, 46, 20, 52, 14, 3, 57, + 50, 8, 5, 63, 31, 37, 40, 18, 43, 17, 28, 38, 6, 60, 49, 11, + 39, 29, 16, 42, 10, 48, 61, 7, 62, 4, 9, 51, 19, 41, 36, 30, + 21, 47, 34, 24, 56, 2, 15, 53, 12, 54, 59, 1, 33, 27, 22, 44, + 0, 29, 58, 39, 55, 42, 13, 16, 45, 48, 23, 10, 26, 7, 32, 61, + 25, 4, 35, 62, 46, 51, 20, 9, 52, 41, 14, 19, 3, 30, 57, 36, + 50, 47, 8, 21, 5, 24, 63, 34, 31, 2, 37, 56, 40, 53, 18, 15, + 43, 54, 17, 12, 28, 1, 38, 59, 6, 27, 60, 33, 49, 44, 11, 22, + 0, 47, 29, 50, 58, 21, 39, 8, 55, 24, 42, 5, 13, 34, 16, 63, + 45, 2, 48, 31, 23, 56, 10, 37, 26, 53, 7, 40, 32, 15, 61, 18, + 25, 54, 4, 43, 35, 12, 62, 17, 46, 1, 51, 28, 20, 59, 9, 38, + 52, 27, 41, 6, 14, 33, 19, 60, 3, 44, 30, 49, 57, 22, 36, 11, + 0, 54, 47, 25, 29, 43, 50, 4, 58, 12, 21, 35, 39, 17, 8, 62, + 55, 1, 24, 46, 42, 28, 5, 51, 13, 59, 34, 20, 16, 38, 63, 9, + 45, 27, 2, 52, 48, 6, 31, 41, 23, 33, 56, 14, 10, 60, 37, 19, + 26, 44, 53, 3, 7, 49, 40, 30, 32, 22, 15, 57, 61, 11, 18, 36, + 0, 27, 54, 45, 47, 52, 25, 2, 29, 6, 43, 48, 50, 41, 4, 31, + 58, 33, 12, 23, 21, 14, 35, 56, 39, 60, 17, 10, 8, 19, 62, 37, + 55, 44, 1, 26, 24, 3, 46, 53, 42, 49, 28, 7, 5, 30, 51, 40, + 13, 22, 59, 32, 34, 57, 20, 15, 16, 11, 38, 61, 63, 36, 9, 18, + 0, 44, 27, 55, 54, 26, 45, 1, 47, 3, 52, 24, 25, 53, 2, 46, + 29, 49, 6, 42, 43, 7, 48, 28, 50, 30, 41, 5, 4, 40, 31, 51, + 58, 22, 33, 13, 12, 32, 23, 59, 21, 57, 14, 34, 35, 15, 56, 20, + 39, 11, 60, 16, 17, 61, 10, 38, 8, 36, 19, 63, 62, 18, 37, 9, + 0, 22, 44, 58, 27, 13, 55, 33, 54, 32, 26, 12, 45, 59, 1, 23, + 47, 57, 3, 21, 52, 34, 24, 14, 25, 15, 53, 35, 2, 20, 46, 56, + 29, 11, 49, 39, 6, 16, 42, 60, 43, 61, 7, 17, 48, 38, 28, 10, + 50, 36, 30, 8, 41, 63, 5, 19, 4, 18, 40, 62, 31, 9, 51, 37, + 0, 11, 22, 29, 44, 39, 58, 49, 27, 16, 13, 6, 55, 60, 33, 42, + 54, 61, 32, 43, 26, 17, 12, 7, 45, 38, 59, 48, 1, 10, 23, 28, + 47, 36, 57, 50, 3, 8, 21, 30, 52, 63, 34, 41, 24, 19, 14, 5, + 25, 18, 15, 4, 53, 62, 35, 40, 2, 9, 20, 31, 46, 37, 56, 51, + 0, 36, 11, 47, 22, 50, 29, 57, 44, 8, 39, 3, 58, 30, 49, 21, + 27, 63, 16, 52, 13, 41, 6, 34, 55, 19, 60, 24, 33, 5, 42, 14, + 54, 18, 61, 25, 32, 4, 43, 15, 26, 62, 17, 53, 12, 40, 7, 35, + 45, 9, 38, 2, 59, 31, 48, 20, 1, 37, 10, 46, 23, 51, 28, 56, + 0, 18, 36, 54, 11, 25, 47, 61, 22, 4, 50, 32, 29, 15, 57, 43, + 44, 62, 8, 26, 39, 53, 3, 17, 58, 40, 30, 12, 49, 35, 21, 7, + 27, 9, 63, 45, 16, 2, 52, 38, 13, 31, 41, 59, 6, 20, 34, 48, + 55, 37, 19, 1, 60, 46, 24, 10, 33, 51, 5, 23, 42, 56, 14, 28, + 0, 9, 18, 27, 36, 45, 54, 63, 11, 2, 25, 16, 47, 38, 61, 52, + 22, 31, 4, 13, 50, 59, 32, 41, 29, 20, 15, 6, 57, 48, 43, 34, + 44, 37, 62, 55, 8, 1, 26, 19, 39, 46, 53, 60, 3, 10, 17, 24, + 58, 51, 40, 33, 30, 23, 12, 5, 49, 56, 35, 42, 21, 28, 7, 14, + 0, 37, 9, 44, 18, 55, 27, 62, 36, 1, 45, 8, 54, 19, 63, 26, + 11, 46, 2, 39, 25, 60, 16, 53, 47, 10, 38, 3, 61, 24, 52, 17, + 22, 51, 31, 58, 4, 33, 13, 40, 50, 23, 59, 30, 32, 5, 41, 12, + 29, 56, 20, 49, 15, 42, 6, 35, 57, 28, 48, 21, 43, 14, 34, 7, + 0, 51, 37, 22, 9, 58, 44, 31, 18, 33, 55, 4, 27, 40, 62, 13, + 36, 23, 1, 50, 45, 30, 8, 59, 54, 5, 19, 32, 63, 12, 26, 41, + 11, 56, 46, 29, 2, 49, 39, 20, 25, 42, 60, 15, 16, 35, 53, 6, + 47, 28, 10, 57, 38, 21, 3, 48, 61, 14, 24, 43, 52, 7, 17, 34, + 0, 56, 51, 11, 37, 29, 22, 46, 9, 49, 58, 2, 44, 20, 31, 39, + 18, 42, 33, 25, 55, 15, 4, 60, 27, 35, 40, 16, 62, 6, 13, 53, + 36, 28, 23, 47, 1, 57, 50, 10, 45, 21, 30, 38, 8, 48, 59, 3, + 54, 14, 5, 61, 19, 43, 32, 24, 63, 7, 12, 52, 26, 34, 41, 17, + 0, 28, 56, 36, 51, 47, 11, 23, 37, 57, 29, 1, 22, 10, 46, 50, + 9, 21, 49, 45, 58, 38, 2, 30, 44, 48, 20, 8, 31, 3, 39, 59, + 18, 14, 42, 54, 33, 61, 25, 5, 55, 43, 15, 19, 4, 24, 60, 32, + 27, 7, 35, 63, 40, 52, 16, 12, 62, 34, 6, 26, 13, 17, 53, 41, + 0, 14, 28, 18, 56, 54, 36, 42, 51, 61, 47, 33, 11, 5, 23, 25, + 37, 43, 57, 55, 29, 19, 1, 15, 22, 24, 10, 4, 46, 32, 50, 60, + 9, 7, 21, 27, 49, 63, 45, 35, 58, 52, 38, 40, 2, 12, 30, 16, + 44, 34, 48, 62, 20, 26, 8, 6, 31, 17, 3, 13, 39, 41, 59, 53, + 0, 7, 14, 9, 28, 27, 18, 21, 56, 63, 54, 49, 36, 35, 42, 45, + 51, 52, 61, 58, 47, 40, 33, 38, 11, 12, 5, 2, 23, 16, 25, 30, + 37, 34, 43, 44, 57, 62, 55, 48, 29, 26, 19, 20, 1, 6, 15, 8, + 22, 17, 24, 31, 10, 13, 4, 3, 46, 41, 32, 39, 50, 53, 60, 59, + 0, 34, 7, 37, 14, 44, 9, 43, 28, 62, 27, 57, 18, 48, 21, 55, + 56, 26, 63, 29, 54, 20, 49, 19, 36, 6, 35, 1, 42, 8, 45, 15, + 51, 17, 52, 22, 61, 31, 58, 24, 47, 13, 40, 10, 33, 3, 38, 4, + 11, 41, 12, 46, 5, 39, 2, 32, 23, 53, 16, 50, 25, 59, 30, 60, + 0, 17, 34, 51, 7, 22, 37, 52, 14, 31, 44, 61, 9, 24, 43, 58, + 28, 13, 62, 47, 27, 10, 57, 40, 18, 3, 48, 33, 21, 4, 55, 38, + 56, 41, 26, 11, 63, 46, 29, 12, 54, 39, 20, 5, 49, 32, 19, 2, + 36, 53, 6, 23, 35, 50, 1, 16, 42, 59, 8, 25, 45, 60, 15, 30, + 0, 41, 17, 56, 34, 11, 51, 26, 7, 46, 22, 63, 37, 12, 52, 29, + 14, 39, 31, 54, 44, 5, 61, 20, 9, 32, 24, 49, 43, 2, 58, 19, + 28, 53, 13, 36, 62, 23, 47, 6, 27, 50, 10, 35, 57, 16, 40, 1, + 18, 59, 3, 42, 48, 25, 33, 8, 21, 60, 4, 45, 55, 30, 38, 15, + 0, 53, 41, 28, 17, 36, 56, 13, 34, 23, 11, 62, 51, 6, 26, 47, + 7, 50, 46, 27, 22, 35, 63, 10, 37, 16, 12, 57, 52, 1, 29, 40, + 14, 59, 39, 18, 31, 42, 54, 3, 44, 25, 5, 48, 61, 8, 20, 33, + 9, 60, 32, 21, 24, 45, 49, 4, 43, 30, 2, 55, 58, 15, 19, 38, + 0, 59, 53, 14, 41, 18, 28, 39, 17, 42, 36, 31, 56, 3, 13, 54, + 34, 25, 23, 44, 11, 48, 62, 5, 51, 8, 6, 61, 26, 33, 47, 20, + 7, 60, 50, 9, 46, 21, 27, 32, 22, 45, 35, 24, 63, 4, 10, 49, + 37, 30, 16, 43, 12, 55, 57, 2, 52, 15, 1, 58, 29, 38, 40, 19, + 0, 60, 59, 7, 53, 9, 14, 50, 41, 21, 18, 46, 28, 32, 39, 27, + 17, 45, 42, 22, 36, 24, 31, 35, 56, 4, 3, 63, 13, 49, 54, 10, + 34, 30, 25, 37, 23, 43, 44, 16, 11, 55, 48, 12, 62, 2, 5, 57, + 51, 15, 8, 52, 6, 58, 61, 1, 26, 38, 33, 29, 47, 19, 20, 40, + 0, 30, 60, 34, 59, 37, 7, 25, 53, 43, 9, 23, 14, 16, 50, 44, + 41, 55, 21, 11, 18, 12, 46, 48, 28, 2, 32, 62, 39, 57, 27, 5, + 17, 15, 45, 51, 42, 52, 22, 8, 36, 58, 24, 6, 31, 1, 35, 61, + 56, 38, 4, 26, 3, 29, 63, 33, 13, 19, 49, 47, 54, 40, 10, 20, + 0, 15, 30, 17, 60, 51, 34, 45, 59, 52, 37, 42, 7, 8, 25, 22, + 53, 58, 43, 36, 9, 6, 23, 24, 14, 1, 16, 31, 50, 61, 44, 35, + 41, 38, 55, 56, 21, 26, 11, 4, 18, 29, 12, 3, 46, 33, 48, 63, + 28, 19, 2, 13, 32, 47, 62, 49, 39, 40, 57, 54, 27, 20, 5, 10, + 0, 38, 15, 41, 30, 56, 17, 55, 60, 26, 51, 21, 34, 4, 45, 11, + 59, 29, 52, 18, 37, 3, 42, 12, 7, 33, 8, 46, 25, 63, 22, 48, + 53, 19, 58, 28, 43, 13, 36, 2, 9, 47, 6, 32, 23, 49, 24, 62, + 14, 40, 1, 39, 16, 54, 31, 57, 50, 20, 61, 27, 44, 10, 35, 5, + 0, 19, 38, 53, 15, 28, 41, 58, 30, 13, 56, 43, 17, 2, 55, 36, + 60, 47, 26, 9, 51, 32, 21, 6, 34, 49, 4, 23, 45, 62, 11, 24, + 59, 40, 29, 14, 52, 39, 18, 1, 37, 54, 3, 16, 42, 57, 12, 31, + 7, 20, 33, 50, 8, 27, 46, 61, 25, 10, 63, 44, 22, 5, 48, 35, + 0, 40, 19, 59, 38, 14, 53, 29, 15, 39, 28, 52, 41, 1, 58, 18, + 30, 54, 13, 37, 56, 16, 43, 3, 17, 57, 2, 42, 55, 31, 36, 12, + 60, 20, 47, 7, 26, 50, 9, 33, 51, 27, 32, 8, 21, 61, 6, 46, + 34, 10, 49, 25, 4, 44, 23, 63, 45, 5, 62, 22, 11, 35, 24, 48, + 0, 20, 40, 60, 19, 7, 59, 47, 38, 50, 14, 26, 53, 33, 29, 9, + 15, 27, 39, 51, 28, 8, 52, 32, 41, 61, 1, 21, 58, 46, 18, 6, + 30, 10, 54, 34, 13, 25, 37, 49, 56, 44, 16, 4, 43, 63, 3, 23, + 17, 5, 57, 45, 2, 22, 42, 62, 55, 35, 31, 11, 36, 48, 12, 24, + 0, 10, 20, 30, 40, 34, 60, 54, 19, 25, 7, 13, 59, 49, 47, 37, + 38, 44, 50, 56, 14, 4, 26, 16, 53, 63, 33, 43, 29, 23, 9, 3, + 15, 5, 27, 17, 39, 45, 51, 57, 28, 22, 8, 2, 52, 62, 32, 42, + 41, 35, 61, 55, 1, 11, 21, 31, 58, 48, 46, 36, 18, 24, 6, 12, + 0, 5, 10, 15, 20, 17, 30, 27, 40, 45, 34, 39, 60, 57, 54, 51, + 19, 22, 25, 28, 7, 2, 13, 8, 59, 62, 49, 52, 47, 42, 37, 32, + 38, 35, 44, 41, 50, 55, 56, 61, 14, 11, 4, 1, 26, 31, 16, 21, + 53, 48, 63, 58, 33, 36, 43, 46, 29, 24, 23, 18, 9, 12, 3, 6, + 0, 35, 5, 38, 10, 41, 15, 44, 20, 55, 17, 50, 30, 61, 27, 56, + 40, 11, 45, 14, 34, 1, 39, 4, 60, 31, 57, 26, 54, 21, 51, 16, + 19, 48, 22, 53, 25, 58, 28, 63, 7, 36, 2, 33, 13, 46, 8, 43, + 59, 24, 62, 29, 49, 18, 52, 23, 47, 12, 42, 9, 37, 6, 32, 3, + 0, 48, 35, 19, 5, 53, 38, 22, 10, 58, 41, 25, 15, 63, 44, 28, + 20, 36, 55, 7, 17, 33, 50, 2, 30, 46, 61, 13, 27, 43, 56, 8, + 40, 24, 11, 59, 45, 29, 14, 62, 34, 18, 1, 49, 39, 23, 4, 52, + 60, 12, 31, 47, 57, 9, 26, 42, 54, 6, 21, 37, 51, 3, 16, 32, + 0, 24, 48, 40, 35, 59, 19, 11, 5, 29, 53, 45, 38, 62, 22, 14, + 10, 18, 58, 34, 41, 49, 25, 1, 15, 23, 63, 39, 44, 52, 28, 4, + 20, 12, 36, 60, 55, 47, 7, 31, 17, 9, 33, 57, 50, 42, 2, 26, + 30, 6, 46, 54, 61, 37, 13, 21, 27, 3, 43, 51, 56, 32, 8, 16, + 0, 12, 24, 20, 48, 60, 40, 36, 35, 47, 59, 55, 19, 31, 11, 7, + 5, 9, 29, 17, 53, 57, 45, 33, 38, 42, 62, 50, 22, 26, 14, 2, + 10, 6, 18, 30, 58, 54, 34, 46, 41, 37, 49, 61, 25, 21, 1, 13, + 15, 3, 23, 27, 63, 51, 39, 43, 44, 32, 52, 56, 28, 16, 4, 8, + 0, 6, 12, 10, 24, 30, 20, 18, 48, 54, 60, 58, 40, 46, 36, 34, + 35, 37, 47, 41, 59, 61, 55, 49, 19, 21, 31, 25, 11, 13, 7, 1, + 5, 3, 9, 15, 29, 27, 17, 23, 53, 51, 57, 63, 45, 43, 33, 39, + 38, 32, 42, 44, 62, 56, 50, 52, 22, 16, 26, 28, 14, 8, 2, 4, + 0, 3, 6, 5, 12, 15, 10, 9, 24, 27, 30, 29, 20, 23, 18, 17, + 48, 51, 54, 53, 60, 63, 58, 57, 40, 43, 46, 45, 36, 39, 34, 33, + 35, 32, 37, 38, 47, 44, 41, 42, 59, 56, 61, 62, 55, 52, 49, 50, + 19, 16, 21, 22, 31, 28, 25, 26, 11, 8, 13, 14, 7, 4, 1, 2, + 0, 32, 3, 35, 6, 38, 5, 37, 12, 44, 15, 47, 10, 42, 9, 41, + 24, 56, 27, 59, 30, 62, 29, 61, 20, 52, 23, 55, 18, 50, 17, 49, + 48, 16, 51, 19, 54, 22, 53, 21, 60, 28, 63, 31, 58, 26, 57, 25, + 40, 8, 43, 11, 46, 14, 45, 13, 36, 4, 39, 7, 34, 2, 33, 1, + 0, 16, 32, 48, 3, 19, 35, 51, 6, 22, 38, 54, 5, 21, 37, 53, + 12, 28, 44, 60, 15, 31, 47, 63, 10, 26, 42, 58, 9, 25, 41, 57, + 24, 8, 56, 40, 27, 11, 59, 43, 30, 14, 62, 46, 29, 13, 61, 45, + 20, 4, 52, 36, 23, 7, 55, 39, 18, 2, 50, 34, 17, 1, 49, 33, + 0, 8, 16, 24, 32, 40, 48, 56, 3, 11, 19, 27, 35, 43, 51, 59, + 6, 14, 22, 30, 38, 46, 54, 62, 5, 13, 21, 29, 37, 45, 53, 61, + 12, 4, 28, 20, 44, 36, 60, 52, 15, 7, 31, 23, 47, 39, 63, 55, + 10, 2, 26, 18, 42, 34, 58, 50, 9, 1, 25, 17, 41, 33, 57, 49, + 0, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, + 3, 7, 11, 15, 19, 23, 27, 31, 35, 39, 43, 47, 51, 55, 59, 63, + 6, 2, 14, 10, 22, 18, 30, 26, 38, 34, 46, 42, 54, 50, 62, 58, + 5, 1, 13, 9, 21, 17, 29, 25, 37, 33, 45, 41, 53, 49, 61, 57, + 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, + 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56, 58, 60, 62, + 3, 1, 7, 5, 11, 9, 15, 13, 19, 17, 23, 21, 27, 25, 31, 29, + 35, 33, 39, 37, 43, 41, 47, 45, 51, 49, 55, 53, 59, 57, 63, 61 +}; + +const qracode qra_12_63_64_irr_b = { + qra_K, + qra_N, + qra_m, + qra_M, + qra_a, + qra_NC, + qra_V, + qra_C, + qra_NMSG, + qra_MAXVDEG, + qra_MAXCDEG, + QRATYPE_NORMAL, + qra_R, + CODE_NAME, + qra_acc_input_idx, + qra_acc_input_wlog, + qra_log, + qra_exp, + qra_msgw, + qra_vdeg, + qra_cdeg, + qra_v2cmidx, + qra_c2vmidx, + qra_pmat +}; + +#undef qra_K +#undef qra_N +#undef qra_m +#undef qra_M +#undef qra_a +#undef qra_NC +#undef qra_V +#undef qra_C +#undef qra_NMSG +#undef qra_MAXVDEG +#undef qra_MAXCDEG +#undef qra_R +#undef CODE_NAME \ No newline at end of file diff --git a/wsjtx_lib/lib/qra/qracodes/qra12_63_64_irr_b.h b/wsjtx_lib/lib/qra/qracodes/qra12_63_64_irr_b.h new file mode 100644 index 0000000..bf70b36 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/qra12_63_64_irr_b.h @@ -0,0 +1,39 @@ +// qra12_63_64_irr_b.h +// Code tables and defines for Q-ary RA code (12,63) over GF(64) +// Code Name: qra12_63_64_irr_b +// (12,63) RA Code over GF(64) - RF=333344455567 + +// (c) 2016 - Nico Palermo - IV3NWV - Microtelecom Srl, Italy + +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _qra12_63_64_irr_b_h +#define _qra12_63_64_irr_b_h + +#include "qracodes.h" + +#ifdef __cplusplus +extern "C" { +#endif + +extern const qracode qra_12_63_64_irr_b; + +#ifdef __cplusplus +} +#endif + +#endif // _qra12_63_64_irr_b_h diff --git a/wsjtx_lib/lib/qra/qracodes/qra13_64_64_irr_e.c b/wsjtx_lib/lib/qra/qracodes/qra13_64_64_irr_e.c new file mode 100644 index 0000000..7adf22f --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/qra13_64_64_irr_e.c @@ -0,0 +1,534 @@ +// qra13_64_64_irr_e.c +// Encoding/Decoding tables for Q-ary RA code (13,64) over GF(64) +// Code Name: qra13_64_64_irr_e +// (13,64) RA Code over GF(64) RF=[3x4 4x4 6x1 3x2 5x1 7x1]/18 + +// (c) 2016 - Nico Palermo - IV3NWV - Microtelecom Srl, Italy + +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include "qra13_64_64_irr_e.h" + +#define qra_K 13 // number of information symbols +#define qra_N 64 // codeword length in symbols +#define qra_m 6 // bits/symbol +#define qra_M 64 // Symbol alphabet cardinality +#define qra_a 1 // grouping factor +#define qra_NC 51 // number of check symbols (N-K) + +// Defines used by the message passing decoder -------- + +#define qra_V 64 // number of variables in the code graph (N) +#define qra_C 116 // number of factors in the code graph (N +(N-K)+1) +#define qra_NMSG 218 // number of msgs in the code graph +#define qra_MAXVDEG 8 // maximum variable degree +#define qra_MAXCDEG 3 // maximum factor degree +#define qra_R 0.20313f // code rate (K/N) +#define CODE_NAME "qra_13_64_64_irr_e" + +// table of the systematic symbols indexes in the accumulator chain +static const int qra_acc_input_idx[qra_NC+1] = { + 12, 4, 3, 9, 0, 11, 6, 8, 12, 1, + 2, 7, 4, 11, 3, 5, 9, 8, 12, 7, + 2, 4, 10, 3, 5, 11, 12, 8, 9, 6, + 7, 2, 5, 4, 12, 8, 11, 1, 6, 7, + 0, 10, 12, 8, 11, 5, 6, 1, 0, 10, + 12, 8 +}; + +// table of the systematic symbols weight logarithms over GF(M) +static const int qra_acc_input_wlog[qra_NC+1] = { + 0, 27, 0, 0, 0, 31, 28, 61, 31, 0, + 0, 52, 22, 7, 19, 47, 44, 62, 32, 50, + 52, 42, 48, 56, 40, 50, 51, 37, 37, 0, + 5, 14, 0, 0, 18, 2, 0, 45, 21, 0, + 62, 8, 11, 60, 36, 32, 17, 9, 5, 0, + 53, 0 +}; + +// table of the logarithms of the elements of GF(M) (log(0) never used) +static const int qra_log[qra_M] = { + -1, 0, 1, 6, 2, 12, 7, 26, 3, 32, + 13, 35, 8, 48, 27, 18, 4, 24, 33, 16, + 14, 52, 36, 54, 9, 45, 49, 38, 28, 41, + 19, 56, 5, 62, 25, 11, 34, 31, 17, 47, + 15, 23, 53, 51, 37, 44, 55, 40, 10, 61, + 46, 30, 50, 22, 39, 43, 29, 60, 42, 21, + 20, 59, 57, 58 +}; + +// table of GF(M) elements given their logarithm +static const int qra_exp[qra_M-1] = { + 1, 2, 4, 8, 16, 32, 3, 6, 12, 24, + 48, 35, 5, 10, 20, 40, 19, 38, 15, 30, + 60, 59, 53, 41, 17, 34, 7, 14, 28, 56, + 51, 37, 9, 18, 36, 11, 22, 44, 27, 54, + 47, 29, 58, 55, 45, 25, 50, 39, 13, 26, + 52, 43, 21, 42, 23, 46, 31, 62, 63, 61, + 57, 49, 33 +}; + +// table of the messages weight logarithms over GF(M) +static const int qra_msgw[qra_NMSG] = { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 27, 0, 0, 0, 31, + 28, 61, 31, 0, 0, 52, 22, 7, 19, 47, + 44, 62, 32, 50, 52, 42, 48, 56, 40, 50, + 51, 37, 37, 0, 5, 14, 0, 0, 18, 2, + 0, 45, 21, 0, 62, 8, 11, 60, 36, 32, + 17, 9, 5, 0, 53, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 +}; + +// table of the degrees of the variable nodes +static const int qra_vdeg[qra_V] = { + 4, 4, 4, 4, 5, 5, 5, 5, 7, 4, + 4, 6, 8, 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 +}; + +// table of the degrees of the factor nodes +static const int qra_cdeg[qra_C] = { + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 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, 2 +}; + +// table (uncompressed) of the v->c message indexes (-1=unused entry) +static const int qra_v2cmidx[qra_V*qra_MAXVDEG] = { + 0, 68, 104, 112, -1, -1, -1, -1, + 1, 73, 101, 111, -1, -1, -1, -1, + 2, 74, 84, 95, -1, -1, -1, -1, + 3, 66, 78, 87, -1, -1, -1, -1, + 4, 65, 76, 85, 97, -1, -1, -1, + 5, 79, 88, 96, 109, -1, -1, -1, + 6, 70, 93, 102, 110, -1, -1, -1, + 7, 75, 83, 94, 103, -1, -1, -1, + 8, 71, 81, 91, 99, 107, 115, -1, + 9, 67, 80, 92, -1, -1, -1, -1, + 10, 86, 105, 113, -1, -1, -1, -1, + 11, 69, 77, 89, 100, 108, -1, -1, + 12, 64, 72, 82, 90, 98, 106, 114, + 13, 116, 117, -1, -1, -1, -1, -1, + 14, 118, 119, -1, -1, -1, -1, -1, + 15, 120, 121, -1, -1, -1, -1, -1, + 16, 122, 123, -1, -1, -1, -1, -1, + 17, 124, 125, -1, -1, -1, -1, -1, + 18, 126, 127, -1, -1, -1, -1, -1, + 19, 128, 129, -1, -1, -1, -1, -1, + 20, 130, 131, -1, -1, -1, -1, -1, + 21, 132, 133, -1, -1, -1, -1, -1, + 22, 134, 135, -1, -1, -1, -1, -1, + 23, 136, 137, -1, -1, -1, -1, -1, + 24, 138, 139, -1, -1, -1, -1, -1, + 25, 140, 141, -1, -1, -1, -1, -1, + 26, 142, 143, -1, -1, -1, -1, -1, + 27, 144, 145, -1, -1, -1, -1, -1, + 28, 146, 147, -1, -1, -1, -1, -1, + 29, 148, 149, -1, -1, -1, -1, -1, + 30, 150, 151, -1, -1, -1, -1, -1, + 31, 152, 153, -1, -1, -1, -1, -1, + 32, 154, 155, -1, -1, -1, -1, -1, + 33, 156, 157, -1, -1, -1, -1, -1, + 34, 158, 159, -1, -1, -1, -1, -1, + 35, 160, 161, -1, -1, -1, -1, -1, + 36, 162, 163, -1, -1, -1, -1, -1, + 37, 164, 165, -1, -1, -1, -1, -1, + 38, 166, 167, -1, -1, -1, -1, -1, + 39, 168, 169, -1, -1, -1, -1, -1, + 40, 170, 171, -1, -1, -1, -1, -1, + 41, 172, 173, -1, -1, -1, -1, -1, + 42, 174, 175, -1, -1, -1, -1, -1, + 43, 176, 177, -1, -1, -1, -1, -1, + 44, 178, 179, -1, -1, -1, -1, -1, + 45, 180, 181, -1, -1, -1, -1, -1, + 46, 182, 183, -1, -1, -1, -1, -1, + 47, 184, 185, -1, -1, -1, -1, -1, + 48, 186, 187, -1, -1, -1, -1, -1, + 49, 188, 189, -1, -1, -1, -1, -1, + 50, 190, 191, -1, -1, -1, -1, -1, + 51, 192, 193, -1, -1, -1, -1, -1, + 52, 194, 195, -1, -1, -1, -1, -1, + 53, 196, 197, -1, -1, -1, -1, -1, + 54, 198, 199, -1, -1, -1, -1, -1, + 55, 200, 201, -1, -1, -1, -1, -1, + 56, 202, 203, -1, -1, -1, -1, -1, + 57, 204, 205, -1, -1, -1, -1, -1, + 58, 206, 207, -1, -1, -1, -1, -1, + 59, 208, 209, -1, -1, -1, -1, -1, + 60, 210, 211, -1, -1, -1, -1, -1, + 61, 212, 213, -1, -1, -1, -1, -1, + 62, 214, 215, -1, -1, -1, -1, -1, + 63, 216, 217, -1, -1, -1, -1, -1 +}; + +// table (uncompressed) of the c->v message indexes (-1=unused entry) +static const int qra_c2vmidx[qra_C*qra_MAXCDEG] = { + 0, -1, -1, 1, -1, -1, 2, -1, -1, 3, -1, -1, + 4, -1, -1, 5, -1, -1, 6, -1, -1, 7, -1, -1, + 8, -1, -1, 9, -1, -1, 10, -1, -1, 11, -1, -1, + 12, -1, -1, 13, -1, -1, 14, -1, -1, 15, -1, -1, + 16, -1, -1, 17, -1, -1, 18, -1, -1, 19, -1, -1, + 20, -1, -1, 21, -1, -1, 22, -1, -1, 23, -1, -1, + 24, -1, -1, 25, -1, -1, 26, -1, -1, 27, -1, -1, + 28, -1, -1, 29, -1, -1, 30, -1, -1, 31, -1, -1, + 32, -1, -1, 33, -1, -1, 34, -1, -1, 35, -1, -1, + 36, -1, -1, 37, -1, -1, 38, -1, -1, 39, -1, -1, + 40, -1, -1, 41, -1, -1, 42, -1, -1, 43, -1, -1, + 44, -1, -1, 45, -1, -1, 46, -1, -1, 47, -1, -1, + 48, -1, -1, 49, -1, -1, 50, -1, -1, 51, -1, -1, + 52, -1, -1, 53, -1, -1, 54, -1, -1, 55, -1, -1, + 56, -1, -1, 57, -1, -1, 58, -1, -1, 59, -1, -1, + 60, -1, -1, 61, -1, -1, 62, -1, -1, 63, -1, -1, + 64, 116, -1, 65, 117, 118, 66, 119, 120, 67, 121, 122, + 68, 123, 124, 69, 125, 126, 70, 127, 128, 71, 129, 130, + 72, 131, 132, 73, 133, 134, 74, 135, 136, 75, 137, 138, + 76, 139, 140, 77, 141, 142, 78, 143, 144, 79, 145, 146, + 80, 147, 148, 81, 149, 150, 82, 151, 152, 83, 153, 154, + 84, 155, 156, 85, 157, 158, 86, 159, 160, 87, 161, 162, + 88, 163, 164, 89, 165, 166, 90, 167, 168, 91, 169, 170, + 92, 171, 172, 93, 173, 174, 94, 175, 176, 95, 177, 178, + 96, 179, 180, 97, 181, 182, 98, 183, 184, 99, 185, 186, +100, 187, 188, 101, 189, 190, 102, 191, 192, 103, 193, 194, +104, 195, 196, 105, 197, 198, 106, 199, 200, 107, 201, 202, +108, 203, 204, 109, 205, 206, 110, 207, 208, 111, 209, 210, +112, 211, 212, 113, 213, 214, 114, 215, 216, 115, 217, -1 +}; + +// permutation matrix to compute Prob(x*alfa^logw) +static const int qra_pmat[qra_M*qra_M] = { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 0, 33, 1, 32, 2, 35, 3, 34, 4, 37, 5, 36, 6, 39, 7, 38, + 8, 41, 9, 40, 10, 43, 11, 42, 12, 45, 13, 44, 14, 47, 15, 46, + 16, 49, 17, 48, 18, 51, 19, 50, 20, 53, 21, 52, 22, 55, 23, 54, + 24, 57, 25, 56, 26, 59, 27, 58, 28, 61, 29, 60, 30, 63, 31, 62, + 0, 49, 33, 16, 1, 48, 32, 17, 2, 51, 35, 18, 3, 50, 34, 19, + 4, 53, 37, 20, 5, 52, 36, 21, 6, 55, 39, 22, 7, 54, 38, 23, + 8, 57, 41, 24, 9, 56, 40, 25, 10, 59, 43, 26, 11, 58, 42, 27, + 12, 61, 45, 28, 13, 60, 44, 29, 14, 63, 47, 30, 15, 62, 46, 31, + 0, 57, 49, 8, 33, 24, 16, 41, 1, 56, 48, 9, 32, 25, 17, 40, + 2, 59, 51, 10, 35, 26, 18, 43, 3, 58, 50, 11, 34, 27, 19, 42, + 4, 61, 53, 12, 37, 28, 20, 45, 5, 60, 52, 13, 36, 29, 21, 44, + 6, 63, 55, 14, 39, 30, 22, 47, 7, 62, 54, 15, 38, 31, 23, 46, + 0, 61, 57, 4, 49, 12, 8, 53, 33, 28, 24, 37, 16, 45, 41, 20, + 1, 60, 56, 5, 48, 13, 9, 52, 32, 29, 25, 36, 17, 44, 40, 21, + 2, 63, 59, 6, 51, 14, 10, 55, 35, 30, 26, 39, 18, 47, 43, 22, + 3, 62, 58, 7, 50, 15, 11, 54, 34, 31, 27, 38, 19, 46, 42, 23, + 0, 63, 61, 2, 57, 6, 4, 59, 49, 14, 12, 51, 8, 55, 53, 10, + 33, 30, 28, 35, 24, 39, 37, 26, 16, 47, 45, 18, 41, 22, 20, 43, + 1, 62, 60, 3, 56, 7, 5, 58, 48, 15, 13, 50, 9, 54, 52, 11, + 32, 31, 29, 34, 25, 38, 36, 27, 17, 46, 44, 19, 40, 23, 21, 42, + 0, 62, 63, 1, 61, 3, 2, 60, 57, 7, 6, 56, 4, 58, 59, 5, + 49, 15, 14, 48, 12, 50, 51, 13, 8, 54, 55, 9, 53, 11, 10, 52, + 33, 31, 30, 32, 28, 34, 35, 29, 24, 38, 39, 25, 37, 27, 26, 36, + 16, 46, 47, 17, 45, 19, 18, 44, 41, 23, 22, 40, 20, 42, 43, 21, + 0, 31, 62, 33, 63, 32, 1, 30, 61, 34, 3, 28, 2, 29, 60, 35, + 57, 38, 7, 24, 6, 25, 56, 39, 4, 27, 58, 37, 59, 36, 5, 26, + 49, 46, 15, 16, 14, 17, 48, 47, 12, 19, 50, 45, 51, 44, 13, 18, + 8, 23, 54, 41, 55, 40, 9, 22, 53, 42, 11, 20, 10, 21, 52, 43, + 0, 46, 31, 49, 62, 16, 33, 15, 63, 17, 32, 14, 1, 47, 30, 48, + 61, 19, 34, 12, 3, 45, 28, 50, 2, 44, 29, 51, 60, 18, 35, 13, + 57, 23, 38, 8, 7, 41, 24, 54, 6, 40, 25, 55, 56, 22, 39, 9, + 4, 42, 27, 53, 58, 20, 37, 11, 59, 21, 36, 10, 5, 43, 26, 52, + 0, 23, 46, 57, 31, 8, 49, 38, 62, 41, 16, 7, 33, 54, 15, 24, + 63, 40, 17, 6, 32, 55, 14, 25, 1, 22, 47, 56, 30, 9, 48, 39, + 61, 42, 19, 4, 34, 53, 12, 27, 3, 20, 45, 58, 28, 11, 50, 37, + 2, 21, 44, 59, 29, 10, 51, 36, 60, 43, 18, 5, 35, 52, 13, 26, + 0, 42, 23, 61, 46, 4, 57, 19, 31, 53, 8, 34, 49, 27, 38, 12, + 62, 20, 41, 3, 16, 58, 7, 45, 33, 11, 54, 28, 15, 37, 24, 50, + 63, 21, 40, 2, 17, 59, 6, 44, 32, 10, 55, 29, 14, 36, 25, 51, + 1, 43, 22, 60, 47, 5, 56, 18, 30, 52, 9, 35, 48, 26, 39, 13, + 0, 21, 42, 63, 23, 2, 61, 40, 46, 59, 4, 17, 57, 44, 19, 6, + 31, 10, 53, 32, 8, 29, 34, 55, 49, 36, 27, 14, 38, 51, 12, 25, + 62, 43, 20, 1, 41, 60, 3, 22, 16, 5, 58, 47, 7, 18, 45, 56, + 33, 52, 11, 30, 54, 35, 28, 9, 15, 26, 37, 48, 24, 13, 50, 39, + 0, 43, 21, 62, 42, 1, 63, 20, 23, 60, 2, 41, 61, 22, 40, 3, + 46, 5, 59, 16, 4, 47, 17, 58, 57, 18, 44, 7, 19, 56, 6, 45, + 31, 52, 10, 33, 53, 30, 32, 11, 8, 35, 29, 54, 34, 9, 55, 28, + 49, 26, 36, 15, 27, 48, 14, 37, 38, 13, 51, 24, 12, 39, 25, 50, + 0, 52, 43, 31, 21, 33, 62, 10, 42, 30, 1, 53, 63, 11, 20, 32, + 23, 35, 60, 8, 2, 54, 41, 29, 61, 9, 22, 34, 40, 28, 3, 55, + 46, 26, 5, 49, 59, 15, 16, 36, 4, 48, 47, 27, 17, 37, 58, 14, + 57, 13, 18, 38, 44, 24, 7, 51, 19, 39, 56, 12, 6, 50, 45, 25, + 0, 26, 52, 46, 43, 49, 31, 5, 21, 15, 33, 59, 62, 36, 10, 16, + 42, 48, 30, 4, 1, 27, 53, 47, 63, 37, 11, 17, 20, 14, 32, 58, + 23, 13, 35, 57, 60, 38, 8, 18, 2, 24, 54, 44, 41, 51, 29, 7, + 61, 39, 9, 19, 22, 12, 34, 56, 40, 50, 28, 6, 3, 25, 55, 45, + 0, 13, 26, 23, 52, 57, 46, 35, 43, 38, 49, 60, 31, 18, 5, 8, + 21, 24, 15, 2, 33, 44, 59, 54, 62, 51, 36, 41, 10, 7, 16, 29, + 42, 39, 48, 61, 30, 19, 4, 9, 1, 12, 27, 22, 53, 56, 47, 34, + 63, 50, 37, 40, 11, 6, 17, 28, 20, 25, 14, 3, 32, 45, 58, 55, + 0, 39, 13, 42, 26, 61, 23, 48, 52, 19, 57, 30, 46, 9, 35, 4, + 43, 12, 38, 1, 49, 22, 60, 27, 31, 56, 18, 53, 5, 34, 8, 47, + 21, 50, 24, 63, 15, 40, 2, 37, 33, 6, 44, 11, 59, 28, 54, 17, + 62, 25, 51, 20, 36, 3, 41, 14, 10, 45, 7, 32, 16, 55, 29, 58, + 0, 50, 39, 21, 13, 63, 42, 24, 26, 40, 61, 15, 23, 37, 48, 2, + 52, 6, 19, 33, 57, 11, 30, 44, 46, 28, 9, 59, 35, 17, 4, 54, + 43, 25, 12, 62, 38, 20, 1, 51, 49, 3, 22, 36, 60, 14, 27, 41, + 31, 45, 56, 10, 18, 32, 53, 7, 5, 55, 34, 16, 8, 58, 47, 29, + 0, 25, 50, 43, 39, 62, 21, 12, 13, 20, 63, 38, 42, 51, 24, 1, + 26, 3, 40, 49, 61, 36, 15, 22, 23, 14, 37, 60, 48, 41, 2, 27, + 52, 45, 6, 31, 19, 10, 33, 56, 57, 32, 11, 18, 30, 7, 44, 53, + 46, 55, 28, 5, 9, 16, 59, 34, 35, 58, 17, 8, 4, 29, 54, 47, + 0, 45, 25, 52, 50, 31, 43, 6, 39, 10, 62, 19, 21, 56, 12, 33, + 13, 32, 20, 57, 63, 18, 38, 11, 42, 7, 51, 30, 24, 53, 1, 44, + 26, 55, 3, 46, 40, 5, 49, 28, 61, 16, 36, 9, 15, 34, 22, 59, + 23, 58, 14, 35, 37, 8, 60, 17, 48, 29, 41, 4, 2, 47, 27, 54, + 0, 55, 45, 26, 25, 46, 52, 3, 50, 5, 31, 40, 43, 28, 6, 49, + 39, 16, 10, 61, 62, 9, 19, 36, 21, 34, 56, 15, 12, 59, 33, 22, + 13, 58, 32, 23, 20, 35, 57, 14, 63, 8, 18, 37, 38, 17, 11, 60, + 42, 29, 7, 48, 51, 4, 30, 41, 24, 47, 53, 2, 1, 54, 44, 27, + 0, 58, 55, 13, 45, 23, 26, 32, 25, 35, 46, 20, 52, 14, 3, 57, + 50, 8, 5, 63, 31, 37, 40, 18, 43, 17, 28, 38, 6, 60, 49, 11, + 39, 29, 16, 42, 10, 48, 61, 7, 62, 4, 9, 51, 19, 41, 36, 30, + 21, 47, 34, 24, 56, 2, 15, 53, 12, 54, 59, 1, 33, 27, 22, 44, + 0, 29, 58, 39, 55, 42, 13, 16, 45, 48, 23, 10, 26, 7, 32, 61, + 25, 4, 35, 62, 46, 51, 20, 9, 52, 41, 14, 19, 3, 30, 57, 36, + 50, 47, 8, 21, 5, 24, 63, 34, 31, 2, 37, 56, 40, 53, 18, 15, + 43, 54, 17, 12, 28, 1, 38, 59, 6, 27, 60, 33, 49, 44, 11, 22, + 0, 47, 29, 50, 58, 21, 39, 8, 55, 24, 42, 5, 13, 34, 16, 63, + 45, 2, 48, 31, 23, 56, 10, 37, 26, 53, 7, 40, 32, 15, 61, 18, + 25, 54, 4, 43, 35, 12, 62, 17, 46, 1, 51, 28, 20, 59, 9, 38, + 52, 27, 41, 6, 14, 33, 19, 60, 3, 44, 30, 49, 57, 22, 36, 11, + 0, 54, 47, 25, 29, 43, 50, 4, 58, 12, 21, 35, 39, 17, 8, 62, + 55, 1, 24, 46, 42, 28, 5, 51, 13, 59, 34, 20, 16, 38, 63, 9, + 45, 27, 2, 52, 48, 6, 31, 41, 23, 33, 56, 14, 10, 60, 37, 19, + 26, 44, 53, 3, 7, 49, 40, 30, 32, 22, 15, 57, 61, 11, 18, 36, + 0, 27, 54, 45, 47, 52, 25, 2, 29, 6, 43, 48, 50, 41, 4, 31, + 58, 33, 12, 23, 21, 14, 35, 56, 39, 60, 17, 10, 8, 19, 62, 37, + 55, 44, 1, 26, 24, 3, 46, 53, 42, 49, 28, 7, 5, 30, 51, 40, + 13, 22, 59, 32, 34, 57, 20, 15, 16, 11, 38, 61, 63, 36, 9, 18, + 0, 44, 27, 55, 54, 26, 45, 1, 47, 3, 52, 24, 25, 53, 2, 46, + 29, 49, 6, 42, 43, 7, 48, 28, 50, 30, 41, 5, 4, 40, 31, 51, + 58, 22, 33, 13, 12, 32, 23, 59, 21, 57, 14, 34, 35, 15, 56, 20, + 39, 11, 60, 16, 17, 61, 10, 38, 8, 36, 19, 63, 62, 18, 37, 9, + 0, 22, 44, 58, 27, 13, 55, 33, 54, 32, 26, 12, 45, 59, 1, 23, + 47, 57, 3, 21, 52, 34, 24, 14, 25, 15, 53, 35, 2, 20, 46, 56, + 29, 11, 49, 39, 6, 16, 42, 60, 43, 61, 7, 17, 48, 38, 28, 10, + 50, 36, 30, 8, 41, 63, 5, 19, 4, 18, 40, 62, 31, 9, 51, 37, + 0, 11, 22, 29, 44, 39, 58, 49, 27, 16, 13, 6, 55, 60, 33, 42, + 54, 61, 32, 43, 26, 17, 12, 7, 45, 38, 59, 48, 1, 10, 23, 28, + 47, 36, 57, 50, 3, 8, 21, 30, 52, 63, 34, 41, 24, 19, 14, 5, + 25, 18, 15, 4, 53, 62, 35, 40, 2, 9, 20, 31, 46, 37, 56, 51, + 0, 36, 11, 47, 22, 50, 29, 57, 44, 8, 39, 3, 58, 30, 49, 21, + 27, 63, 16, 52, 13, 41, 6, 34, 55, 19, 60, 24, 33, 5, 42, 14, + 54, 18, 61, 25, 32, 4, 43, 15, 26, 62, 17, 53, 12, 40, 7, 35, + 45, 9, 38, 2, 59, 31, 48, 20, 1, 37, 10, 46, 23, 51, 28, 56, + 0, 18, 36, 54, 11, 25, 47, 61, 22, 4, 50, 32, 29, 15, 57, 43, + 44, 62, 8, 26, 39, 53, 3, 17, 58, 40, 30, 12, 49, 35, 21, 7, + 27, 9, 63, 45, 16, 2, 52, 38, 13, 31, 41, 59, 6, 20, 34, 48, + 55, 37, 19, 1, 60, 46, 24, 10, 33, 51, 5, 23, 42, 56, 14, 28, + 0, 9, 18, 27, 36, 45, 54, 63, 11, 2, 25, 16, 47, 38, 61, 52, + 22, 31, 4, 13, 50, 59, 32, 41, 29, 20, 15, 6, 57, 48, 43, 34, + 44, 37, 62, 55, 8, 1, 26, 19, 39, 46, 53, 60, 3, 10, 17, 24, + 58, 51, 40, 33, 30, 23, 12, 5, 49, 56, 35, 42, 21, 28, 7, 14, + 0, 37, 9, 44, 18, 55, 27, 62, 36, 1, 45, 8, 54, 19, 63, 26, + 11, 46, 2, 39, 25, 60, 16, 53, 47, 10, 38, 3, 61, 24, 52, 17, + 22, 51, 31, 58, 4, 33, 13, 40, 50, 23, 59, 30, 32, 5, 41, 12, + 29, 56, 20, 49, 15, 42, 6, 35, 57, 28, 48, 21, 43, 14, 34, 7, + 0, 51, 37, 22, 9, 58, 44, 31, 18, 33, 55, 4, 27, 40, 62, 13, + 36, 23, 1, 50, 45, 30, 8, 59, 54, 5, 19, 32, 63, 12, 26, 41, + 11, 56, 46, 29, 2, 49, 39, 20, 25, 42, 60, 15, 16, 35, 53, 6, + 47, 28, 10, 57, 38, 21, 3, 48, 61, 14, 24, 43, 52, 7, 17, 34, + 0, 56, 51, 11, 37, 29, 22, 46, 9, 49, 58, 2, 44, 20, 31, 39, + 18, 42, 33, 25, 55, 15, 4, 60, 27, 35, 40, 16, 62, 6, 13, 53, + 36, 28, 23, 47, 1, 57, 50, 10, 45, 21, 30, 38, 8, 48, 59, 3, + 54, 14, 5, 61, 19, 43, 32, 24, 63, 7, 12, 52, 26, 34, 41, 17, + 0, 28, 56, 36, 51, 47, 11, 23, 37, 57, 29, 1, 22, 10, 46, 50, + 9, 21, 49, 45, 58, 38, 2, 30, 44, 48, 20, 8, 31, 3, 39, 59, + 18, 14, 42, 54, 33, 61, 25, 5, 55, 43, 15, 19, 4, 24, 60, 32, + 27, 7, 35, 63, 40, 52, 16, 12, 62, 34, 6, 26, 13, 17, 53, 41, + 0, 14, 28, 18, 56, 54, 36, 42, 51, 61, 47, 33, 11, 5, 23, 25, + 37, 43, 57, 55, 29, 19, 1, 15, 22, 24, 10, 4, 46, 32, 50, 60, + 9, 7, 21, 27, 49, 63, 45, 35, 58, 52, 38, 40, 2, 12, 30, 16, + 44, 34, 48, 62, 20, 26, 8, 6, 31, 17, 3, 13, 39, 41, 59, 53, + 0, 7, 14, 9, 28, 27, 18, 21, 56, 63, 54, 49, 36, 35, 42, 45, + 51, 52, 61, 58, 47, 40, 33, 38, 11, 12, 5, 2, 23, 16, 25, 30, + 37, 34, 43, 44, 57, 62, 55, 48, 29, 26, 19, 20, 1, 6, 15, 8, + 22, 17, 24, 31, 10, 13, 4, 3, 46, 41, 32, 39, 50, 53, 60, 59, + 0, 34, 7, 37, 14, 44, 9, 43, 28, 62, 27, 57, 18, 48, 21, 55, + 56, 26, 63, 29, 54, 20, 49, 19, 36, 6, 35, 1, 42, 8, 45, 15, + 51, 17, 52, 22, 61, 31, 58, 24, 47, 13, 40, 10, 33, 3, 38, 4, + 11, 41, 12, 46, 5, 39, 2, 32, 23, 53, 16, 50, 25, 59, 30, 60, + 0, 17, 34, 51, 7, 22, 37, 52, 14, 31, 44, 61, 9, 24, 43, 58, + 28, 13, 62, 47, 27, 10, 57, 40, 18, 3, 48, 33, 21, 4, 55, 38, + 56, 41, 26, 11, 63, 46, 29, 12, 54, 39, 20, 5, 49, 32, 19, 2, + 36, 53, 6, 23, 35, 50, 1, 16, 42, 59, 8, 25, 45, 60, 15, 30, + 0, 41, 17, 56, 34, 11, 51, 26, 7, 46, 22, 63, 37, 12, 52, 29, + 14, 39, 31, 54, 44, 5, 61, 20, 9, 32, 24, 49, 43, 2, 58, 19, + 28, 53, 13, 36, 62, 23, 47, 6, 27, 50, 10, 35, 57, 16, 40, 1, + 18, 59, 3, 42, 48, 25, 33, 8, 21, 60, 4, 45, 55, 30, 38, 15, + 0, 53, 41, 28, 17, 36, 56, 13, 34, 23, 11, 62, 51, 6, 26, 47, + 7, 50, 46, 27, 22, 35, 63, 10, 37, 16, 12, 57, 52, 1, 29, 40, + 14, 59, 39, 18, 31, 42, 54, 3, 44, 25, 5, 48, 61, 8, 20, 33, + 9, 60, 32, 21, 24, 45, 49, 4, 43, 30, 2, 55, 58, 15, 19, 38, + 0, 59, 53, 14, 41, 18, 28, 39, 17, 42, 36, 31, 56, 3, 13, 54, + 34, 25, 23, 44, 11, 48, 62, 5, 51, 8, 6, 61, 26, 33, 47, 20, + 7, 60, 50, 9, 46, 21, 27, 32, 22, 45, 35, 24, 63, 4, 10, 49, + 37, 30, 16, 43, 12, 55, 57, 2, 52, 15, 1, 58, 29, 38, 40, 19, + 0, 60, 59, 7, 53, 9, 14, 50, 41, 21, 18, 46, 28, 32, 39, 27, + 17, 45, 42, 22, 36, 24, 31, 35, 56, 4, 3, 63, 13, 49, 54, 10, + 34, 30, 25, 37, 23, 43, 44, 16, 11, 55, 48, 12, 62, 2, 5, 57, + 51, 15, 8, 52, 6, 58, 61, 1, 26, 38, 33, 29, 47, 19, 20, 40, + 0, 30, 60, 34, 59, 37, 7, 25, 53, 43, 9, 23, 14, 16, 50, 44, + 41, 55, 21, 11, 18, 12, 46, 48, 28, 2, 32, 62, 39, 57, 27, 5, + 17, 15, 45, 51, 42, 52, 22, 8, 36, 58, 24, 6, 31, 1, 35, 61, + 56, 38, 4, 26, 3, 29, 63, 33, 13, 19, 49, 47, 54, 40, 10, 20, + 0, 15, 30, 17, 60, 51, 34, 45, 59, 52, 37, 42, 7, 8, 25, 22, + 53, 58, 43, 36, 9, 6, 23, 24, 14, 1, 16, 31, 50, 61, 44, 35, + 41, 38, 55, 56, 21, 26, 11, 4, 18, 29, 12, 3, 46, 33, 48, 63, + 28, 19, 2, 13, 32, 47, 62, 49, 39, 40, 57, 54, 27, 20, 5, 10, + 0, 38, 15, 41, 30, 56, 17, 55, 60, 26, 51, 21, 34, 4, 45, 11, + 59, 29, 52, 18, 37, 3, 42, 12, 7, 33, 8, 46, 25, 63, 22, 48, + 53, 19, 58, 28, 43, 13, 36, 2, 9, 47, 6, 32, 23, 49, 24, 62, + 14, 40, 1, 39, 16, 54, 31, 57, 50, 20, 61, 27, 44, 10, 35, 5, + 0, 19, 38, 53, 15, 28, 41, 58, 30, 13, 56, 43, 17, 2, 55, 36, + 60, 47, 26, 9, 51, 32, 21, 6, 34, 49, 4, 23, 45, 62, 11, 24, + 59, 40, 29, 14, 52, 39, 18, 1, 37, 54, 3, 16, 42, 57, 12, 31, + 7, 20, 33, 50, 8, 27, 46, 61, 25, 10, 63, 44, 22, 5, 48, 35, + 0, 40, 19, 59, 38, 14, 53, 29, 15, 39, 28, 52, 41, 1, 58, 18, + 30, 54, 13, 37, 56, 16, 43, 3, 17, 57, 2, 42, 55, 31, 36, 12, + 60, 20, 47, 7, 26, 50, 9, 33, 51, 27, 32, 8, 21, 61, 6, 46, + 34, 10, 49, 25, 4, 44, 23, 63, 45, 5, 62, 22, 11, 35, 24, 48, + 0, 20, 40, 60, 19, 7, 59, 47, 38, 50, 14, 26, 53, 33, 29, 9, + 15, 27, 39, 51, 28, 8, 52, 32, 41, 61, 1, 21, 58, 46, 18, 6, + 30, 10, 54, 34, 13, 25, 37, 49, 56, 44, 16, 4, 43, 63, 3, 23, + 17, 5, 57, 45, 2, 22, 42, 62, 55, 35, 31, 11, 36, 48, 12, 24, + 0, 10, 20, 30, 40, 34, 60, 54, 19, 25, 7, 13, 59, 49, 47, 37, + 38, 44, 50, 56, 14, 4, 26, 16, 53, 63, 33, 43, 29, 23, 9, 3, + 15, 5, 27, 17, 39, 45, 51, 57, 28, 22, 8, 2, 52, 62, 32, 42, + 41, 35, 61, 55, 1, 11, 21, 31, 58, 48, 46, 36, 18, 24, 6, 12, + 0, 5, 10, 15, 20, 17, 30, 27, 40, 45, 34, 39, 60, 57, 54, 51, + 19, 22, 25, 28, 7, 2, 13, 8, 59, 62, 49, 52, 47, 42, 37, 32, + 38, 35, 44, 41, 50, 55, 56, 61, 14, 11, 4, 1, 26, 31, 16, 21, + 53, 48, 63, 58, 33, 36, 43, 46, 29, 24, 23, 18, 9, 12, 3, 6, + 0, 35, 5, 38, 10, 41, 15, 44, 20, 55, 17, 50, 30, 61, 27, 56, + 40, 11, 45, 14, 34, 1, 39, 4, 60, 31, 57, 26, 54, 21, 51, 16, + 19, 48, 22, 53, 25, 58, 28, 63, 7, 36, 2, 33, 13, 46, 8, 43, + 59, 24, 62, 29, 49, 18, 52, 23, 47, 12, 42, 9, 37, 6, 32, 3, + 0, 48, 35, 19, 5, 53, 38, 22, 10, 58, 41, 25, 15, 63, 44, 28, + 20, 36, 55, 7, 17, 33, 50, 2, 30, 46, 61, 13, 27, 43, 56, 8, + 40, 24, 11, 59, 45, 29, 14, 62, 34, 18, 1, 49, 39, 23, 4, 52, + 60, 12, 31, 47, 57, 9, 26, 42, 54, 6, 21, 37, 51, 3, 16, 32, + 0, 24, 48, 40, 35, 59, 19, 11, 5, 29, 53, 45, 38, 62, 22, 14, + 10, 18, 58, 34, 41, 49, 25, 1, 15, 23, 63, 39, 44, 52, 28, 4, + 20, 12, 36, 60, 55, 47, 7, 31, 17, 9, 33, 57, 50, 42, 2, 26, + 30, 6, 46, 54, 61, 37, 13, 21, 27, 3, 43, 51, 56, 32, 8, 16, + 0, 12, 24, 20, 48, 60, 40, 36, 35, 47, 59, 55, 19, 31, 11, 7, + 5, 9, 29, 17, 53, 57, 45, 33, 38, 42, 62, 50, 22, 26, 14, 2, + 10, 6, 18, 30, 58, 54, 34, 46, 41, 37, 49, 61, 25, 21, 1, 13, + 15, 3, 23, 27, 63, 51, 39, 43, 44, 32, 52, 56, 28, 16, 4, 8, + 0, 6, 12, 10, 24, 30, 20, 18, 48, 54, 60, 58, 40, 46, 36, 34, + 35, 37, 47, 41, 59, 61, 55, 49, 19, 21, 31, 25, 11, 13, 7, 1, + 5, 3, 9, 15, 29, 27, 17, 23, 53, 51, 57, 63, 45, 43, 33, 39, + 38, 32, 42, 44, 62, 56, 50, 52, 22, 16, 26, 28, 14, 8, 2, 4, + 0, 3, 6, 5, 12, 15, 10, 9, 24, 27, 30, 29, 20, 23, 18, 17, + 48, 51, 54, 53, 60, 63, 58, 57, 40, 43, 46, 45, 36, 39, 34, 33, + 35, 32, 37, 38, 47, 44, 41, 42, 59, 56, 61, 62, 55, 52, 49, 50, + 19, 16, 21, 22, 31, 28, 25, 26, 11, 8, 13, 14, 7, 4, 1, 2, + 0, 32, 3, 35, 6, 38, 5, 37, 12, 44, 15, 47, 10, 42, 9, 41, + 24, 56, 27, 59, 30, 62, 29, 61, 20, 52, 23, 55, 18, 50, 17, 49, + 48, 16, 51, 19, 54, 22, 53, 21, 60, 28, 63, 31, 58, 26, 57, 25, + 40, 8, 43, 11, 46, 14, 45, 13, 36, 4, 39, 7, 34, 2, 33, 1, + 0, 16, 32, 48, 3, 19, 35, 51, 6, 22, 38, 54, 5, 21, 37, 53, + 12, 28, 44, 60, 15, 31, 47, 63, 10, 26, 42, 58, 9, 25, 41, 57, + 24, 8, 56, 40, 27, 11, 59, 43, 30, 14, 62, 46, 29, 13, 61, 45, + 20, 4, 52, 36, 23, 7, 55, 39, 18, 2, 50, 34, 17, 1, 49, 33, + 0, 8, 16, 24, 32, 40, 48, 56, 3, 11, 19, 27, 35, 43, 51, 59, + 6, 14, 22, 30, 38, 46, 54, 62, 5, 13, 21, 29, 37, 45, 53, 61, + 12, 4, 28, 20, 44, 36, 60, 52, 15, 7, 31, 23, 47, 39, 63, 55, + 10, 2, 26, 18, 42, 34, 58, 50, 9, 1, 25, 17, 41, 33, 57, 49, + 0, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, + 3, 7, 11, 15, 19, 23, 27, 31, 35, 39, 43, 47, 51, 55, 59, 63, + 6, 2, 14, 10, 22, 18, 30, 26, 38, 34, 46, 42, 54, 50, 62, 58, + 5, 1, 13, 9, 21, 17, 29, 25, 37, 33, 45, 41, 53, 49, 61, 57, + 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, + 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56, 58, 60, 62, + 3, 1, 7, 5, 11, 9, 15, 13, 19, 17, 23, 21, 27, 25, 31, 29, + 35, 33, 39, 37, 43, 41, 47, 45, 51, 49, 55, 53, 59, 57, 63, 61 +}; + +const qracode qra_13_64_64_irr_e = { + qra_K, + qra_N, + qra_m, + qra_M, + qra_a, + qra_NC, + qra_V, + qra_C, + qra_NMSG, + qra_MAXVDEG, + qra_MAXCDEG, + QRATYPE_CRCPUNCTURED, + qra_R, + CODE_NAME, + qra_acc_input_idx, + qra_acc_input_wlog, + qra_log, + qra_exp, + qra_msgw, + qra_vdeg, + qra_cdeg, + qra_v2cmidx, + qra_c2vmidx, + qra_pmat +}; + +#undef qra_K +#undef qra_N +#undef qra_m +#undef qra_M +#undef qra_a +#undef qra_NC +#undef qra_V +#undef qra_C +#undef qra_NMSG +#undef qra_MAXVDEG +#undef qra_MAXCDEG +#undef qra_R +#undef CODE_NAME \ No newline at end of file diff --git a/wsjtx_lib/lib/qra/qracodes/qra13_64_64_irr_e.h b/wsjtx_lib/lib/qra/qracodes/qra13_64_64_irr_e.h new file mode 100644 index 0000000..d24421d --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/qra13_64_64_irr_e.h @@ -0,0 +1,39 @@ +// qra13_64_64_irr_e.h +// Code tables and defines for Q-ary RA code (13,64) over GF(64) +// Code Name: qra13_64_64_irr_e +// (13,64) RA Code over GF(64) RF=[3x4 4x4 6x1 3x2 5x1 7x1]/18 + +// (c) 2016 - Nico Palermo - IV3NWV - Microtelecom Srl, Italy + +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#ifndef _qra13_64_64_irr_e_h +#define _qra13_64_64_irr_e_h + +#include "qracodes.h" + +#ifdef __cplusplus +extern "C" { +#endif + +extern const qracode qra_13_64_64_irr_e; + +#ifdef __cplusplus +} +#endif + +#endif // _qra13_64_64_irr_e_h diff --git a/wsjtx_lib/lib/qra/qracodes/qracodes.c b/wsjtx_lib/lib/qra/qracodes/qracodes.c new file mode 100644 index 0000000..748a9c9 --- /dev/null +++ b/wsjtx_lib/lib/qra/qracodes/qracodes.c @@ -0,0 +1,474 @@ +// qracodes.c +// Q-ary RA codes encoding/decoding functions +// +// (c) 2016 - Nico Palermo, IV3NWV - Microtelecom Srl, Italy +// ------------------------------------------------------------------------------ +// This file is part of the qracodes project, a Forward Error Control +// encoding/decoding package based on Q-ary RA (Repeat and Accumulate) LDPC codes. +// +// qracodes is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// qracodes is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with qracodes source distribution. +// If not, see . + +#include +#include + +#include "npfwht.h" +#include "pdmath.h" + +#include "qracodes.h" + +int qra_encode(const qracode *pcode, int *y, const int *x) +{ + int k,j,kk,jj; + int t, chk = 0; + + const int K = pcode->K; + const int M = pcode->M; + const int NC= pcode->NC; + const int a = pcode->a; + const int *acc_input_idx = pcode->acc_input_idx; + const int *acc_input_wlog = pcode->acc_input_wlog; + const int *gflog = pcode->gflog; + const int *gfexp = pcode->gfexp; + + // copy the systematic symbols to destination + memcpy(y,x,K*sizeof(int)); + + y = y+K; // point to check symbols + + // compute the code check symbols as a weighted accumulation of a permutated + // sequence of the (repeated) systematic input symbols: + // chk(k+1) = x(idx(k))*alfa^(logw(k)) + chk(k) + // (all operations performed over GF(M)) + + if (a==1) { // grouping factor = 1 + for (k=0;k 1 + for (k=0;k80.f) // avoid floating point exp() overflows + v=80.f; + + src[nitems] = (float)exp(v); + } +} + + +float qra_mfskbesselmetric(float *pix, const float *rsq, const int m, const int N, float EsNoMetric) +{ + // Computes the codeword symbols intrinsic probabilities + // given the square of the received input amplitudes. + + // The input vector rqs must be a linear array of size M*N, where M=2^m, + // containing the squared amplitudes (rp*rp+rq*rq) of the input samples + + // First symbol amplitudes should be stored in the first M positions, + // second symbol amplitudes stored at positions [M ... 2*M-1], and so on. + + // Output vector is the intrinsic symbol metric (the probability distribution) + // assuming that symbols are transmitted using a M-FSK modulation + // and incoherent demodulation. + + // As the input Es/No is generally unknown (as it cannot be exstimated accurately + // when the codeword length is few tens symbols) but an exact metric requires it + // we simply fix it to a predefined EsNoMetric value so that the metric is what + // expected at that specific value. + // The metric computed in this way is optimal only at this predefined Es/No value, + // nevertheless it is usually better than a generic parameter-free metric which + // makes no assumptions on the input Es/No. + + // returns the estimated noise standard deviation + + int k; + float rsum = 0.f; + float sigmaest, cmetric; + + const int M = 1<M; + const int qra_m = pcode->m; + const int qra_V = pcode->V; + const int qra_MAXVDEG = pcode->MAXVDEG; + const int *qra_vdeg = pcode->vdeg; + const int qra_C = pcode->C; + const int qra_MAXCDEG = pcode->MAXCDEG; + const int *qra_cdeg = pcode->cdeg; + const int *qra_v2cmidx = pcode->v2cmidx; + const int *qra_c2vmidx = pcode->c2vmidx; + const int *qra_pmat = pcode->gfpmat; + const int *qra_msgw = pcode->msgw; + +// float msgout[qra_M]; // buffer to store temporary results + float msgout[QRACODE_MAX_M]; // we use a fixed size in order to avoid mallocs + + float totex; // total extrinsic information + int nit; // current iteration + int nv; // current variable + int nc; // current check + int k,kk; // loop indexes + + int ndeg; // current node degree + int msgbase; // current offset in the table of msg indexes + int imsg; // current message index + int wmsg; // current message weight + + int rc = -1; // rc>=0 extrinsic converged to 1 at iteration rc (rc=0..maxiter-1) + // rc=-1 no convergence in the given number of iterations + // rc=-2 error in the code tables (code checks degrees must be >1) + // rc=-3 M is larger than QRACODE_MAX_M + + + + if (qra_M>QRACODE_MAX_M) + return -3; + + // message initialization ------------------------------------------------------- + + // init c->v variable intrinsic msgs + pd_init(C2VMSG(0),pix,qra_M*qra_V); + + // init the v->c messages directed to code factors (k=1..ndeg) with the intrinsic info + for (nv=0;nvc + for (k=1;kv step ----------------------------------------------------- + // Computes messages from code checks to code variables. + // As the first qra_V checks are associated with intrinsic information + // (the code tables have been constructed in this way) + // we need to do this step only for code checks in the range [qra_V..qra_C) + + // The convolutions of probability distributions over the alphabet of a finite field GF(qra_M) + // are performed with a fast convolution algorithm over the given field. + // + // I.e. given the code check x1+x2+x3 = 0 (with x1,x2,x3 in GF(2^m)) + // and given Prob(x2) and Prob(x3), we have that: + // Prob(x1=X1) = Prob((x2+x3)=X1) = sum((Prob(x2=X2)*Prob(x3=(X1+X2))) for all the X2s in the field + // This translates to Prob(x1) = IWHT(WHT(Prob(x2))*WHT(Prob(x3))) + // where WHT and IWHT are the direct and inverse Walsh-Hadamard transforms of the argument. + // Note that the WHT and the IWHF differs only by a multiplicative coefficent and since in this step + // we don't need that the output distribution is normalized we use the relationship + // Prob(x1) =(proportional to) WH(WH(Prob(x2))*WH(Prob(x3))) + + // In general given the check code x1+x2+x3+..+xm = 0 + // the output distribution of a variable given the distributions of the other m-1 variables + // is the inverse WHT of the product of the WHTs of the distribution of the other m-1 variables + // The complexity of this algorithm scales with M*log2(M) instead of the M^2 complexity of + // the brute force approach (M=size of the alphabet) + + for (nc=qra_V;nc1) + return -2; // bad code tables + + msgbase = nc*qra_MAXCDEG; // base to msg index row for the current node + + // transforms inputs in the Walsh-Hadamard "frequency" domain + // v->c -> fwht(v->c) + for (k=0;kv = prod(fwht(v->c)) + // TODO: we assume that checks degrees are not larger than three but + // if they are larger the products can be computed more efficiently + for (kk=0;kkc steps when multipling + // small fp numbers + msgout[0]+=1E-7f; // TODO: define the bias accordingly to the field size + + np_fwht(qra_m,msgout,msgout); + + // inverse weight and output + imsg = qra_c2vmidx[msgbase+k]; // current output msg index + wmsg = qra_msgw[imsg]; // current msg weight + + if (wmsg==0) + pd_init(C2VMSG(imsg),msgout,qra_M); + else + // output p(alfa^(-w)*x) + pd_bwdperm(C2VMSG(imsg),msgout, MSGPERM(wmsg), qra_M); + + } // for (k=0;kc step ----------------------------------------------------- + for (nv=0;nvc msg = prod(c->v) + // TODO: factor factors to reduce the number of computations for high degree nodes + for (kk=0;kkc are null + // normalize output to a probability distribution + if (pd_norm(msgout,qra_m)<=0) { + // dump msgin; + printf("warning: v->c pd with invalid norm. nit=%d nv=%d k=%d\n",nit,nv,k); + for (kk=0;kk(1.*(qra_V)-0.01)) { + // the total maximum extrinsic information of each symbol in the codeword + // is very close to one. This means that we have reached the (1,1) point in the + // code EXIT chart(s) and we have successfully decoded the input. + rc = nit; + break; // remove the break to evaluate the decoder speed performance as a function of the max iterations number) + } + + } // for (nit=0;nitM; + const int qra_m = pcode->m; + const int qra_K = pcode->K; + + int k; + + for (k=0;k. + +#ifndef _qracodes_h_ +#define _qracodes_h_ + +// type of codes +#define QRATYPE_NORMAL 0x00 // normal code +#define QRATYPE_CRC 0x01 // code with crc - last information symbol is a CRC +#define QRATYPE_CRCPUNCTURED 0x02 // the CRC symbol is punctured (not sent along the channel) + + +typedef struct { + // code parameters + const int K; // number of information symbols + const int N; // codeword length in symbols + const int m; // bits/symbol + const int M; // Symbol alphabet cardinality (2^m) + const int a; // code grouping factor + const int NC; // number of check symbols (N-K) + const int V; // number of variables in the code graph (N) + const int C; // number of factors in the code graph (N +(N-K)+1) + const int NMSG; // number of msgs in the code graph + const int MAXVDEG; // maximum variable degree + const int MAXCDEG; // maximum factor degree + const int type; // see QRATYPE_xx defines + const float R; // code rate (K/N) + const char name[64]; // code name + // tables used by the encoder + const int *acc_input_idx; + const int *acc_input_wlog; + const int *gflog; + const int *gfexp; + // tables used by the decoder ------------------------- + const int *msgw; + const int *vdeg; + const int *cdeg; + const int *v2cmidx; + const int *c2vmidx; + const int *gfpmat; +} qracode; +// Uncomment the header file of the code which needs to be tested + +//#include "qra12_63_64_irr_b.h" // irregular code (12,63) over GF(64) +//#include "qra13_64_64_irr_e.h" // irregular code with good performance and best UER protection at AP56 +//#include "qra13_64_64_reg_a.h" // regular code with good UER but perf. inferior to that of code qra12_63_64_irr_b + +#ifdef __cplusplus +extern "C" { +#endif + +int qra_encode(const qracode *pcode, int *y, const int *x); +float qra_mfskbesselmetric(float *pix, const float *rsq, const int m, const int N, float EsNoMetric); +int qra_extrinsic(const qracode *pcode, float *pex, const float *pix, int maxiter,float *qra_v2cmsg,float *qra_c2vmsg); +void qra_mapdecode(const qracode *pcode, int *xdec, float *pex, const float *pix); + +#ifdef __cplusplus +} +#endif + +#endif // _qracodes_h_ diff --git a/wsjtx_lib/lib/qra64code.f90 b/wsjtx_lib/lib/qra64code.f90 new file mode 100644 index 0000000..188b5f0 --- /dev/null +++ b/wsjtx_lib/lib/qra64code.f90 @@ -0,0 +1,64 @@ +program QRA64code + +! Provides examples of message packing, bit and symbol ordering, +! QRA (63,12) encoding, and other necessary details of the QRA64 +! protocol. + + use packjt + character*22 msg,msg0,msg1,decoded,cok*3,msgtype*10 + integer dgen(12),sent(63) + integer icos7(0:6) + data icos7/2,5,6,0,4,1,3/ !Defines a 7x7 Costas array + + include 'testmsg.f90' + + nargs=iargc() + if(nargs.lt.1) then + print*,'Usage: qra64code "message"' + print*,' qra64code -t' + go to 999 + endif + + call getarg(1,msg) !Get message from command line + nmsg=1 + if(msg(1:2).eq."-t") nmsg=NTEST + + write(*,1010) +1010 format(" Message Decoded Err? Type"/74("-")) + + do imsg=1,nmsg + if(nmsg.gt.1) msg=testmsg(imsg) + call fmtmsg(msg,iz) !To upper, collapse mult blanks + msg0=msg !Input message + call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report + msg1=msg !Message without "OOO" + call packmsg(msg1,dgen,itype) !Pack message into 12 six-bit bytes + msgtype="" + if(itype.eq.1) msgtype="Std Msg" + if(itype.eq.2) msgtype="Type 1 pfx" + if(itype.eq.3) msgtype="Type 1 sfx" + if(itype.eq.4) msgtype="Type 2 pfx" + if(itype.eq.5) msgtype="Type 2 sfx" + if(itype.eq.6) msgtype="Free text" + + call qra64_enc(dgen,sent) !Encode using QRA64 + + call unpackmsg(dgen,decoded) !Unpack the user message + call fmtmsg(decoded,iz) + ii=imsg + write(*,1020) ii,msg0,decoded,itype,msgtype +1020 format(i4,1x,a22,2x,a22,4x,i3,": ",a13) + enddo + + if(nmsg.eq.1) then + write(*,1030) dgen +1030 format(/'Packed message, 6-bit symbols ',12i3) !Display packed symbols + + write(*,1040) sent +1040 format(/'Information-carrying channel symbols'/(i5,29i3)) + + write(*,1050) 10*icos7,sent(1:32),10*icos7,sent(33:63),10*icos7 +1050 format(/'Channel symbols including sync'/(i5,29i3)) + endif + +999 end program QRA64code diff --git a/wsjtx_lib/lib/qratest.f90 b/wsjtx_lib/lib/qratest.f90 new file mode 100644 index 0000000..8e46c80 --- /dev/null +++ b/wsjtx_lib/lib/qratest.f90 @@ -0,0 +1,54 @@ +program qratest + + parameter (NMAX=60*12000) + real dd(NMAX) + character arg*8,mycall*12,hiscall*12,hisgrid*6,decoded*22 + character c*1 + logical loop + + nargs=iargc() + if(nargs.lt.1 .or. nargs.gt.4) then + print*,'Usage: qratest nfile [sync f0 fTol]' + go to 999 + endif + call getarg(1,arg) + read(arg,*) nfile + loop=arg(1:1).eq.'+' + minsync0=-1 + nfqso0=-1 + ntol0=-1 + if(nargs.gt.1) then + call getarg(2,arg) + read(arg,*) minsync0 + call getarg(3,arg) + read(arg,*) nfqso0 + call getarg(4,arg) + read(arg,*) ntol0 + endif + ndepth=3 + nft=99 + + open(60,file='qra64_data.bin',access='stream') + + do ifile=1,999 + read(60,end=999) dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & + mycall,hiscall,hisgrid + if(ifile.lt.nfile) cycle + + if(minsync0.ne.-1) minsync=minsync0 + if(nfqso0.ne.-1) nfqso=nfqso0 + if(ntol0.ne.-1) ntol=ntol0 + + call qra64a(dd,npts,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & + mycall,hiscall,hisgrid,sync,nsnr,dtx,nfreq,decoded,nft) + c='a' + if(mode64.eq.2) c='b' + if(mode64.eq.4) c='c' + if(mode64.eq.8) c='d' + if(mode64.eq.16) c='e' + write(*,1000) ifile,c,nutc,nsnr,dtx,nfreq,decoded,nft-100,sync-3.4 +1000 format(i4,1x,a1,1x,i4.4,i4,f6.2,i5,1x,a22,i3,f6.2) + if(ifile.eq.nfile .and. (.not.loop)) exit + enddo + +999 end program qratest diff --git a/wsjtx_lib/lib/qso50/g0 b/wsjtx_lib/lib/qso50/g0 new file mode 100644 index 0000000..a19d872 --- /dev/null +++ b/wsjtx_lib/lib/qso50/g0 @@ -0,0 +1,8 @@ +gfortran -o twq -Wall -Wno-conversion -fbounds-check twq.f90 \ + ../packjt.f90 wqenc.f90 wqdec.f90 packprop.f90 \ + packname.f90 packtext2.f90 unpackprop.f90 unpackname.f90 \ + unpacktext2.f90 unpackpfx.f90 pack50.f90 unpack50.f90 \ + ../hash.f90 ../deg2grid.f90 ../grid2deg.f90 \ + ../fix_contest_msg.f90 ../to_contest_msg.f90 \ + ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 ../wsprd/nhash.c + \ No newline at end of file diff --git a/wsjtx_lib/lib/qso50/pack50.f90 b/wsjtx_lib/lib/qso50/pack50.f90 new file mode 100644 index 0000000..29f6202 --- /dev/null +++ b/wsjtx_lib/lib/qso50/pack50.f90 @@ -0,0 +1,26 @@ +subroutine pack50(n1,n2,dat) + + integer*1 dat(11),i1 + + i1=iand(ishft(n1,-20),255) !8 bits + dat(1)=i1 + i1=iand(ishft(n1,-12),255) !8 bits + dat(2)=i1 + i1=iand(ishft(n1, -4),255) !8 bits + dat(3)=i1 + i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits + dat(4)=i1 + i1=iand(ishft(n2,-10),255) !8 bits + dat(5)=i1 + i1=iand(ishft(n2, -2),255) !8 bits + dat(6)=i1 + i1=64*iand(n2,3) !2 bits + dat(7)=i1 + dat(8)=0 + dat(9)=0 + dat(10)=0 + dat(11)=0 + + return +end subroutine pack50 + diff --git a/wsjtx_lib/lib/qso50/packname.f90 b/wsjtx_lib/lib/qso50/packname.f90 new file mode 100644 index 0000000..bd17078 --- /dev/null +++ b/wsjtx_lib/lib/qso50/packname.f90 @@ -0,0 +1,23 @@ +subroutine packname(name,len,n1,n2) + + character*9 name + real*8 dn + + dn=0 + do i=1,len + n=ichar(name(i:i)) + if(n.ge.97 .and. n.le.122) n=n-32 + dn=27*dn + n-64 + enddo + if(len.lt.9) then + do i=len+1,9 + dn=27*dn + enddo + endif + + n2=mod(dn,32768.d0) + dn=dn/32768.d0 + n1=dn + + return +end subroutine packname diff --git a/wsjtx_lib/lib/qso50/packprop.f90 b/wsjtx_lib/lib/qso50/packprop.f90 new file mode 100644 index 0000000..68f488e --- /dev/null +++ b/wsjtx_lib/lib/qso50/packprop.f90 @@ -0,0 +1,36 @@ +subroutine packprop(k,muf,ccur,cxp,n1) + +! Pack propagation indicators into a 21-bit number. + +! k k-index, 0-9; 10="N/A" +! muf muf, 2-60 MHz; 0=N/A, 1="none", 61=">60 MHz" +! ccur up to two current events, each indicated by single +! or double letter. +! cxp zero or one expected event, indicated by single or +! double letter + + character ccur*4,cxp*2 + + j=ichar(ccur(1:1))-64 + if(j.lt.0) j=0 + n1=j + do i=2,4 + if(ccur(i:i).eq.' ') go to 10 + if(ccur(i:i).eq.ccur(i-1:i-1)) then + n1=n1+26 + else + j=ichar(ccur(i:i))-64 + if(j.lt.0) j=0 + n1=53*n1 + j + endif + enddo + +10 j=ichar(cxp(1:1))-64 + if(j.lt.0) j=0 + if(cxp(2:2).eq.cxp(1:1)) j=j+26 + n1=53*n1 + j + n1=11*n1 + k + n1=62*n1 + muf + + return +end subroutine packprop diff --git a/wsjtx_lib/lib/qso50/packtext2.f90 b/wsjtx_lib/lib/qso50/packtext2.f90 new file mode 100644 index 0000000..46fd577 --- /dev/null +++ b/wsjtx_lib/lib/qso50/packtext2.f90 @@ -0,0 +1,22 @@ +subroutine packtext2(msg,n1,ng) + + character*8 msg + real*8 dn + character*41 c + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +./?'/ + + dn=0. + do i=1,8 + do j=1,41 + if(msg(i:i).eq.c(j:j)) go to 10 + enddo + j=37 +10 j=j-1 !Codes should start at zero + dn=41.d0*dn + j + enddo + + ng=mod(dn,32768.d0) + n1=(dn-ng)/32768.d0 + + return +end subroutine packtext2 diff --git a/wsjtx_lib/lib/qso50/twq.f90 b/wsjtx_lib/lib/qso50/twq.f90 new file mode 100644 index 0000000..f13d001 --- /dev/null +++ b/wsjtx_lib/lib/qso50/twq.f90 @@ -0,0 +1,18 @@ +program twq + + character*22 msg0,msg + integer*1 data0(11) + + open(10,file='wqmsg.txt',status='old') + write(*,1000) +1000 format(4x,'Encoded message',9x,'Decoded as',12x,'itype'/55('-')) + + do line=1,9999 + read(10,*,end=999) msg0 + call wqenc(msg0,itype,data0) + call wqdec(data0,msg,ntype) + write(*,1100) line,msg0,msg,ntype +1100 format(i2,'.',1x,a22,2x,a22,i3) + enddo + +999 end program twq diff --git a/wsjtx_lib/lib/qso50/unpack50.f90 b/wsjtx_lib/lib/qso50/unpack50.f90 new file mode 100644 index 0000000..da56e5d --- /dev/null +++ b/wsjtx_lib/lib/qso50/unpack50.f90 @@ -0,0 +1,30 @@ +subroutine unpack50(dat,n1,n2) + + integer*1 dat(11) + + i=dat(1) + i4=iand(i,255) + n1=ishft(i4,20) + i=dat(2) + i4=iand(i,255) + n1=n1 + ishft(i4,12) + i=dat(3) + i4=iand(i,255) + n1=n1 + ishft(i4,4) + i=dat(4) + i4=iand(i,255) + n1=n1 + iand(ishft(i4,-4),15) + n2=ishft(iand(i4,15),18) + i=dat(5) + i4=iand(i,255) + n2=n2 + ishft(i4,10) + i=dat(6) + i4=iand(i,255) + n2=n2 + ishft(i4,2) + i=dat(7) + i4=iand(i,255) + n2=n2 + iand(ishft(i4,-6),3) + + return +end subroutine unpack50 + diff --git a/wsjtx_lib/lib/qso50/unpackname.f90 b/wsjtx_lib/lib/qso50/unpackname.f90 new file mode 100644 index 0000000..0b51151 --- /dev/null +++ b/wsjtx_lib/lib/qso50/unpackname.f90 @@ -0,0 +1,20 @@ +subroutine unpackname(n1,n2,name,len) + + character*9 name + real*8 dn + + dn=32768.d0*n1 + n2 + len=0 + do i=9,1,-1 + j=mod(dn,27.d0) + if(j.ge.1) then + name(i:i)=char(64+j) + len=len+1 + else + name(i:i)=' ' + endif + dn=dn/27.d0 + enddo + + return +end subroutine unpackname diff --git a/wsjtx_lib/lib/qso50/unpackpfx.f90 b/wsjtx_lib/lib/qso50/unpackpfx.f90 new file mode 100644 index 0000000..ce35201 --- /dev/null +++ b/wsjtx_lib/lib/qso50/unpackpfx.f90 @@ -0,0 +1,35 @@ +subroutine unpackpfx(ng,call1) + + character*12 call1 + character*3 pfx + + if(ng.lt.60000) then +! Add-on prefix of 1 to 3 characters + n=ng + do i=3,1,-1 + nc=mod(n,37) + if(nc.ge.0 .and. nc.le.9) then + pfx(i:i)=char(nc+48) + else if(nc.ge.10 .and. nc.le.35) then + pfx(i:i)=char(nc+55) + else + pfx(i:i)=' ' + endif + n=n/37 + enddo + call1=pfx//'/'//call1 + if(call1(1:1).eq.' ') call1=call1(2:) + if(call1(1:1).eq.' ') call1=call1(2:) + else +! Add-on suffix, one character + i1=index(call1,' ') + nc=ng-60000 + if(nc.ge.0 .and. nc.le.9) then + call1=call1(:i1-1)//'/'//char(nc+48) + else if(nc.ge.10 .and. nc.le.35) then + call1=call1(:i1-1)//'/'//char(nc+55) + endif + endif + + return +end subroutine unpackpfx diff --git a/wsjtx_lib/lib/qso50/unpackprop.f90 b/wsjtx_lib/lib/qso50/unpackprop.f90 new file mode 100644 index 0000000..bf9152c --- /dev/null +++ b/wsjtx_lib/lib/qso50/unpackprop.f90 @@ -0,0 +1,28 @@ +subroutine unpackprop(n1,k,muf,ccur,cxp) + + character ccur*4,cxp*2 + + muf=mod(n1,62) + n1=n1/62 + + k=mod(n1,11) + n1=n1/11 + + j=mod(n1,53) + n1=n1/53 + if(j.eq.0) cxp='*' + if(j.ge.1 .and. j.le.26) cxp=char(64+j) + if(j.gt.26) cxp=char(64+j-26)//char(64+j-26) + + j=mod(n1,53) + n1=n1/53 + if(j.eq.0) ccur(2:2)='*' + if(j.ge.1 .and. j.le.26) ccur(2:2)=char(64+j) + if(j.gt.26) ccur(2:3)=char(64+j-26)//char(64+j-26) + j=n1 + if(j.eq.0) ccur(1:1)='*' + if(j.ge.1 .and. j.le.26) ccur(1:1)=char(64+j) + if(j.gt.26) ccur=char(64+j-26)//char(64+j-26)//ccur(2:3) + + return +end subroutine unpackprop diff --git a/wsjtx_lib/lib/qso50/unpacktext2.f90 b/wsjtx_lib/lib/qso50/unpacktext2.f90 new file mode 100644 index 0000000..b877fb6 --- /dev/null +++ b/wsjtx_lib/lib/qso50/unpacktext2.f90 @@ -0,0 +1,17 @@ +subroutine unpacktext2(n1,ng,msg) + + character*22 msg + real*8 dn + character*41 c + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +./?'/ + + msg=' ' + dn=32768.d0*n1 + ng + do i=8,1,-1 + j=mod(dn,41.d0) + msg(i:i)=c(j+1:j+1) + dn=dn/41.d0 + enddo + + return +end subroutine unpacktext2 diff --git a/wsjtx_lib/lib/qso50/wqdec.f90 b/wsjtx_lib/lib/qso50/wqdec.f90 new file mode 100644 index 0000000..761fe09 --- /dev/null +++ b/wsjtx_lib/lib/qso50/wqdec.f90 @@ -0,0 +1,316 @@ +subroutine wqdec(data0,message,ntype) + + use packjt + parameter (N15=32758) + integer*1 data0(11) + character*22 message + character*12 callsign + character*3 cdbm,cf + character*2 crpt + character*4 grid,psfx + character*9 name + character*36 fmt + character*6 cwx(4) + character*7 cwind(5) + character ccur*4,cxp*2 + logical first + character*12 dcall(0:N15-1) + data first/.true./ + data cwx/'CLEAR','CLOUDY','RAIN','SNOW'/ + data cwind/'CALM','BREEZES','WINDY','DRY','HUMID'/ + save first,dcall + + if(first) then + dcall=' ' + first=.false. + endif + + message=' ' + call unpack50(data0,n1,n2) + call unpackcall(n1,callsign,iv2,psfx) + i1=index(callsign,' ') + call unpackgrid(n2/128,grid) + ntype=iand(n2,127) -64 + +! Standard WSPR message (types 0 3 7 10 13 17 ... 60) + nu=mod(ntype,10) + if(ntype.ge.0 .and. ntype.le.60 .and. (nu.eq.0 .or. nu.eq.3 .or. & + nu.eq.7)) then + write(cdbm,'(i3)'),ntype + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + message=callsign(1:i1)//grid//' '//cdbm + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1) + +! "Best DX" WSPR response (type 1) + else if(ntype.eq.1) then + message=grid//' DE '//callsign + +! CQ (msg 3; types 2,4,5) + else if(ntype.eq.2) then + message='CQ '//callsign(:i1)//grid + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1) + else if(ntype.eq.4 .or. ntype.eq.5) then + ng=n2/128 + 32768*(ntype-4) + call unpackpfx(ng,callsign) + message='CQ '//callsign + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1) + +! Reply to CQ (msg #2; type 6) + else if(ntype.eq.6) then + ih=(n2-64-ntype)/128 + if(dcall(ih)(1:1).ne.' ') then + i2=index(dcall(ih),' ') + message='<'//dcall(ih)(:i2-1)//'> '//callsign(:i1-1) + else + message='<...> '//callsign + endif + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! Reply to CQ (msg #2; type 8) + else if(ntype.eq.8) then + message='DE '//callsign(:i1)//grid + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! Reply to CQ, DE pfx/call (msg #2; types 9, 11) + else if(ntype.eq.9 .or. ntype.eq.11) then + ng=n2/128 + 32768*(ntype-9)/2 + call unpackpfx(ng,callsign) + message='DE '//callsign + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! Calls and report (msg #3; types -1 to -9) + else if(ntype.le.-1 .and. ntype.ge.-9) then + write(crpt,1010) -ntype +1010 format('S',i1) + ih=(n2-62-ntype)/128 + if(dcall(ih)(1:1).ne.' ') then + i2=index(dcall(ih),' ') + message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> '//crpt + else + message=callsign(:i1)//'<...> '//crpt + endif + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! pfx/call and report (msg #3; types -10 to -27) + else if(ntype.le.-10 .and. ntype.ge.-27) then + ng=n2/128 + nrpt=-ntype-9 + if(ntype.le.-19) then + ng=ng + 32768 + nrpt=-ntype-18 + endif + write(crpt,1010) nrpt + call unpackpfx(ng,callsign) + message=callsign//' '//crpt + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! Calls and R and report (msg #4; types -28 to -36) + else if(ntype.le.-28 .and. ntype.ge.-36) then + write(crpt,1010) -(ntype+27) + ih=(n2-64+28-ntype)/128 + if(dcall(ih)(1:1).ne.' ') then + i2=index(dcall(ih),' ') + message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> '//'R '//crpt + else + message=callsign(:i1)//'<...> '//'R '//crpt + endif + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! pfx/call R and report (msg #4; types -37 to -54) + else if(ntype.le.-37 .and. ntype.ge.-54) then + ng=n2/128 + nrpt=-ntype-36 + if(ntype.le.-46) then + ng=ng + 32768 + nrpt=-ntype-45 + endif + write(crpt,1010) nrpt + call unpackpfx(ng,callsign) + message=callsign//' R '//crpt + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! Calls and RRR (msg#5; type 12) + else if(ntype.eq.12) then + ih=(n2-64+28-ntype)/128 + if(dcall(ih)(1:1).ne.' ') then + i2=index(dcall(ih),' ') + message=callsign(:i1)//'<'//dcall(ih)(:i2-1)//'> RRR' + else + message=callsign(:i1)//'<...> RRR' + endif + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! Calls and RRR (msg#5; type 14) + else if(ntype.eq.14) then + ih=(n2-64+28-ntype)/128 + if(dcall(ih)(1:1).ne.' ') then + i2=index(dcall(ih),' ') + message='<'//dcall(ih)(:i2-1)//'> '//callsign(:i1)//'RRR' + else + message='<...> '//callsign(:i1)//' RRR' + endif + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! DE pfx/call and RRR (msg#5; types 15, 16) + else if(ntype.eq.15 .or. ntype.eq.16) then + ng=n2/128 + 32768*(ntype-15) + call unpackpfx(ng,callsign) + message='DE '//callsign//' RRR' + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! TNX [name] 73 GL (msg #6; type 18) + else if(ntype.eq.18) then + ng=(n2-18-64)/128 + call unpackname(n1,ng,name,len) + message='TNX '//name(:len)//' 73 GL' + +! OP [name] 73 GL (msg #6; type 18) + else if(ntype.eq.-56) then + ng=(n2+56-64)/128 + call unpackname(n1,ng,name,len) + message='OP '//name(:len)//' 73 GL' + +! 73 DE [call] [grid] (msg #6; type 19) + else if(ntype.eq.19) then + ng=(n2-19-64)/128 + message='73 DE '//callsign(:i1)//grid + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! 73 DE pfx/call (msg #6; type 21, 22) + else if(ntype.eq.21 .or. ntype.eq.22) then + ng=n2/128 + (ntype-21)*32768 + call unpackpfx(ng,callsign) + i1=index(callsign,' ') + message='73 DE '//callsign + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1-1) + +! [power] W [gain] DBD 73 GL (msg#6; type 24, 25) + else if(ntype.eq.24 .or. ntype.eq.25) then + ng=(n2-24-64)/128 - 32 + i1=1 + if(n1.gt.0) i1=log10(float(n1)) + 1 + i2=1 + if(ng.ge.10) i2=2 + if(ng.lt.0) i2=i2+1 + if(n1.le.3000) then + if(ntype.eq.24) fmt="(i4,' W ',i2,' DBD 73 GL')" + if(ntype.eq.25) fmt="(i4,' W ',i2,' DBD ')" + fmt(3:3)=char(48+i1) + fmt(12:12)=char(48+i2) + if(ng.le.100) then + write(message,fmt) n1,ng + else + if(ng.eq.30000) fmt=fmt(1:8)//"DIPOLE')" + if(ng.eq.30001) fmt=fmt(1:8)//"VERTICAL')" + write(message,fmt) n1 + endif + else + mw=n1-3000 + if(ntype.eq.24) fmt="('0.',i3.3,' W ',i2,' DBD 73 GL')" + if(ntype.eq.25) fmt="('0.',i3.3,' W ',i2,' DBD ')" + fmt(19:19)=char(48+i2) + if(ng.le.100) then + write(message,fmt) mw,ng + else + if(ng.eq.30000) fmt=fmt(1:15)//"DIPOLE')" + if(ng.eq.30001) fmt=fmt(1:15)//"VERTICAL')" + write(message,fmt) n1 + endif + if(index(message,'***').gt.0) go to 700 + endif + +! QRZ call (msg #3; type 26) + else if(ntype.eq.26) then + ng=(n2-24-64)/128 - 32 + message='QRZ '//callsign + +! PSE QSY [nnn] KHZ (msg #6; type 28) + else if(ntype.eq.28) then + if(n1.gt.0) i1=log10(float(n1)) + 1 + fmt="('PSE QSY ',i2,' KHZ')" + fmt(14:14)=char(48+i1) + write(message,fmt) n1 + +! WX wx temp C/F wind (msg #6; type 29) + else if(ntype.eq.29) then + nwx=n1/10000 + ntemp=mod(n1,10000) - 100 + cf=' F ' + if(ntemp.gt.800) then + ntemp=ntemp-1000 + cf=' C ' + endif + n2a=n2/128 + if(nwx.ge.1 .and. nwx.le.4 .and. n2a.ge.1 .and. n2a.le.5) then + write(message,1020) cwx(nwx),ntemp,cf,cwind(n2/128) +1020 format('WX ',a6,i3,a3,a7) + else + message='WX'//' (BadMsg)' + endif + +! Hexadecimal data (type 62) + else if(ntype.eq.62) then + ng=n2/128 + write(message,'(z4.4,z7.7)') ng,n1 + +! Solar/geomagnetic/ionospheric data (type 63) + else if(ntype.eq.63) then + ih=(n2-64-ntype)/128 + if(dcall(ih)(1:1).ne.' ') then + i2=index(dcall(ih),' ') + message='<'//dcall(ih)(:i2-1)//'> ' + else + message='<...> ' + endif + call unpackprop(n1,k,muf,ccur,cxp) + i2=index(message,'>') + write(message(i2+1:),'(i3,i3)') k,muf + message=message(:i2+7)//ccur//' '//cxp + +! [plain text] (msg #6; type -57) + else if(ntype.eq.-57) then + ng=n2/128 + call unpacktext2(n1,ng,message) + else + go to 700 + endif + go to 750 + +! message='' +700 i1=index(callsign,' ') + if(i1.lt.1) i1=12 + message=callsign(:i1)//' (BadMsg)' + +750 do i=1,22 + if(ichar(message(i:i)).eq.0) message(i:i)=' ' + enddo + + do i=22,1,-1 + if(message(i:i).ne.' ') go to 800 + enddo +800 i2=i + do n=1,20 + i1=index(message(:i2),' ') + if(i1.le.0) go to 900 + message=message(1:i1)//message(i1+2:) + i2=i2-1 + enddo + +900 return +end subroutine wqdec diff --git a/wsjtx_lib/lib/qso50/wqenc.f90 b/wsjtx_lib/lib/qso50/wqenc.f90 new file mode 100644 index 0000000..33879f7 --- /dev/null +++ b/wsjtx_lib/lib/qso50/wqenc.f90 @@ -0,0 +1,346 @@ +subroutine wqenc(msg,ntype,data0) + +! Parse and encode a WSPR message. + + use packjt + parameter (MASK15=32767) + character*22 msg + character*12 call1,call2 + character*4 grid + character*9 name + character ccur*4,cxp*2 + logical lbad1,lbad2 + integer*1 data0(11) + integer nu(0:9) + data nu/0,-1,1,0,-1,2,1,0,-1,1/ + + read(msg,1001,end=1,err=1) ng,n1 +1001 format(z4,z7) + ntype=62 + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) !Pack 8 bits per byte, add tail + go to 900 + +1 if(msg(1:6).eq.'73 DE ') go to 80 + if(index(msg,' W ').gt.0 .and. index(msg,' DBD ').gt.0) go to 90 + if(msg(1:4).eq.'QRZ ') go to 100 + if(msg(1:8).eq.'PSE QSY ') go to 110 + if(msg(1:3).eq.'WX ') go to 120 + +! Standard WSPR message (types 0 3 7 10 13 17 ... 60) + i1=index(msg,' ') + if(i1.lt.4 .or. i1.gt.7) go to 10 + call1=msg(:i1-1) + grid=msg(i1+1:i1+4) + call packcall(call1,n1,lbad1) + call packgrid(grid,ng,lbad2) + if(lbad1 .or. lbad2) go to 10 + ndbm=0 + read(msg(i1+5:),*,err=10,end=800) ndbm + if(ndbm.lt.0 .or. ndbm.gt.60) go to 800 + ndbm=ndbm+nu(mod(ndbm,10)) + n2=128*ng + (ndbm+64) + call pack50(n1,n2,data0) + ntype=ndbm + go to 900 + +! "BestDX" automated WSPR reply (type 1) +10 if(i1.ne.5 .or. msg(5:8).ne.' DE ') go to 20 + grid=msg(1:4) + call packgrid(grid,ng,lbad2) + if(lbad2) go to 800 + call1=msg(9:) + call packcall(call1,n1,lbad1) + if(lbad1) go to 800 + ntype=1 + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) !Pack 8 bits per byte, add tail + go to 900 + +! CQ (msg #1; types 2, 4, 5) +20 if(msg(1:3).ne.'CQ ') go to 30 + if(index(msg,'/').le.0) then + i2=index(msg(4:),' ') + call1=msg(4:i2+3) + grid=msg(i2+4:) + call packcall(call1,n1,lbad1) + if(lbad1) go to 30 + call packgrid(grid,ng,lbad2) + if(lbad2) go to 30 + ntype=2 + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + else + ntype=4 ! or 5 + call1=msg(4:) + call packpfx(call1,n1,ng,nadd) + ntype=ntype+nadd + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + endif + go to 900 + +! Reply to CQ (msg #2; types 6,8,9,11) +30 if(msg(1:1).ne.'<' .and. msg(1:3).ne.'DE ') go to 40 + if(index(msg,' RRR ').gt.0) go to 50 + if(msg(1:1).eq.'<') then + ntype=6 + i1=index(msg,'>') + call1=msg(2:i1-1) + read(msg(i1+1:),*,err=31,end=31) k,muf,ccur,cxp + go to 130 +31 call2=msg(i1+2:) + call hash(call1,i1-2,ih) + call packcall(call2,n1,lbad1) + n2=128*ih + (ntype+64) + call pack50(n1,n2,data0) + else + i1=index(msg(4:),' ') + call1=msg(4:i1+2) + if(index(msg,'/').le.0) then + ntype=8 + ih=0 + call packcall(call1,n1,lbad1) + grid=msg(i1+4:i1+7) + call packgrid(grid,ng,lbad2) + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + else + ntype=9 ! or 11 + call1=msg(4:) + call packpfx(call1,n1,ng,nadd) + ntype=ntype + 2*nadd + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + endif + endif + go to 900 + +! Call(s) + report (msg #3; types -1 to -27) +! Call(s) + R + report (msg #4; types -28 to -54) +40 if(index(msg,' RRR').gt.0) go to 50 + i1=index(msg,'<') + if(i1.gt.0 .and. (i1.lt.5 .or. i1.gt.8)) go to 50 + i2=index(msg,'/') + if(i2.gt.0 .and.i2.le.4) then + ntype=-10 ! -10 to -27 + i0=index(msg,' ') + call1=msg(:i0-1) + call packpfx(call1,n1,ng,nadd) + ntype=ntype - 9*nadd + i2=index(msg,' ') + i3=index(msg,' R ') + if(i3.gt.0) i2=i2+2 !-28 to -36 + read(msg(i2+2:i2+2),*,end=800,err=800) nrpt + ntype=ntype - (nrpt-1) + if(i3.gt.0) ntype=ntype-27 + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + go to 900 + else if(i1.eq.0) then + go to 50 + endif + call1=msg(:i1-2) !-1 to -9 + i2=index(msg,'>') + call2=msg(i1+1:i2-1) + call hash(call2,i2-i1-1,ih) + i3=index(msg,' R ') + if(i3.gt.0) i2=i2+2 !-28 to -36 + read(msg(i2+3:i2+3),*,end=42,err=42) nrpt + go to 43 +42 nrpt=1 +43 ntype=-nrpt + if(i3.gt.0) ntype=-(nrpt+27) + call packcall(call1,n1,lbad1) + n2=128*ih + (ntype+64) + call pack50(n1,n2,data0) + go to 900 + +50 i0=index(msg,'<') + if(i0.le.0 .and. msg(1:3).ne.'DE ') go to 60 + i3=index(msg,' RRR') + if(i3.le.0) go to 60 +! Call or calls and RRR (msg#5; type2 12,14,15,16) + i0=index(msg,'<') + if(i0.eq.1) then + if(index(msg,'/').le.0) then + ntype=14 + i1=index(msg,'>') + call1=msg(2:i1-1) + call2=msg(i1+2:) + i2=index(call2,' ') + call2=call2(:i2-1) + call packcall(call2,n1,lbad1) + call hash(call1,i1-2,ih) + n2=128*ih + (ntype+64) + call pack50(n1,n2,data0) + else + stop '0002' + endif + else if(i0.ge.5 .and. i0.le.8) then + if(index(msg,'/').le.0) then + ntype=12 + i1=index(msg,'>') + call1=msg(:i0-2) + call2=msg(i0+1:i1-1) + call packcall(call1,n1,lbad1) + call hash(call2,i1-i0-1,ih) + n2=128*ih + (ntype+64) + call pack50(n1,n2,data0) + else + stop '0002' + endif + else + i1=index(msg(4:),' ') + call1=msg(4:i1+2) + if(index(msg,'/').le.0) then + ntype=9 + grid=msg(i1+4:i1+7) + else + ntype=15 ! or 16 + call1=msg(4:) + i0=index(call1,' ') + call1=call1(:i0-1) + call packpfx(call1,n1,ng,nadd) + ntype=ntype+nadd + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + endif + endif + go to 900 + +! TNX 73 GL (msg #6; type 18 ...) +60 if(msg(1:4).ne.'TNX ') go to 70 + ntype=18 + n1=0 + i2=index(msg(5:),' ') + name=msg(5:i2+4) + call packname(name,i2-1,n1,ng) + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + go to 900 + +! TNX name 73 GL (msg #6; type -56 ...) +70 if(msg(1:3).ne.'OP ') go to 80 + ntype=-56 + n1=0 + i2=index(msg(4:),' ') + name=msg(4:i2+3) + call packname(name,i2-1,n1,ng) + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + go to 900 + +! 73 DE call grid (msg #6; type 19) +80 if(msg(1:6).ne.'73 DE ') go to 90 + ntype=19 + i1=index(msg(7:),' ') + call1=msg(7:) + if(index(call1,'/').le.0) then + i1=index(call1,' ') + grid=call1(i1+1:) + call1=call1(:i1-1) + call packcall(call1,n1,lbad1) + call packgrid(grid,ng,lbad2) + if(lbad1 .or. lbad2) go to 800 + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + go to 900 + else + ntype=21 ! or 22 + call packpfx(call1,n1,ng,nadd) + ntype=ntype + nadd + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + go to 900 + endif + +! [pwr] W [gain] DBD [73 GL] (msg #6; types 24, 25) +90 if(index(msg,' W ').le.0) go to 140 + ntype=25 + if(index(msg,' DBD 73 GL').gt.0) ntype=24 + i1=index(msg,' ') + read(msg(:i1-1),*,end=800,err=800) watts + if(watts.ge.1.0) nwatts=watts + if(watts.lt.1.0) nwatts=3000 + nint(1000.*watts) + if(index(msg,'DIPOLE').gt.0) then + ndbd=30000 + else if(index(msg,'VERTICAL').gt.0) then + ndbd=30001 + else + i2=index(msg(i1+3:),' ') + read(msg(i1+3:i1+i2+1),*,end=800,err=800) ndbd + endif + n1=nwatts + ng=ndbd + 32 + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + go to 900 + +! QRZ call (msg #3; type 26) +100 call1=msg(5:) + call packcall(call1,n1,lbad1) + if(lbad1) go to 800 + ntype=26 + n2=ntype+64 + call pack50(n1,n2,data0) + go to 900 + +! PSE QSY [nnn] KHZ (msg #6; type 28) +110 ntype=28 + read(msg(9:),*,end=800,err=800) n1 + n2=ntype+64 + call pack50(n1,n2,data0) + go to 900 + +! WX wx temp C|F wind (msg #6; type 29) +120 ntype=29 + if(index(msg,' CLEAR ').gt.0) then + i1=10 + n1=10000 + else if(index(msg,' CLOUDY ').gt.0) then + i1=11 + n1=20000 + else if(index(msg,' RAIN ').gt.0) then + i1=9 + n1=30000 + else if(index(msg,' SNOW ').gt.0) then + i1=9 + n1=40000 + endif + read(msg(i1:),*,err=800,end=800) ntemp + ntemp=ntemp+100 + i1=index(msg,' C ') + if(i1.gt.0) ntemp=ntemp+1000 + n1=n1+ntemp + if(index(msg,' CALM').gt.0) ng=1 + if(index(msg,' BREEZES').gt.0) ng=2 + if(index(msg,' WINDY').gt.0) ng=3 + if(index(msg,' DRY').gt.0) ng=4 + if(index(msg,' HUMID').gt.0) ng=5 + + n2=128*ng + (ntype+64) + call pack50(n1,n2,data0) + + go to 900 + +! Solar/geomagnetic/ionospheric data +130 ntype=63 + call packprop(k,muf,ccur,cxp,n1) + call hash(call1,i1-2,ih) + n2=128*ih + ntype + 64 + call pack50(n1,n2,data0) + go to 900 + +140 continue + +! Plain text +800 ntype=-57 + call packtext2(msg(:8),n1,ng) + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + go to 900 + +900 continue + return +end subroutine wqenc diff --git a/wsjtx_lib/lib/qso50/wqmsg.txt b/wsjtx_lib/lib/qso50/wqmsg.txt new file mode 100644 index 0000000..591a5d1 --- /dev/null +++ b/wsjtx_lib/lib/qso50/wqmsg.txt @@ -0,0 +1,31 @@ +"CQ K1JT FN20" +"CQ PJ4/K1JT" +" W6CQZ" +"DE W6CQZ CM87" +"DE PJ4/K1JT" +"W6CQZ S4" +"QRZ K1JT" +"PJ4/W6CQZ S4" +"K1JT R S3" +"PJ4/K1JT R S3" +" K1JT RRR" +"W6CQZ RRR" +"DE PJ4/K1JT RRR" +"73 DE W6CQZ CM87" +"73 DE PJ4/K1JT" +"TNX VICTORIA 73 GL" +"OP HARRY 73 GL" +"5 W DIPOLE" +"10 W VERTICAL" +"1 W 0 DBD" +"1500 W 21 DBD 73 GL" +"PSE QSY 1811 KHZ" +"WX SNOW -5 C CALM" +"CUL JACK" +"." +"CQ K1JT FN20" +" W6CQZ" +"W6CQZ S4" +"K1JT R S3" +" K1JT RRR" +"TNX JOE 73 GL" diff --git a/wsjtx_lib/lib/readwav.f90 b/wsjtx_lib/lib/readwav.f90 new file mode 100644 index 0000000..2536904 --- /dev/null +++ b/wsjtx_lib/lib/readwav.f90 @@ -0,0 +1,73 @@ +! +! readwav - open and read the header of a WAV format file +! +! On successful exit the file is left positioned at the start of the +! data. +! +! Example of usage: +! +! use readwav +! integer*2 sample +! type(wav_header) wav +! call wav%read ('file.wav') +! write (*,*) 'Sample rate is: ', wav%audio_format%sample_rate +! do i=0,wav%data_size +! read (unit=wav%lun) sample +! ! process sample +! end do +! +module readwav + implicit none + + type format_chunk + integer*2 audio_format + integer*2 num_channels + integer sample_rate + integer byte_rate + integer*2 block_align + integer*2 bits_per_sample + end type format_chunk + + type, public :: wav_header + integer :: lun + type(format_chunk) :: audio_format + integer :: data_size + contains + procedure :: read + end type wav_header + + private +contains + subroutine read (this, filename) + implicit none + + type riff_descriptor + character(len=4) :: id + integer :: size + end type riff_descriptor + + class(wav_header), intent(inout) :: this + character(len=*), intent(in) :: filename + + integer :: filepos + type(riff_descriptor) :: desc + character(len=4) :: riff_type + + this%lun=26 + open (unit=this%lun, file=filename, access='stream',status='old') + read (unit=this%lun) desc,riff_type + inquire (unit=this%lun, pos=filepos) + do + read (unit=this%lun, pos=filepos) desc + inquire (unit=this%lun, pos=filepos) + if (desc%id .eq. 'fmt ') then + read (unit=this%lun) this%audio_format + else if (desc%id .eq. 'data') then + this%data_size = desc%size + exit + end if + filepos = filepos + (desc%size + 1) / 2 * 2 ! pad to even alignment + end do + return + end subroutine read +end module readwav diff --git a/wsjtx_lib/lib/rectify_msk.f90 b/wsjtx_lib/lib/rectify_msk.f90 new file mode 100644 index 0000000..ff5ee49 --- /dev/null +++ b/wsjtx_lib/lib/rectify_msk.f90 @@ -0,0 +1,64 @@ +subroutine rectify_msk(c,msg0,imsg,freq2) + + parameter (NSPM=1404) + complex c(0:NSPM-1) !Received data + complex cmsg(0:NSPM-1) !Message waveform + complex c1(0:NSPM-1) !Rectified signal + complex c2(0:NSPM-1) !Integral of rectified signal + complex c3(0:2*NSPM-1) !FFT of rectified signal + complex cfac + character*22 msg0,msg,msgsent + integer i4tone(234) + + ichk=0 + msg=msg0 + nsym=234 + if(imsg.ge.0) then + ichk=10000+imsg + msg=" 73" + nsym=35 + endif + call genmsk(msg,ichk,msgsent,i4tone,itype) !Get tone sequence for msg + + twopi=8.0*atan(1.0) + dt=1.0/12000.0 + f0=1000.0 + f1=2000.0 + phi=0. + dphi=0. + k=-1 + c2=0. + do j=1,nsym !Generate Tx waveform for msg + if(i4tone(j).eq.0) dphi=twopi*f0*dt + if(i4tone(j).eq.1) dphi=twopi*f1*dt + do i=1,6 + k=k+1 + phi=phi+dphi + cmsg(k)=cmplx(cos(phi),sin(phi)) + c1(k)=conjg(cmsg(k))*c(k) + if(k.ge.1) c2(k)=c2(k-1) + c1(k) + enddo + enddo + c2(0)=c2(1) + pha=atan2(aimag(c2(NSPM-1)),real(c2(NSPM-1))) + cfac=cmplx(cos(pha),-sin(pha)) + c1=cfac*c1 + c2=cfac*c2 + nfft=2*NSPM + c3(0:NSPM-1)=c2 + c3(NSPM:nfft-1)=0. + df=12000.0/nfft + call four2a(c3,nfft,1,-1,1) + smax=0. + do i=0,nfft-1 + f=i*df + if(i.gt.nfft/2) f=f-12000.0 + s=1.e-10*(real(c3(i))**2 + aimag(c3(i))**2) + if(s.gt.smax) then + smax=s + freq2=1500.0 + f + endif + enddo + + return +end subroutine rectify_msk diff --git a/wsjtx_lib/lib/refspectrum.f90 b/wsjtx_lib/lib/refspectrum.f90 new file mode 100644 index 0000000..68b514f --- /dev/null +++ b/wsjtx_lib/lib/refspectrum.f90 @@ -0,0 +1,158 @@ +subroutine refspectrum(id2,bclear,brefspec,buseref,fname) + +! Input: +! id2 i*2 Raw 16-bit integer data, 12000 Hz sample rate +! brefspec logical True when accumulating a reference spectrum + + parameter (NFFT=6912,NH=NFFT/2,NPOLYLOW=400,NPOLYHIGH=2600) + integer*2 id2(NFFT) + logical*1 bclear,brefspec,buseref,blastuse + + real xs(0:NH-1) !Saved upper half of input chunk convolved with h(t) + real x(0:NFFT-1) !Work array + real*4 w(0:NFFT-1) !Window function + real*4 s(0:NH) !Average spectrum + real*4 fil(0:NH) + real*8 xfit(1500),yfit(1500),sigmay(1500),a(5),chisqr !Polyfit arrays + logical first + complex cx(0:NH) !Complex frequency-domain work array + complex cfil(0:NH) + character*(*) fname + common/spectra/syellow(6827),ref(0:NH),filter(0:NH) + equivalence(x,cx) + data first/.true./,blastuse/.false./ + save + + if(first) then + pi=4.0*atan(1.0) + do i=0,NFFT-1 + ww=sin(i*pi/NFFT) + w(i)=ww*ww/NFFT + enddo + nsave=0 + s=0.0 + filter=1.0 + xs=0. + first=.false. + endif + if(bclear) s=0. + + if(brefspec) then + x(0:NH-1)=0.001*id2(1:NH) + x(NH:NFFT-1)=0.0 + call four2a(cx,NFFT,1,-1,0) !r2c FFT + + do i=1,NH + s(i)=s(i) + real(cx(i))**2 + aimag(cx(i))**2 + enddo + nsave=nsave+1 + + fac0=0.9 + if(mod(nsave,4).eq.0) then + df=12000.0/NFFT + ia=nint(1000.0/df) + ib=nint(2000.0/df) + avemid=sum(s(ia:ib))/(ib-ia+1) + do i=0,NH + fil(i)=0. + if(s(i).gt.0.0) then + fil(i)=sqrt(avemid/s(i)) + endif + enddo + +! Default range is 240 - 4000 Hz. For narrower filters, use frequencies +! at which gain is -20 dB relative to 1500 Hz. + ia=nint(240.0/df) + ib=nint(4000.0/df) + i0=nint(1500.0/df) + do i=i0,ia,-1 + if(s(i)/s(i0).lt.0.01) exit + enddo + ia=i + do i=i0,ib,1 + if(s(i)/s(i0).lt.0.01) exit + enddo + ib=i + + fac=fac0 + do i=ia,1,-1 + fac=fac*fac0 + fil(i)=fac*fil(i) + enddo + + fac=fac0 + do i=ib,NH + fac=fac*fac0 + fil(i)=fac*fil(i) + enddo + + do iter=1,100 !### ??? ### + call smo121(fil,NH) + enddo + + do i=0,NH + filter(i)=-60.0 + if(s(i).gt.0.0) filter(i)=20.0*log10(fil(i)) + enddo + + il=nint(NPOLYLOW/df) + ih=nint(NPOLYHIGH/df) + nfit=ih-il+1 + mode=0 + nterms=5 + do i=1,nfit + xfit(i)=((i+il-1)*df-1500.0)/1000.0 + yfit(i)=fil(i+il-1) + sigmay(i)=1.0 + enddo + call polyfit(xfit,yfit,sigmay,nfit,nterms,mode,a,chisqr) + + open(16,file=fname,status='unknown') + write(16,1003) NPOLYLOW,NPOLYHIGH,nterms,a +1003 format(3i5,5e25.16) + do i=1,NH + freq=i*df + ref(i)=db(s(i)/avemid) + write(16,1005) freq,s(i),ref(i),fil(i),filter(i) +1005 format(f10.3,e12.3,f12.6,e12.3,f12.6) + enddo + close(16) + endif + return + endif + + if(buseref) then + if(blastuse.neqv.buseref) then !just enabled so read filter + fil=1.0 + open(16,file=fname,status='old',err=999) + read(16,1003,err=20,end=999) ndummy,ndummy,nterms,a + goto 30 +20 rewind(16) !allow for old style refspec.dat with no header +30 do i=1,NH + read(16,1005,err=999,end=999) freq,s(i),ref(i),fil(i),filter(i) + enddo +! Make the filter causal for overlap and add. + cx(0)=0.0 + cx(1:NH)=fil(1:NH)/NFFT + call four2a(cx,NFFT,1,1,-1) + x=cshift(x,-400) + x(800:NH)=0.0 + call four2a(cx,NFFT,1,-1,0) + cfil=cx + close(16) + endif +! Use overlap and add method to apply causal reference filter. + x(0:NH-1)=id2(1:NH) + x(NH:NFFT-1)=0.0 + x=x/NFFT + call four2a(cx,NFFT,1,-1,0) + cx=cfil*cx + call four2a(cx,NFFT,1,1,-1) + x(0:NH-1)=x(0:NH-1)+xs + xs=x(NH:NFFT-1) + id2(1:NH)=nint(x(0:NH-1)) + endif + blastuse=buseref + +999 return +end subroutine refspectrum diff --git a/wsjtx_lib/lib/rig_control.c b/wsjtx_lib/lib/rig_control.c new file mode 100644 index 0000000..7c8b2f6 --- /dev/null +++ b/wsjtx_lib/lib/rig_control.c @@ -0,0 +1,99 @@ +#include "config.h" +#include +#include +#include +#include "tstrig.h" + +RIG *my_rig; // handle to rig + +int set_conf(RIG *my_rig, char *conf_parms); + +//------------------------------------------------------------------------ +int set_conf(RIG *my_rig, char *conf_parms) +{ + char *p, *q, *n; + int iret; + + p = conf_parms; + while (p && *p != '\0') { + /* FIXME: left hand value of = cannot be null */ + q = strchr(p, '='); + if ( !q ) + return -RIG_EINVAL; + *q++ = '\0'; + n = strchr(q, ','); + if (n) *n++ = '\0'; + iret = rig_set_conf(my_rig, rig_token_lookup(my_rig, p), q); + if (iret != RIG_OK) + return iret; + p = n; + } + return RIG_OK; +} + +//------------------------------------------------------------------------ +int rigOpen(int verbose, rig_model_t my_model, const char* rig_file, + int serial_rate, const char* conf_parms2) +{ + int iret; /* generic return code from functions */ + char *civaddr = NULL; /* NULL means no need to set conf */ + // const char *rig_file; + // const char *conf_parms2; + // int serial_rate; + + rig_set_debug(verbose); + my_rig=rig_init(my_model); + + if (!my_rig) { + // fprintf(stderr, "Unknown rig num %d, or initialization error.\n",my_model); + return -1; + } + + // rig_file="COM1"; + // serial_rate=4800; + // conf_parms2="data_bits=8,stop_bits=2,serial_handshake=Hardware"; + + iret=set_conf(my_rig, conf_parms2); + if (iret!=RIG_OK) { + // fprintf(stderr, "Config parameter error: %s\n", rigerror(iret)); + return -2; + } + + if (rig_file) + strncpy(my_rig->state.rigport.pathname, rig_file, FILPATHLEN - 1); + + if (serial_rate!=0) + my_rig->state.rigport.parm.serial.rate = serial_rate; + + if (civaddr) + rig_set_conf(my_rig, rig_token_lookup(my_rig, "civaddr"), civaddr); + + iret = rig_open(my_rig); + if(iret!=0) return -3; + return 0; +} + +int rigSetFreq(int fHz) +{ + return rig_set_freq(my_rig,RIG_VFO_CURR,fHz); +} + +int rigFreq(int *fHz) +{ + int iret=0; + freq_t freq; + iret=rig_get_freq(my_rig, RIG_VFO_CURR, &freq); + *fHz=freq; + return iret; +} + +int rigSetPTT(int iptt) +{ + return rig_set_ptt(my_rig, RIG_VFO_CURR, iptt); +} + +void rigClose() +{ + rig_close(my_rig); + rig_cleanup(my_rig); +} diff --git a/wsjtx_lib/lib/rs.h b/wsjtx_lib/lib/rs.h new file mode 100644 index 0000000..06cbe34 --- /dev/null +++ b/wsjtx_lib/lib/rs.h @@ -0,0 +1,35 @@ +/* User include file for the Reed-Solomon codec + * Copyright 2002, Phil Karn KA9Q + * May be used under the terms of the GNU General Public License (GPL) + */ + +/* General purpose RS codec, 8-bit symbols */ +void encode_rs_char(void *rs,unsigned char *data,unsigned char *parity); +int decode_rs_char(void *rs,unsigned char *data,int *eras_pos, + int no_eras); +void *init_rs_char(int symsize,int gfpoly, + int fcr,int prim,int nroots, + int pad); +void free_rs_char(void *rs); + +/* General purpose RS codec, integer symbols */ +void encode_rs_int(void *rs,int *data,int *parity); +int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras); +void *init_rs_int(int symsize,int gfpoly,int fcr, + int prim,int nroots,int pad); +void free_rs_int(void *rs); + +/* CCSDS standard (255,223) RS codec with conventional (*not* dual-basis) + * symbol representation + */ +void encode_rs_8(unsigned char *data,unsigned char *parity,int pad); +int decode_rs_8(unsigned char *data,int *eras_pos,int no_eras,int pad); + +/* CCSDS standard (255,223) RS codec with dual-basis symbol representation */ +void encode_rs_ccsds(unsigned char *data,unsigned char *parity,int pad); +int decode_rs_ccsds(unsigned char *data,int *eras_pos,int no_eras,int pad); + +/* Tables to map from conventional->dual (Taltab) and + * dual->conventional (Tal1tab) bases + */ +extern unsigned char Taltab[],Tal1tab[]; diff --git a/wsjtx_lib/lib/rtty_spec.f90 b/wsjtx_lib/lib/rtty_spec.f90 new file mode 100644 index 0000000..2ddc802 --- /dev/null +++ b/wsjtx_lib/lib/rtty_spec.f90 @@ -0,0 +1,102 @@ +program rtty_spec + +! Generate simulated data for standard RTTY and WSJT-X modes FT8, FT4 + + use wavhdr + use packjt + parameter (NMAX=15*12000) + type(hdr) h + complex cwave(NMAX) + real wave(NMAX) + real*4 dat(NMAX) !Generated waveform + integer*2 iwave(NMAX) !Generated waveform + integer itone(680) !Channel symbols (values 0-1, 0-3, 0-7) + integer*1 msgbits(77) + character*37 msg37,msgsent37 + character*8 arg + + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: rtty_spec ' + go to 999 + endif + call getarg(1,arg) + read(arg,*) snrdb !S/N in dB (2500 hz reference BW) + + rmsdb=25. + rms=10.0**(0.05*rmsdb) + sig=10.0**(0.05*snrdb) + npts=NMAX + + do i=1,NMAX !Generate gaussian noise + dat(i)=gran() + enddo + +! Add the RTTY signal + fsample=12000.0 !Sample rate (Hz) + dt=1.0/fsample !Sample interval (s) + twopi=8.0*atan(1.0) + phi=0. + dphi=0. + j0=-1 + do i=6001,NMAX-6000 + j=nint(i*dt/0.022) + if(j.ne.j0) then + f0=1415.0 + call random_number(rr) + if(rr.gt.0.5) f0=1585.0 + dphi=twopi*f0*dt + j0=j + endif + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + dat(i)=dat(i) + sig*sin(phi) + enddo + +! FT8 signal (FSK) + i3=0 + n3=0 + msg37='WB9XYZ KA2ABC FN42' + call genft8(msg37,i3,n3,msgsent37,msgbits,itone) + nsym=79 + nsps=1920 + bt=99.0 + f0=3500.0 + icmplx=0 + nwave=nsym*nsps + call gen_ft8wave(itone,nsym,nsps,bt,fsample,f0,cwave,wave,icmplx,nwave) + dat(6001:6000+nwave)=dat(6001:6000+nwave) + sig*wave(1:nwave) + +! FT8 signal (GFSK) + i3=0 + n3=0 + msg37='WB9XYZ KA2ABC FN42' + call genft8(msg37,i3,n3,msgsent37,msgbits,itone) + nsym=79 + nsps=1920 + bt=2.0 + f0=4000.0 + icmplx=0 + nwave=nsym*nsps + call gen_ft8wave(itone,nsym,nsps,bt,fsample,f0,cwave,wave,icmplx,nwave) + dat(6001:6000+nwave)=dat(6001:6000+nwave) + sig*wave(1:nwave) + +! Add the FT4 signal + ichk=0 + call genft4(msg37,ichk,msgsent37,msgbits,itone) + nsym=103 + nsps=576 + f0=4500.0 + icmplx=0 + nwave=(nsym+2)*nsps + call gen_ft4wave(itone,nsym,nsps,fsample,f0,cwave,wave,icmplx,nwave) + dat(6001:6000+nwave)=dat(6001:6000+nwave) + sig*wave(1:nwave) + + h=default_header(12000,NMAX) + datmax=maxval(abs(dat)) + iwave=nint(32767.0*dat/datmax) + open(10,file='000000_000001.wav',access='stream',status='unknown') + write(10) h,iwave + close(10) + +999 end program rtty_spec diff --git a/wsjtx_lib/lib/save_dxbase.f90 b/wsjtx_lib/lib/save_dxbase.f90 new file mode 100644 index 0000000..206dfd5 --- /dev/null +++ b/wsjtx_lib/lib/save_dxbase.f90 @@ -0,0 +1,9 @@ +subroutine save_dxbase(dxbase0) + + use packjt77 + character*6 dxbase0 + + dxbase=dxbase0 + + return +end subroutine save_dxbase diff --git a/wsjtx_lib/lib/save_echo_params.f90 b/wsjtx_lib/lib/save_echo_params.f90 new file mode 100644 index 0000000..56930ba --- /dev/null +++ b/wsjtx_lib/lib/save_echo_params.f90 @@ -0,0 +1,29 @@ +subroutine save_echo_params(nDopTotal,nDopAudio,nfrit,f1,fspread,id2,idir) + + integer*2 id2(10) + integer*2 id2a(10) + equivalence (nDopTotal0,id2a(1)) + equivalence (nDopAudio0,id2a(3)) + equivalence (nfrit0,id2a(5)) + equivalence (f10,id2a(7)) + equivalence (fspread0,id2a(9)) + + if(idir.gt.0) then + nDopTotal0=nDopTotal + nDopAudio0=nDopAudio + nfrit0=nfrit + f10=f1 + fspread0=fspread + id2=id2a + else + id2a=id2 + id2(1:10)=0 + nDopTotal=nDopTotal0 + nDopAudio=nDopAudio0 + nfrit=nfrit0 + f1=f10 + fspread=fspread0 + endif + + return +end subroutine save_echo_params diff --git a/wsjtx_lib/lib/savec2.f90 b/wsjtx_lib/lib/savec2.f90 new file mode 100644 index 0000000..6435a21 --- /dev/null +++ b/wsjtx_lib/lib/savec2.f90 @@ -0,0 +1,55 @@ +integer function savec2(c2name,ntrseconds,f0m1500) + +! Array c0() has complex samples at 1500 Hz sample rate. +! WSPR-2: downsample by 1/4 to produce c2, centered at 1500 Hz +! WSPR-15: downsample by 1/32 to produce c2, centered at 1612.5 Hz + + parameter (NDMAX=120*1500) !Sample intervals at 1500 Hz rate + parameter (MAXFFT=256*1024) + + character*(*) c2name + character*14 outfile + real*8 f0m1500 + complex c0 + complex c1(0:MAXFFT-1) + complex c2(0:65535) + common/c0com/c0(0:NDMAX-1) + + ntrminutes=ntrseconds/60 + npts=114*1500 + nfft1=262144 + if(ntrminutes.eq.15) then + npts=890*1500 + nfft1=MAXFFT + endif + df1=1500.0/nfft1 + fac=1.0/nfft1 + c1(0:npts-1)=fac*c0(0:npts-1) + c1(npts:nfft1-1)=0. + + call four2a(c1,nfft1,1,1,1) !Complex FFT to frequency domain + +! Select the desired frequency range + nfft2=65536 + nh2=nfft2/2 + if(ntrminutes.eq.2) then + c2(0:nh2)=c1(0:nh2) + c2(nh2+1:nfft2-1)=c1(nfft1-nh2+1:nfft1-1) + else + i0=nint(112.5/df1) + c2(0:nh2)=c1(i0:i0+nh2) + c2(nh2+1:nfft2-1)=c1(i0-nh2+1:i0-1) + endif + + call four2a(c2,nfft2,1,-1,1) !Shorter complex FFT, back to time domain + +! Write complex time-domain data to disk. + i1=index(c2name,'.c2') + outfile=c2name(i1-11:i1+2) + open(18,file=c2name,status='unknown',access='stream', iostat=ioerr) + if (ioerr.eq.0) then + write(18) outfile,ntrminutes,f0m1500,c2(0:45000-1) + close(18) + endif + savec2 = ioerr +end function savec2 diff --git a/wsjtx_lib/lib/sec0.f90 b/wsjtx_lib/lib/sec0.f90 new file mode 100644 index 0000000..1ced602 --- /dev/null +++ b/wsjtx_lib/lib/sec0.f90 @@ -0,0 +1,21 @@ +subroutine sec0(n,t) + + ! Simple execution timer. + ! call sec0(0,t) + ! ... statements to be timed ... + ! call sec0(1,t) + ! print*,'Execution time:',t + + integer*8 count0,count1,clkfreq + save count0 + + call system_clock(count1,clkfreq) + if(n.eq.0) then + count0=count1 + return + else + t=float(count1-count0)/float(clkfreq) + endif + + return +end subroutine sec0 diff --git a/wsjtx_lib/lib/sec_midn.f90 b/wsjtx_lib/lib/sec_midn.f90 new file mode 100644 index 0000000..0bbe62c --- /dev/null +++ b/wsjtx_lib/lib/sec_midn.f90 @@ -0,0 +1,11 @@ +real function sec_midn() + sec_midn=secnds(0.0) + return +end function sec_midn + +subroutine sleep_msec(n) + + call usleep(1000*n) + + return +end subroutine sleep_msec diff --git a/wsjtx_lib/lib/setup65.f90 b/wsjtx_lib/lib/setup65.f90 new file mode 100644 index 0000000..d47974c --- /dev/null +++ b/wsjtx_lib/lib/setup65.f90 @@ -0,0 +1,96 @@ +subroutine setup65 + +! Defines arrays related to the JT65 pseudo-random synchronizing pattern. +! Executed at program start. + + use jt65_mod + integer nprc(126) + +! JT65 + data nprc/ & + 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & + 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & + 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & + 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & + 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & + 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & + 1,1,1,1,1,1/ + data mr2/0/ !Silence compiler warning + +! Put the appropriate pseudo-random sequence into pr + nsym=126 + do i=1,nsym + pr(i)=2*nprc(i)-1 + enddo + +! Determine locations of data and reference symbols + k=0 + mr1=0 + do i=1,nsym + if(pr(i).lt.0.0) then + k=k+1 + mdat(k)=i + else + mr2=i + if(mr1.eq.0) mr1=i + endif + enddo + nsig=k + +! Determine the reference symbols for each data symbol. + do k=1,nsig + m=mdat(k) + mref(k,1)=mr1 + do n=1,10 !Get ref symbol before data + if((m-n).gt.0) then + if (pr(m-n).gt.0.0) go to 10 + endif + enddo + go to 12 +10 mref(k,1)=m-n +12 mref(k,2)=mr2 + do n=1,10 !Get ref symbol after data + if((m+n).le.nsym) then + if (pr(m+n).gt.0.0) go to 20 + endif + enddo + cycle +20 mref(k,2)=m+n + enddo + +! Now do it all again, using opposite logic on pr(i) + k=0 + mr1=0 + do i=1,nsym + if(pr(i).gt.0.0) then + k=k+1 + mdat2(k)=i + else + mr2=i + if(mr1.eq.0) mr1=i + endif + enddo + nsig=k + + do k=1,nsig + m=mdat2(k) + mref2(k,1)=mr1 + do n=1,10 + if((m-n).gt.0) then + if (pr(m-n).lt.0.0) go to 110 + endif + enddo + go to 112 +110 mref2(k,1)=m-n +112 mref2(k,2)=mr2 + do n=1,10 + if((m+n).le.nsym) then + if (pr(m+n).lt.0.0) go to 120 + endif + enddo + cycle +120 mref2(k,2)=m+n + enddo + + return +end subroutine setup65 diff --git a/wsjtx_lib/lib/sfrsd.f90 b/wsjtx_lib/lib/sfrsd.f90 new file mode 100644 index 0000000..49dc7bc --- /dev/null +++ b/wsjtx_lib/lib/sfrsd.f90 @@ -0,0 +1,121 @@ +subroutine sfrsd(mrsym,mrprob,mr2sym,mr2prob,ntrials,correct,indexes, & + param,ntry) + + integer mrsym(0:62),mrprob(0:62),mr2sym(0:62),mr2prob(0:62) + integer correct(0:62),indexes(0:62),probs(0:62),thresh0(0:62) + integer rxdat(0:62),rxdat2(0:62),rxprob(0:62),rxprob2(0:62) + integer workdat(0:62),era_pos(0:50) + integer perr(0:7,0:7) + integer param(0:7) + real ratio0(0:62) + + call init_rs_int() + do i=0,62 + rxdat(i)=mrsym(62-i) + rxdat2(i)=mr2sym(62-i) + rxprob(i)=mrprob(62-i) + rxprob2(i)=mr2prob(62-i) + enddo + + do i=0,62 + indexes(i)=i + probs(i)=rxprob(i) + enddo + + do ip=1,62 + do k=0,63-ip + if(probs(k).lt.probs(k+1)) then + ntmp=probs(k) + probs(k)=probs(k+1) + probs(k+1)=ntmp + ntmp=indexes(k) + indexes(k)=indexes(k+1) + indexes(k+1)=ntmp + endif + enddo + enddo + + era_pos=0 + numera=0 + workdat=rxdat + call decode_rs_int() + if(nerr.ge.0) then + correct=workdat + param=0 + return + endif + + call random_seed() + + ncandidates=0 + nsum=0 + do i=0,62 + nsum=nsum+rxprob(i) + j=indexes(62-i) + ratio0(i)=float(rxprob2(j))/(float(rxprob(j))+0.01) + ii=int(7.999*ratio0(i)) + jj=(62-i)/8 + thresh0(i)=nint(1.3*perr(jj,ii)) + enddo + if(nsum.eq.0) return + + do k=0,ntrials + era_pos=0 + workdat=rxdat + numera=0 + do i=0,62 + j=indexes(62-i) + thresh=thresh0(i) + ir=rand() + if(...) then + era_pos(numera)=j + numera=numera+1 + endif + enddo + + call decode_rs_int() + if(nerr.ge.0) then + ncandidates=ncandidates+1 + nhard=0 + nsoft=0 + nsofter=0 + do i=0,62 + if(workdat(i).ne.rxdat(i)) then + nhard=nhard+1 + nsofter=nsofter+rxprob(i) + if(workdat(i).ne.rxdat2(i)) nsoft=nsoft+rxprob(i) + else + nsofter=nsofter-rxprob(i) + endif + enddo + nsoft=63*nsoft/nsum + nsofter=63*nsofter/nsum + ntotal=nsoft+nhard + if(ntotal.lt.ntotal_min) then + nsoft_min=nsoft + nhard_min=nhard + nsofter_min=nsofter + ntotal_min=ntotal + correct=workdat + nera_best=numera + ntry=k + endif + if(ntotal_min.lt.72 .and. nhard_min.lt.42) exit + endif + if(k.eq.ntrials-1) ntry=k+1 + enddo + + if(ntotal_min.ge.76 .or. nhard.ge.44) nhard_min=-1 + + param(0)=ncandidates + param(1)=nhard_min + param(2)=nsoft_min + param(3)=nera_best + param(4)=nsofter_min + if(param(0).eq.0) param(2)=-1 + + return +end subroutine sfrsd + + + diff --git a/wsjtx_lib/lib/sgran.c b/wsjtx_lib/lib/sgran.c new file mode 100644 index 0000000..b48222e --- /dev/null +++ b/wsjtx_lib/lib/sgran.c @@ -0,0 +1,7 @@ +#include "init_random_seed.h" + +/* Fortran wrapper to seed the C library rand */ +void sgran_(void) +{ + init_random_seed(); +} diff --git a/wsjtx_lib/lib/sh65.f90 b/wsjtx_lib/lib/sh65.f90 new file mode 100644 index 0000000..09bef9c --- /dev/null +++ b/wsjtx_lib/lib/sh65.f90 @@ -0,0 +1,94 @@ +subroutine sh65(cx,n5,mode65,ntol,xdf,nspecial,snrdb) + parameter(NFFT=2048,NH=NFFT/2) + complex cx(n5) !Centered on nfqso, sample rate 1378.125 + complex c(0:NFFT-1) + real s(-NH+1:NH) + real ss(-NH+1:NH,16) + real sigmax(16) + integer ipk(16) + + ss=0. + + jstep=NFFT/8 + nblks=272 + ia=-jstep+1 + do iblk=1,nblks + n=mod(iblk-1,16) + 1 + ia=ia+jstep + ib=ia+NFFT-1 + c=cx(ia:ib) + call four2a(c,nfft,1,1,1) !c2c FFT + do i=0,NFFT-1 + j=i + if(j.gt.NH) j=j-NFFT + ss(j,n)=ss(j,n) + real(c(i))**2 + aimag(c(i))**2 + enddo + enddo + + s=1.e-5*s + ss=1.e-5*ss + df=1378.1285/NFFT + nfac=40*mode65 + dtstep=0.25/df + + do i=1,2*mode65 + call smo121(ss,16*NFFT) + enddo + +! do i=-NH+1,NH +! write(72,3072) i*df,(ss(i,j),j=1,16) +!3072 format(17f7.1) +! enddo + +! Define freq range to be searched. Upper tone is at sync freq + 4*nfac*df Hz + fa=-ntol + fb=ntol + ia2=max(-NH+1,nint(fa/df)) + ib2=min(NH,nint(fb/df + 4.1*nfac)) + +! Find strongest line in each of the 16 phases + sbest=0. + snrbest=0. + nbest=1 + ipk=0 + do n=1,16 + sigmax(n)=0. + do i=ia2,ib2 + sig=ss(i,n) + if(sig.ge.sigmax(n)) then + ipk(n)=i + sigmax(n)=sig + if(sig.ge.sbest) then + sbest=sig + nbest=n + endif + endif + enddo + enddo + n2best=nbest+8 + if(n2best.gt.16) n2best=nbest-8 + xdf=min(ipk(nbest),ipk(n2best))*df + nspecial=0 + if(abs(xdf).le.ntol) then + idiff=abs(ipk(nbest)-ipk(n2best)) + xk=float(idiff)/nfac + k=nint(xk) + iderr=nint((xk-k)*nfac) +! maxerr=nint(0.008*abs(idiff) + 0.51) + maxerr=nint(0.02*abs(idiff) + 0.51) !### Better test ??? ### +! write(71,3001) nbest,n2best,idiff,iderr,maxerr,k, & +! ipk(nbest)*df,ipk(n2best)*df,sbest +!3001 format(6i4,2f7.1,f7.2) + if(abs(iderr).le.maxerr .and. k.ge.2 .and. k.le.4) nspecial=k + snrdb=-30.0 + if(nspecial.gt.0) then + call sh65snr(ss(ia2,nbest),ib2-ia2+1,snr1) + call sh65snr(ss(ia2,n2best),ib2-ia2+1,snr2) + snr=0.5*(snr1+snr2) + snrdb=db(snr) - db(2500.0/df) - db(sqrt(nblks/4.0)) + 8.0 + endif + if(snr1.lt.4.0 .or. snr2.lt.4.0 .or. snr.lt.5.0) nspecial=0 + endif + + return +end subroutine sh65 diff --git a/wsjtx_lib/lib/sh65snr.f90 b/wsjtx_lib/lib/sh65snr.f90 new file mode 100644 index 0000000..3d44901 --- /dev/null +++ b/wsjtx_lib/lib/sh65snr.f90 @@ -0,0 +1,36 @@ +subroutine sh65snr(x,nz,snr) + + real x(nz) + + ipk=0 !Shut up compiler warnings. -db + smax=-1.e30 + do i=1,nz + if(x(i).gt.smax) then + ipk=i + smax=x(i) + endif + s=s+x(i) + enddo + + s=0. + ns=0 + do i=1,nz + if(abs(i-ipk).ge.3) then + s=s+x(i) + ns=ns+1 + endif + enddo + ave=s/ns + + sq=0. + do i=1,nz + if(abs(i-ipk).ge.3) then + sq=sq+(x(i)-ave)**2 + ns=ns+1 + endif + enddo + rms=sqrt(sq/(nz-2)) + snr=(smax-ave)/rms + + return +end subroutine sh65snr diff --git a/wsjtx_lib/lib/shell.f90 b/wsjtx_lib/lib/shell.f90 new file mode 100644 index 0000000..d7365bf --- /dev/null +++ b/wsjtx_lib/lib/shell.f90 @@ -0,0 +1,27 @@ +subroutine shell(n,a) + integer n + real a(n) + integer i,j,inc + real v + + inc=1 +1 inc=3*inc+1 + if(inc.le.n) go to 1 +2 inc=inc/3 + + do i=inc+1,n + v=a(i) + j=i +3 if(a(j-inc).gt.v) then + a(j)=a(j-inc) + j=j-inc + if(j.le.inc) go to 4 + go to 3 + endif +4 a(j)=v + enddo + + if(inc.gt.1) go to 2 + + return +end subroutine shell diff --git a/wsjtx_lib/lib/shmem.cpp b/wsjtx_lib/lib/shmem.cpp new file mode 100644 index 0000000..95a8661 --- /dev/null +++ b/wsjtx_lib/lib/shmem.cpp @@ -0,0 +1,20 @@ +#include +#include + +// Multiple instances: KK1D, 17 Jul 2013 +QSharedMemory shmem; + +struct jt9com; + +// C wrappers for a QSharedMemory class instance +extern "C" +{ + bool shmem_create (int nsize) {return shmem.create(nsize);} + void shmem_setkey (char * const mykey) {shmem.setKey(QLatin1String{mykey});} + bool shmem_attach () {return shmem.attach();} + int shmem_size () {return static_cast (shmem.size());} + struct jt9com * shmem_address () {return reinterpret_cast(shmem.data());} + bool shmem_lock () {return shmem.lock();} + bool shmem_unlock () {return shmem.unlock();} + bool shmem_detach () {return shmem.detach();} +} diff --git a/wsjtx_lib/lib/shmem.f90 b/wsjtx_lib/lib/shmem.f90 new file mode 100644 index 0000000..8d9db7d --- /dev/null +++ b/wsjtx_lib/lib/shmem.f90 @@ -0,0 +1,45 @@ +module shmem + ! external routines wrapping the Qt QSharedMemory class + interface + function shmem_create (size) bind(C, name="shmem_create") + use iso_c_binding, only: c_bool, c_int + logical(c_bool) :: shmem_create + integer(c_int), value, intent(in) :: size + end function shmem_create + + subroutine shmem_setkey (key) bind(C, name="shmem_setkey") + use iso_c_binding, only: c_bool, c_char + character(kind=c_char), intent(in) :: key(*) + end subroutine shmem_setkey + + function shmem_attach () bind(C, name="shmem_attach") + use iso_c_binding, only: c_bool + logical(c_bool) :: shmem_attach + end function shmem_attach + + function shmem_address() bind(C, name="shmem_address") + use, intrinsic :: iso_c_binding, only: c_ptr + type(c_ptr) :: shmem_address + end function shmem_address + + function shmem_size() bind(C, name="shmem_size") + use, intrinsic :: iso_c_binding, only: c_int + integer(c_int) :: shmem_size + end function shmem_size + + function shmem_lock () bind(C, name="shmem_lock") + use iso_c_binding, only: c_bool + logical(c_bool) :: shmem_lock + end function shmem_lock + + function shmem_unlock () bind(C, name="shmem_unlock") + use iso_c_binding, only: c_bool + logical(c_bool) :: shmem_unlock + end function shmem_unlock + + function shmem_detach () bind(C, name="shmem_detach") + use iso_c_binding, only: c_bool + logical(c_bool) :: shmem_detach + end function shmem_detach + end interface +end module shmem diff --git a/wsjtx_lib/lib/slasubs.f b/wsjtx_lib/lib/slasubs.f new file mode 100644 index 0000000..30ba6dd --- /dev/null +++ b/wsjtx_lib/lib/slasubs.f @@ -0,0 +1,3400 @@ + SUBROUTINE sla_CLDJ (IY, IM, ID, DJM, J) +*+ +* - - - - - +* C L D J +* - - - - - +* +* Gregorian Calendar to Modified Julian Date +* +* Given: +* IY,IM,ID int year, month, day in Gregorian calendar +* +* Returned: +* DJM dp modified Julian Date (JD-2400000.5) for 0 hrs +* J int status: +* 0 = OK +* 1 = bad year (MJD not computed) +* 2 = bad month (MJD not computed) +* 3 = bad day (MJD computed) +* +* The year must be -4699 (i.e. 4700BC) or later. +* +* The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55). +* +* Last revision: 27 July 2004 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + INTEGER IY,IM,ID + DOUBLE PRECISION DJM + INTEGER J + +* Month lengths in days + INTEGER MTAB(12) + DATA MTAB / 31,28,31,30,31,30,31,31,30,31,30,31 / + + + +* Preset status. + J = 0 + +* Validate year. + IF ( IY .LT. -4699 ) THEN + J = 1 + ELSE + +* Validate month. + IF ( IM.GE.1 .AND. IM.LE.12 ) THEN + +* Allow for leap year. + IF ( MOD(IY,4) .EQ. 0 ) THEN + MTAB(2) = 29 + ELSE + MTAB(2) = 28 + END IF + IF ( MOD(IY,100).EQ.0 .AND. MOD(IY,400).NE.0 ) + : MTAB(2) = 28 + +* Validate day. + IF ( ID.LT.1 .OR. ID.GT.MTAB(IM) ) J=3 + +* Modified Julian Date. + DJM = DBLE ( ( 1461 * ( IY - (12-IM)/10 + 4712 ) ) / 4 + : + ( 306 * MOD ( IM+9, 12 ) + 5 ) / 10 + : - ( 3 * ( ( IY - (12-IM)/10 + 4900 ) / 100 ) ) / 4 + : + ID - 2399904 ) + +* Bad month. + ELSE + J=2 + END IF + + END IF + + END + DOUBLE PRECISION FUNCTION sla_DAT (UTC) +*+ +* - - - - +* D A T +* - - - - +* +* Increment to be applied to Coordinated Universal Time UTC to give +* International Atomic Time TAI (double precision) +* +* Given: +* UTC d UTC date as a modified JD (JD-2400000.5) +* +* Result: TAI-UTC in seconds +* +* Notes: +* +* 1 The UTC is specified to be a date rather than a time to indicate +* that care needs to be taken not to specify an instant which lies +* within a leap second. Though in most cases UTC can include the +* fractional part, correct behaviour on the day of a leap second +* can only be guaranteed up to the end of the second 23:59:59. +* +* 2 For epochs from 1961 January 1 onwards, the expressions from the +* file ftp://maia.usno.navy.mil/ser7/tai-utc.dat are used. +* +* 3 The 5ms time step at 1961 January 1 is taken from 2.58.1 (p87) of +* the 1992 Explanatory Supplement. +* +* 4 UTC began at 1960 January 1.0 (JD 2436934.5) and it is improper +* to call the routine with an earlier epoch. However, if this +* is attempted, the TAI-UTC expression for the year 1960 is used. +* +* +* :-----------------------------------------: +* : : +* : IMPORTANT : +* : : +* : This routine must be updated on each : +* : occasion that a leap second is : +* : announced : +* : : +* : Latest leap second: 2015 July 1 : +* : : +* :-----------------------------------------: +* +* Last revision: 5 July 2008 +* +* Copyright P.T.Wallace. All rights reserved. +*- + + IMPLICIT NONE + + DOUBLE PRECISION UTC + + DOUBLE PRECISION DT + + + + IF (.FALSE.) THEN + +* - - - - - - - - - - - - - - - - - - - - - - * +* Add new code here on each occasion that a * +* leap second is announced, and update the * +* preamble comments appropriately. * +* - - - - - - - - - - - - - - - - - - - - - - * + +* 2017 January 1 + ELSE IF (UTC.GE.57754D0) THEN + DT=37D0 + +* 2015 July 1 + ELSE IF (UTC.GE.57204D0) THEN + DT=36D0 + +* 2012 July 1 + ELSE IF (UTC.GE.56109D0) THEN + DT=35D0 + +* 2009 January 1 + ELSE IF (UTC.GE.54832D0) THEN + DT=34D0 + +* 2006 January 1 + ELSE IF (UTC.GE.53736D0) THEN + DT=33D0 + +* 1999 January 1 + ELSE IF (UTC.GE.51179D0) THEN + DT=32D0 + +* 1997 July 1 + ELSE IF (UTC.GE.50630D0) THEN + DT=31D0 + +* 1996 January 1 + ELSE IF (UTC.GE.50083D0) THEN + DT=30D0 + +* 1994 July 1 + ELSE IF (UTC.GE.49534D0) THEN + DT=29D0 + +* 1993 July 1 + ELSE IF (UTC.GE.49169D0) THEN + DT=28D0 + +* 1992 July 1 + ELSE IF (UTC.GE.48804D0) THEN + DT=27D0 + +* 1991 January 1 + ELSE IF (UTC.GE.48257D0) THEN + DT=26D0 + +* 1990 January 1 + ELSE IF (UTC.GE.47892D0) THEN + DT=25D0 + +* 1988 January 1 + ELSE IF (UTC.GE.47161D0) THEN + DT=24D0 + +* 1985 July 1 + ELSE IF (UTC.GE.46247D0) THEN + DT=23D0 + +* 1983 July 1 + ELSE IF (UTC.GE.45516D0) THEN + DT=22D0 + +* 1982 July 1 + ELSE IF (UTC.GE.45151D0) THEN + DT=21D0 + +* 1981 July 1 + ELSE IF (UTC.GE.44786D0) THEN + DT=20D0 + +* 1980 January 1 + ELSE IF (UTC.GE.44239D0) THEN + DT=19D0 + +* 1979 January 1 + ELSE IF (UTC.GE.43874D0) THEN + DT=18D0 + +* 1978 January 1 + ELSE IF (UTC.GE.43509D0) THEN + DT=17D0 + +* 1977 January 1 + ELSE IF (UTC.GE.43144D0) THEN + DT=16D0 + +* 1976 January 1 + ELSE IF (UTC.GE.42778D0) THEN + DT=15D0 + +* 1975 January 1 + ELSE IF (UTC.GE.42413D0) THEN + DT=14D0 + +* 1974 January 1 + ELSE IF (UTC.GE.42048D0) THEN + DT=13D0 + +* 1973 January 1 + ELSE IF (UTC.GE.41683D0) THEN + DT=12D0 + +* 1972 July 1 + ELSE IF (UTC.GE.41499D0) THEN + DT=11D0 + +* 1972 January 1 + ELSE IF (UTC.GE.41317D0) THEN + DT=10D0 + +* 1968 February 1 + ELSE IF (UTC.GE.39887D0) THEN + DT=4.2131700D0+(UTC-39126D0)*0.002592D0 + +* 1966 January 1 + ELSE IF (UTC.GE.39126D0) THEN + DT=4.3131700D0+(UTC-39126D0)*0.002592D0 + +* 1965 September 1 + ELSE IF (UTC.GE.39004D0) THEN + DT=3.8401300D0+(UTC-38761D0)*0.001296D0 + +* 1965 July 1 + ELSE IF (UTC.GE.38942D0) THEN + DT=3.7401300D0+(UTC-38761D0)*0.001296D0 + +* 1965 March 1 + ELSE IF (UTC.GE.38820D0) THEN + DT=3.6401300D0+(UTC-38761D0)*0.001296D0 + +* 1965 January 1 + ELSE IF (UTC.GE.38761D0) THEN + DT=3.5401300D0+(UTC-38761D0)*0.001296D0 + +* 1964 September 1 + ELSE IF (UTC.GE.38639D0) THEN + DT=3.4401300D0+(UTC-38761D0)*0.001296D0 + +* 1964 April 1 + ELSE IF (UTC.GE.38486D0) THEN + DT=3.3401300D0+(UTC-38761D0)*0.001296D0 + +* 1964 January 1 + ELSE IF (UTC.GE.38395D0) THEN + DT=3.2401300D0+(UTC-38761D0)*0.001296D0 + +* 1963 November 1 + ELSE IF (UTC.GE.38334D0) THEN + DT=1.9458580D0+(UTC-37665D0)*0.0011232D0 + +* 1962 January 1 + ELSE IF (UTC.GE.37665D0) THEN + DT=1.8458580D0+(UTC-37665D0)*0.0011232D0 + +* 1961 August 1 + ELSE IF (UTC.GE.37512D0) THEN + DT=1.3728180D0+(UTC-37300D0)*0.001296D0 + +* 1961 January 1 + ELSE IF (UTC.GE.37300D0) THEN + DT=1.4228180D0+(UTC-37300D0)*0.001296D0 + +* Before that + ELSE + DT=1.4178180D0+(UTC-37300D0)*0.001296D0 + + END IF + + sla_DAT=DT + + END + SUBROUTINE sla_DC62S (V, A, B, R, AD, BD, RD) +*+ +* - - - - - - +* D C 6 2 S +* - - - - - - +* +* Conversion of position & velocity in Cartesian coordinates +* to spherical coordinates (double precision) +* +* Given: +* V d(6) Cartesian position & velocity vector +* +* Returned: +* A d longitude (radians) +* B d latitude (radians) +* R d radial coordinate +* AD d longitude derivative (radians per unit time) +* BD d latitude derivative (radians per unit time) +* RD d radial derivative +* +* P.T.Wallace Starlink 28 April 1996 +* +* Copyright (C) 1996 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION V(6),A,B,R,AD,BD,RD + + DOUBLE PRECISION X,Y,Z,XD,YD,ZD,RXY2,RXY,R2,XYP + + + +* Components of position/velocity vector + X=V(1) + Y=V(2) + Z=V(3) + XD=V(4) + YD=V(5) + ZD=V(6) + +* Component of R in XY plane squared + RXY2=X*X+Y*Y + +* Modulus squared + R2=RXY2+Z*Z + +* Protection against null vector + IF (R2.EQ.0D0) THEN + X=XD + Y=YD + Z=ZD + RXY2=X*X+Y*Y + R2=RXY2+Z*Z + END IF + +* Position and velocity in spherical coordinates + RXY=SQRT(RXY2) + XYP=X*XD+Y*YD + IF (RXY2.NE.0D0) THEN + A=ATAN2(Y,X) + B=ATAN2(Z,RXY) + AD=(X*YD-Y*XD)/RXY2 + BD=(ZD*RXY2-Z*XYP)/(R2*RXY) + ELSE + A=0D0 + IF (Z.NE.0D0) THEN + B=ATAN2(Z,RXY) + ELSE + B=0D0 + END IF + AD=0D0 + BD=0D0 + END IF + R=SQRT(R2) + IF (R.NE.0D0) THEN + RD=(XYP+Z*ZD)/R + ELSE + RD=0D0 + END IF + + END + SUBROUTINE sla_DCC2S (V, A, B) +*+ +* - - - - - - +* D C C 2 S +* - - - - - - +* +* Cartesian to spherical coordinates (double precision) +* +* Given: +* V d(3) x,y,z vector +* +* Returned: +* A,B d spherical coordinates in radians +* +* The spherical coordinates are longitude (+ve anticlockwise looking +* from the +ve latitude pole) and latitude. The Cartesian coordinates +* are right handed, with the x axis at zero longitude and latitude, and +* the z axis at the +ve latitude pole. +* +* If V is null, zero A and B are returned. At either pole, zero A is +* returned. +* +* Last revision: 22 July 2004 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION V(3),A,B + + DOUBLE PRECISION X,Y,Z,R + + + X = V(1) + Y = V(2) + Z = V(3) + R = SQRT(X*X+Y*Y) + + IF (R.EQ.0D0) THEN + A = 0D0 + ELSE + A = ATAN2(Y,X) + END IF + + IF (Z.EQ.0D0) THEN + B = 0D0 + ELSE + B = ATAN2(Z,R) + END IF + + END + SUBROUTINE sla_DCS2C (A, B, V) +*+ +* - - - - - - +* D C S 2 C +* - - - - - - +* +* Spherical coordinates to direction cosines (double precision) +* +* Given: +* A,B d spherical coordinates in radians +* (RA,Dec), (long,lat) etc. +* +* Returned: +* V d(3) x,y,z unit vector +* +* The spherical coordinates are longitude (+ve anticlockwise looking +* from the +ve latitude pole) and latitude. The Cartesian coordinates +* are right handed, with the x axis at zero longitude and latitude, and +* the z axis at the +ve latitude pole. +* +* Last revision: 26 December 2004 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION A,B,V(3) + + DOUBLE PRECISION COSB + + + COSB = COS(B) + + V(1) = COS(A)*COSB + V(2) = SIN(A)*COSB + V(3) = SIN(B) + + END + SUBROUTINE sla_DE2H (HA, DEC, PHI, AZ, EL) +*+ +* - - - - - +* D E 2 H +* - - - - - +* +* Equatorial to horizon coordinates: HA,Dec to Az,El +* +* (double precision) +* +* Given: +* HA d hour angle +* DEC d declination +* PHI d observatory latitude +* +* Returned: +* AZ d azimuth +* EL d elevation +* +* Notes: +* +* 1) All the arguments are angles in radians. +* +* 2) Azimuth is returned in the range 0-2pi; north is zero, +* and east is +pi/2. Elevation is returned in the range +* +/-pi/2. +* +* 3) The latitude must be geodetic. In critical applications, +* corrections for polar motion should be applied. +* +* 4) In some applications it will be important to specify the +* correct type of hour angle and declination in order to +* produce the required type of azimuth and elevation. In +* particular, it may be important to distinguish between +* elevation as affected by refraction, which would +* require the "observed" HA,Dec, and the elevation +* in vacuo, which would require the "topocentric" HA,Dec. +* If the effects of diurnal aberration can be neglected, the +* "apparent" HA,Dec may be used instead of the topocentric +* HA,Dec. +* +* 5) No range checking of arguments is carried out. +* +* 6) In applications which involve many such calculations, rather +* than calling the present routine it will be more efficient to +* use inline code, having previously computed fixed terms such +* as sine and cosine of latitude, and (for tracking a star) +* sine and cosine of declination. +* +* P.T.Wallace Starlink 9 July 1994 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION HA,DEC,PHI,AZ,EL + + DOUBLE PRECISION D2PI + PARAMETER (D2PI=6.283185307179586476925286766559D0) + + DOUBLE PRECISION SH,CH,SD,CD,SP,CP,X,Y,Z,R,A + + +* Useful trig functions + SH=SIN(HA) + CH=COS(HA) + SD=SIN(DEC) + CD=COS(DEC) + SP=SIN(PHI) + CP=COS(PHI) + +* Az,El as x,y,z + X=-CH*CD*SP+SD*CP + Y=-SH*CD + Z=CH*CD*CP+SD*SP + +* To spherical + R=SQRT(X*X+Y*Y) + IF (R.EQ.0D0) THEN + A=0D0 + ELSE + A=ATAN2(Y,X) + END IF + IF (A.LT.0D0) A=A+D2PI + AZ=A + EL=ATAN2(Z,R) + + END + SUBROUTINE sla_DEULER (ORDER, PHI, THETA, PSI, RMAT) +*+ +* - - - - - - - +* D E U L E R +* - - - - - - - +* +* Form a rotation matrix from the Euler angles - three successive +* rotations about specified Cartesian axes (double precision) +* +* Given: +* ORDER c*(*) specifies about which axes the rotations occur +* PHI d 1st rotation (radians) +* THETA d 2nd rotation ( " ) +* PSI d 3rd rotation ( " ) +* +* Returned: +* RMAT d(3,3) rotation matrix +* +* A rotation is positive when the reference frame rotates +* anticlockwise as seen looking towards the origin from the +* positive region of the specified axis. +* +* The characters of ORDER define which axes the three successive +* rotations are about. A typical value is 'ZXZ', indicating that +* RMAT is to become the direction cosine matrix corresponding to +* rotations of the reference frame through PHI radians about the +* old Z-axis, followed by THETA radians about the resulting X-axis, +* then PSI radians about the resulting Z-axis. +* +* The axis names can be any of the following, in any order or +* combination: X, Y, Z, uppercase or lowercase, 1, 2, 3. Normal +* axis labelling/numbering conventions apply; the xyz (=123) +* triad is right-handed. Thus, the 'ZXZ' example given above +* could be written 'zxz' or '313' (or even 'ZxZ' or '3xZ'). ORDER +* is terminated by length or by the first unrecognized character. +* +* Fewer than three rotations are acceptable, in which case the later +* angle arguments are ignored. If all rotations are zero, the +* identity matrix is produced. +* +* P.T.Wallace Starlink 23 May 1997 +* +* Copyright (C) 1997 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + CHARACTER*(*) ORDER + DOUBLE PRECISION PHI,THETA,PSI,RMAT(3,3) + + INTEGER J,I,L,N,K + DOUBLE PRECISION RESULT(3,3),ROTN(3,3),ANGLE,S,C,W,WM(3,3) + CHARACTER AXIS + + + +* Initialize result matrix + DO J=1,3 + DO I=1,3 + IF (I.NE.J) THEN + RESULT(I,J) = 0D0 + ELSE + RESULT(I,J) = 1D0 + END IF + END DO + END DO + +* Establish length of axis string + L = LEN(ORDER) + +* Look at each character of axis string until finished + DO N=1,3 + IF (N.LE.L) THEN + +* Initialize rotation matrix for the current rotation + DO J=1,3 + DO I=1,3 + IF (I.NE.J) THEN + ROTN(I,J) = 0D0 + ELSE + ROTN(I,J) = 1D0 + END IF + END DO + END DO + +* Pick up the appropriate Euler angle and take sine & cosine + IF (N.EQ.1) THEN + ANGLE = PHI + ELSE IF (N.EQ.2) THEN + ANGLE = THETA + ELSE + ANGLE = PSI + END IF + S = SIN(ANGLE) + C = COS(ANGLE) + +* Identify the axis + AXIS = ORDER(N:N) + IF (AXIS.EQ.'X'.OR. + : AXIS.EQ.'x'.OR. + : AXIS.EQ.'1') THEN + +* Matrix for x-rotation + ROTN(2,2) = C + ROTN(2,3) = S + ROTN(3,2) = -S + ROTN(3,3) = C + + ELSE IF (AXIS.EQ.'Y'.OR. + : AXIS.EQ.'y'.OR. + : AXIS.EQ.'2') THEN + +* Matrix for y-rotation + ROTN(1,1) = C + ROTN(1,3) = -S + ROTN(3,1) = S + ROTN(3,3) = C + + ELSE IF (AXIS.EQ.'Z'.OR. + : AXIS.EQ.'z'.OR. + : AXIS.EQ.'3') THEN + +* Matrix for z-rotation + ROTN(1,1) = C + ROTN(1,2) = S + ROTN(2,1) = -S + ROTN(2,2) = C + + ELSE + +* Unrecognized character - fake end of string + L = 0 + + END IF + +* Apply the current rotation (matrix ROTN x matrix RESULT) + DO I=1,3 + DO J=1,3 + W = 0D0 + DO K=1,3 + W = W+ROTN(I,K)*RESULT(K,J) + END DO + WM(I,J) = W + END DO + END DO + DO J=1,3 + DO I=1,3 + RESULT(I,J) = WM(I,J) + END DO + END DO + + END IF + + END DO + +* Copy the result + DO J=1,3 + DO I=1,3 + RMAT(I,J) = RESULT(I,J) + END DO + END DO + + END + SUBROUTINE sla_DMOON (DATE, PV) +*+ +* - - - - - - +* D M O O N +* - - - - - - +* +* Approximate geocentric position and velocity of the Moon +* (double precision) +* +* Given: +* DATE D TDB (loosely ET) as a Modified Julian Date +* (JD-2400000.5) +* +* Returned: +* PV D(6) Moon x,y,z,xdot,ydot,zdot, mean equator and +* equinox of date (AU, AU/s) +* +* Notes: +* +* 1 This routine is a full implementation of the algorithm +* published by Meeus (see reference). +* +* 2 Meeus quotes accuracies of 10 arcsec in longitude, 3 arcsec in +* latitude and 0.2 arcsec in HP (equivalent to about 20 km in +* distance). Comparison with JPL DE200 over the interval +* 1960-2025 gives RMS errors of 3.7 arcsec and 83 mas/hour in +* longitude, 2.3 arcsec and 48 mas/hour in latitude, 11 km +* and 81 mm/s in distance. The maximum errors over the same +* interval are 18 arcsec and 0.50 arcsec/hour in longitude, +* 11 arcsec and 0.24 arcsec/hour in latitude, 40 km and 0.29 m/s +* in distance. +* +* 3 The original algorithm is expressed in terms of the obsolete +* timescale Ephemeris Time. Either TDB or TT can be used, but +* not UT without incurring significant errors (30 arcsec at +* the present time) due to the Moon's 0.5 arcsec/sec movement. +* +* 4 The algorithm is based on pre IAU 1976 standards. However, +* the result has been moved onto the new (FK5) equinox, an +* adjustment which is in any case much smaller than the +* intrinsic accuracy of the procedure. +* +* 5 Velocity is obtained by a complete analytical differentiation +* of the Meeus model. +* +* Reference: +* Meeus, l'Astronomie, June 1984, p348. +* +* P.T.Wallace Starlink 22 January 1998 +* +* Copyright (C) 1998 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DATE,PV(6) + +* Degrees, arcseconds and seconds of time to radians + DOUBLE PRECISION D2R,DAS2R,DS2R + PARAMETER (D2R=0.0174532925199432957692369D0, + : DAS2R=4.848136811095359935899141D-6, + : DS2R=7.272205216643039903848712D-5) + +* Seconds per Julian century (86400*36525) + DOUBLE PRECISION CJ + PARAMETER (CJ=3155760000D0) + +* Julian epoch of B1950 + DOUBLE PRECISION B1950 + PARAMETER (B1950=1949.9997904423D0) + +* Earth equatorial radius in AU ( = 6378.137 / 149597870 ) + DOUBLE PRECISION ERADAU + PARAMETER (ERADAU=4.2635212653763D-5) + + DOUBLE PRECISION T,THETA,SINOM,COSOM,DOMCOM,WA,DWA,WB,DWB,WOM, + : DWOM,SINWOM,COSWOM,V,DV,COEFF,EMN,EMPN,DN,FN,EN, + : DEN,DTHETA,FTHETA,EL,DEL,B,DB,BF,DBF,P,DP,SP,R, + : DR,X,Y,Z,XD,YD,ZD,SEL,CEL,SB,CB,RCB,RBD,W,EPJ, + : EQCOR,EPS,SINEPS,COSEPS,ES,EC + INTEGER N,I + +* +* Coefficients for fundamental arguments +* +* at J1900: T**0, T**1, T**2, T**3 +* at epoch: T**0, T**1 +* +* Units are degrees for position and Julian centuries for time +* + +* Moon's mean longitude + DOUBLE PRECISION ELP0,ELP1,ELP2,ELP3,ELP,DELP + PARAMETER (ELP0=270.434164D0, + : ELP1=481267.8831D0, + : ELP2=-0.001133D0, + : ELP3=0.0000019D0) + +* Sun's mean anomaly + DOUBLE PRECISION EM0,EM1,EM2,EM3,EM,DEM + PARAMETER (EM0=358.475833D0, + : EM1=35999.0498D0, + : EM2=-0.000150D0, + : EM3=-0.0000033D0) + +* Moon's mean anomaly + DOUBLE PRECISION EMP0,EMP1,EMP2,EMP3,EMP,DEMP + PARAMETER (EMP0=296.104608D0, + : EMP1=477198.8491D0, + : EMP2=0.009192D0, + : EMP3=0.0000144D0) + +* Moon's mean elongation + DOUBLE PRECISION D0,D1,D2,D3,D,DD + PARAMETER (D0=350.737486D0, + : D1=445267.1142D0, + : D2=-0.001436D0, + : D3=0.0000019D0) + +* Mean distance of the Moon from its ascending node + DOUBLE PRECISION F0,F1,F2,F3,F,DF + PARAMETER (F0=11.250889D0, + : F1=483202.0251D0, + : F2=-0.003211D0, + : F3=-0.0000003D0) + +* Longitude of the Moon's ascending node + DOUBLE PRECISION OM0,OM1,OM2,OM3,OM,DOM + PARAMETER (OM0=259.183275D0, + : OM1=-1934.1420D0, + : OM2=0.002078D0, + : OM3=0.0000022D0) + +* Coefficients for (dimensionless) E factor + DOUBLE PRECISION E1,E2,E,DE,ESQ,DESQ + PARAMETER (E1=-0.002495D0,E2=-0.00000752D0) + +* Coefficients for periodic variations etc + DOUBLE PRECISION PAC,PA0,PA1 + PARAMETER (PAC=0.000233D0,PA0=51.2D0,PA1=20.2D0) + DOUBLE PRECISION PBC + PARAMETER (PBC=-0.001778D0) + DOUBLE PRECISION PCC + PARAMETER (PCC=0.000817D0) + DOUBLE PRECISION PDC + PARAMETER (PDC=0.002011D0) + DOUBLE PRECISION PEC,PE0,PE1,PE2 + PARAMETER (PEC=0.003964D0, + : PE0=346.560D0,PE1=132.870D0,PE2=-0.0091731D0) + DOUBLE PRECISION PFC + PARAMETER (PFC=0.001964D0) + DOUBLE PRECISION PGC + PARAMETER (PGC=0.002541D0) + DOUBLE PRECISION PHC + PARAMETER (PHC=0.001964D0) + DOUBLE PRECISION PIC + PARAMETER (PIC=-0.024691D0) + DOUBLE PRECISION PJC,PJ0,PJ1 + PARAMETER (PJC=-0.004328D0,PJ0=275.05D0,PJ1=-2.30D0) + DOUBLE PRECISION CW1 + PARAMETER (CW1=0.0004664D0) + DOUBLE PRECISION CW2 + PARAMETER (CW2=0.0000754D0) + +* +* Coefficients for Moon position +* +* Tx(N) = coefficient of L, B or P term (deg) +* ITx(N,1-5) = coefficients of M, M', D, F, E**n in argument +* + INTEGER NL,NB,NP + PARAMETER (NL=50,NB=45,NP=31) + DOUBLE PRECISION TL(NL),TB(NB),TP(NP) + INTEGER ITL(5,NL),ITB(5,NB),ITP(5,NP) +* +* Longitude +* M M' D F n + DATA TL( 1)/ +6.288750D0 /, + : (ITL(I, 1),I=1,5)/ +0, +1, +0, +0, 0 / + DATA TL( 2)/ +1.274018D0 /, + : (ITL(I, 2),I=1,5)/ +0, -1, +2, +0, 0 / + DATA TL( 3)/ +0.658309D0 /, + : (ITL(I, 3),I=1,5)/ +0, +0, +2, +0, 0 / + DATA TL( 4)/ +0.213616D0 /, + : (ITL(I, 4),I=1,5)/ +0, +2, +0, +0, 0 / + DATA TL( 5)/ -0.185596D0 /, + : (ITL(I, 5),I=1,5)/ +1, +0, +0, +0, 1 / + DATA TL( 6)/ -0.114336D0 /, + : (ITL(I, 6),I=1,5)/ +0, +0, +0, +2, 0 / + DATA TL( 7)/ +0.058793D0 /, + : (ITL(I, 7),I=1,5)/ +0, -2, +2, +0, 0 / + DATA TL( 8)/ +0.057212D0 /, + : (ITL(I, 8),I=1,5)/ -1, -1, +2, +0, 1 / + DATA TL( 9)/ +0.053320D0 /, + : (ITL(I, 9),I=1,5)/ +0, +1, +2, +0, 0 / + DATA TL(10)/ +0.045874D0 /, + : (ITL(I,10),I=1,5)/ -1, +0, +2, +0, 1 / + DATA TL(11)/ +0.041024D0 /, + : (ITL(I,11),I=1,5)/ -1, +1, +0, +0, 1 / + DATA TL(12)/ -0.034718D0 /, + : (ITL(I,12),I=1,5)/ +0, +0, +1, +0, 0 / + DATA TL(13)/ -0.030465D0 /, + : (ITL(I,13),I=1,5)/ +1, +1, +0, +0, 1 / + DATA TL(14)/ +0.015326D0 /, + : (ITL(I,14),I=1,5)/ +0, +0, +2, -2, 0 / + DATA TL(15)/ -0.012528D0 /, + : (ITL(I,15),I=1,5)/ +0, +1, +0, +2, 0 / + DATA TL(16)/ -0.010980D0 /, + : (ITL(I,16),I=1,5)/ +0, -1, +0, +2, 0 / + DATA TL(17)/ +0.010674D0 /, + : (ITL(I,17),I=1,5)/ +0, -1, +4, +0, 0 / + DATA TL(18)/ +0.010034D0 /, + : (ITL(I,18),I=1,5)/ +0, +3, +0, +0, 0 / + DATA TL(19)/ +0.008548D0 /, + : (ITL(I,19),I=1,5)/ +0, -2, +4, +0, 0 / + DATA TL(20)/ -0.007910D0 /, + : (ITL(I,20),I=1,5)/ +1, -1, +2, +0, 1 / + DATA TL(21)/ -0.006783D0 /, + : (ITL(I,21),I=1,5)/ +1, +0, +2, +0, 1 / + DATA TL(22)/ +0.005162D0 /, + : (ITL(I,22),I=1,5)/ +0, +1, -1, +0, 0 / + DATA TL(23)/ +0.005000D0 /, + : (ITL(I,23),I=1,5)/ +1, +0, +1, +0, 1 / + DATA TL(24)/ +0.004049D0 /, + : (ITL(I,24),I=1,5)/ -1, +1, +2, +0, 1 / + DATA TL(25)/ +0.003996D0 /, + : (ITL(I,25),I=1,5)/ +0, +2, +2, +0, 0 / + DATA TL(26)/ +0.003862D0 /, + : (ITL(I,26),I=1,5)/ +0, +0, +4, +0, 0 / + DATA TL(27)/ +0.003665D0 /, + : (ITL(I,27),I=1,5)/ +0, -3, +2, +0, 0 / + DATA TL(28)/ +0.002695D0 /, + : (ITL(I,28),I=1,5)/ -1, +2, +0, +0, 1 / + DATA TL(29)/ +0.002602D0 /, + : (ITL(I,29),I=1,5)/ +0, +1, -2, -2, 0 / + DATA TL(30)/ +0.002396D0 /, + : (ITL(I,30),I=1,5)/ -1, -2, +2, +0, 1 / + DATA TL(31)/ -0.002349D0 /, + : (ITL(I,31),I=1,5)/ +0, +1, +1, +0, 0 / + DATA TL(32)/ +0.002249D0 /, + : (ITL(I,32),I=1,5)/ -2, +0, +2, +0, 2 / + DATA TL(33)/ -0.002125D0 /, + : (ITL(I,33),I=1,5)/ +1, +2, +0, +0, 1 / + DATA TL(34)/ -0.002079D0 /, + : (ITL(I,34),I=1,5)/ +2, +0, +0, +0, 2 / + DATA TL(35)/ +0.002059D0 /, + : (ITL(I,35),I=1,5)/ -2, -1, +2, +0, 2 / + DATA TL(36)/ -0.001773D0 /, + : (ITL(I,36),I=1,5)/ +0, +1, +2, -2, 0 / + DATA TL(37)/ -0.001595D0 /, + : (ITL(I,37),I=1,5)/ +0, +0, +2, +2, 0 / + DATA TL(38)/ +0.001220D0 /, + : (ITL(I,38),I=1,5)/ -1, -1, +4, +0, 1 / + DATA TL(39)/ -0.001110D0 /, + : (ITL(I,39),I=1,5)/ +0, +2, +0, +2, 0 / + DATA TL(40)/ +0.000892D0 /, + : (ITL(I,40),I=1,5)/ +0, +1, -3, +0, 0 / + DATA TL(41)/ -0.000811D0 /, + : (ITL(I,41),I=1,5)/ +1, +1, +2, +0, 1 / + DATA TL(42)/ +0.000761D0 /, + : (ITL(I,42),I=1,5)/ -1, -2, +4, +0, 1 / + DATA TL(43)/ +0.000717D0 /, + : (ITL(I,43),I=1,5)/ -2, +1, +0, +0, 2 / + DATA TL(44)/ +0.000704D0 /, + : (ITL(I,44),I=1,5)/ -2, +1, -2, +0, 2 / + DATA TL(45)/ +0.000693D0 /, + : (ITL(I,45),I=1,5)/ +1, -2, +2, +0, 1 / + DATA TL(46)/ +0.000598D0 /, + : (ITL(I,46),I=1,5)/ -1, +0, +2, -2, 1 / + DATA TL(47)/ +0.000550D0 /, + : (ITL(I,47),I=1,5)/ +0, +1, +4, +0, 0 / + DATA TL(48)/ +0.000538D0 /, + : (ITL(I,48),I=1,5)/ +0, +4, +0, +0, 0 / + DATA TL(49)/ +0.000521D0 /, + : (ITL(I,49),I=1,5)/ -1, +0, +4, +0, 1 / + DATA TL(50)/ +0.000486D0 /, + : (ITL(I,50),I=1,5)/ +0, +2, -1, +0, 0 / +* +* Latitude +* M M' D F n + DATA TB( 1)/ +5.128189D0 /, + : (ITB(I, 1),I=1,5)/ +0, +0, +0, +1, 0 / + DATA TB( 2)/ +0.280606D0 /, + : (ITB(I, 2),I=1,5)/ +0, +1, +0, +1, 0 / + DATA TB( 3)/ +0.277693D0 /, + : (ITB(I, 3),I=1,5)/ +0, +1, +0, -1, 0 / + DATA TB( 4)/ +0.173238D0 /, + : (ITB(I, 4),I=1,5)/ +0, +0, +2, -1, 0 / + DATA TB( 5)/ +0.055413D0 /, + : (ITB(I, 5),I=1,5)/ +0, -1, +2, +1, 0 / + DATA TB( 6)/ +0.046272D0 /, + : (ITB(I, 6),I=1,5)/ +0, -1, +2, -1, 0 / + DATA TB( 7)/ +0.032573D0 /, + : (ITB(I, 7),I=1,5)/ +0, +0, +2, +1, 0 / + DATA TB( 8)/ +0.017198D0 /, + : (ITB(I, 8),I=1,5)/ +0, +2, +0, +1, 0 / + DATA TB( 9)/ +0.009267D0 /, + : (ITB(I, 9),I=1,5)/ +0, +1, +2, -1, 0 / + DATA TB(10)/ +0.008823D0 /, + : (ITB(I,10),I=1,5)/ +0, +2, +0, -1, 0 / + DATA TB(11)/ +0.008247D0 /, + : (ITB(I,11),I=1,5)/ -1, +0, +2, -1, 1 / + DATA TB(12)/ +0.004323D0 /, + : (ITB(I,12),I=1,5)/ +0, -2, +2, -1, 0 / + DATA TB(13)/ +0.004200D0 /, + : (ITB(I,13),I=1,5)/ +0, +1, +2, +1, 0 / + DATA TB(14)/ +0.003372D0 /, + : (ITB(I,14),I=1,5)/ -1, +0, -2, +1, 1 / + DATA TB(15)/ +0.002472D0 /, + : (ITB(I,15),I=1,5)/ -1, -1, +2, +1, 1 / + DATA TB(16)/ +0.002222D0 /, + : (ITB(I,16),I=1,5)/ -1, +0, +2, +1, 1 / + DATA TB(17)/ +0.002072D0 /, + : (ITB(I,17),I=1,5)/ -1, -1, +2, -1, 1 / + DATA TB(18)/ +0.001877D0 /, + : (ITB(I,18),I=1,5)/ -1, +1, +0, +1, 1 / + DATA TB(19)/ +0.001828D0 /, + : (ITB(I,19),I=1,5)/ +0, -1, +4, -1, 0 / + DATA TB(20)/ -0.001803D0 /, + : (ITB(I,20),I=1,5)/ +1, +0, +0, +1, 1 / + DATA TB(21)/ -0.001750D0 /, + : (ITB(I,21),I=1,5)/ +0, +0, +0, +3, 0 / + DATA TB(22)/ +0.001570D0 /, + : (ITB(I,22),I=1,5)/ -1, +1, +0, -1, 1 / + DATA TB(23)/ -0.001487D0 /, + : (ITB(I,23),I=1,5)/ +0, +0, +1, +1, 0 / + DATA TB(24)/ -0.001481D0 /, + : (ITB(I,24),I=1,5)/ +1, +1, +0, +1, 1 / + DATA TB(25)/ +0.001417D0 /, + : (ITB(I,25),I=1,5)/ -1, -1, +0, +1, 1 / + DATA TB(26)/ +0.001350D0 /, + : (ITB(I,26),I=1,5)/ -1, +0, +0, +1, 1 / + DATA TB(27)/ +0.001330D0 /, + : (ITB(I,27),I=1,5)/ +0, +0, -1, +1, 0 / + DATA TB(28)/ +0.001106D0 /, + : (ITB(I,28),I=1,5)/ +0, +3, +0, +1, 0 / + DATA TB(29)/ +0.001020D0 /, + : (ITB(I,29),I=1,5)/ +0, +0, +4, -1, 0 / + DATA TB(30)/ +0.000833D0 /, + : (ITB(I,30),I=1,5)/ +0, -1, +4, +1, 0 / + DATA TB(31)/ +0.000781D0 /, + : (ITB(I,31),I=1,5)/ +0, +1, +0, -3, 0 / + DATA TB(32)/ +0.000670D0 /, + : (ITB(I,32),I=1,5)/ +0, -2, +4, +1, 0 / + DATA TB(33)/ +0.000606D0 /, + : (ITB(I,33),I=1,5)/ +0, +0, +2, -3, 0 / + DATA TB(34)/ +0.000597D0 /, + : (ITB(I,34),I=1,5)/ +0, +2, +2, -1, 0 / + DATA TB(35)/ +0.000492D0 /, + : (ITB(I,35),I=1,5)/ -1, +1, +2, -1, 1 / + DATA TB(36)/ +0.000450D0 /, + : (ITB(I,36),I=1,5)/ +0, +2, -2, -1, 0 / + DATA TB(37)/ +0.000439D0 /, + : (ITB(I,37),I=1,5)/ +0, +3, +0, -1, 0 / + DATA TB(38)/ +0.000423D0 /, + : (ITB(I,38),I=1,5)/ +0, +2, +2, +1, 0 / + DATA TB(39)/ +0.000422D0 /, + : (ITB(I,39),I=1,5)/ +0, -3, +2, -1, 0 / + DATA TB(40)/ -0.000367D0 /, + : (ITB(I,40),I=1,5)/ +1, -1, +2, +1, 1 / + DATA TB(41)/ -0.000353D0 /, + : (ITB(I,41),I=1,5)/ +1, +0, +2, +1, 1 / + DATA TB(42)/ +0.000331D0 /, + : (ITB(I,42),I=1,5)/ +0, +0, +4, +1, 0 / + DATA TB(43)/ +0.000317D0 /, + : (ITB(I,43),I=1,5)/ -1, +1, +2, +1, 1 / + DATA TB(44)/ +0.000306D0 /, + : (ITB(I,44),I=1,5)/ -2, +0, +2, -1, 2 / + DATA TB(45)/ -0.000283D0 /, + : (ITB(I,45),I=1,5)/ +0, +1, +0, +3, 0 / +* +* Parallax +* M M' D F n + DATA TP( 1)/ +0.950724D0 /, + : (ITP(I, 1),I=1,5)/ +0, +0, +0, +0, 0 / + DATA TP( 2)/ +0.051818D0 /, + : (ITP(I, 2),I=1,5)/ +0, +1, +0, +0, 0 / + DATA TP( 3)/ +0.009531D0 /, + : (ITP(I, 3),I=1,5)/ +0, -1, +2, +0, 0 / + DATA TP( 4)/ +0.007843D0 /, + : (ITP(I, 4),I=1,5)/ +0, +0, +2, +0, 0 / + DATA TP( 5)/ +0.002824D0 /, + : (ITP(I, 5),I=1,5)/ +0, +2, +0, +0, 0 / + DATA TP( 6)/ +0.000857D0 /, + : (ITP(I, 6),I=1,5)/ +0, +1, +2, +0, 0 / + DATA TP( 7)/ +0.000533D0 /, + : (ITP(I, 7),I=1,5)/ -1, +0, +2, +0, 1 / + DATA TP( 8)/ +0.000401D0 /, + : (ITP(I, 8),I=1,5)/ -1, -1, +2, +0, 1 / + DATA TP( 9)/ +0.000320D0 /, + : (ITP(I, 9),I=1,5)/ -1, +1, +0, +0, 1 / + DATA TP(10)/ -0.000271D0 /, + : (ITP(I,10),I=1,5)/ +0, +0, +1, +0, 0 / + DATA TP(11)/ -0.000264D0 /, + : (ITP(I,11),I=1,5)/ +1, +1, +0, +0, 1 / + DATA TP(12)/ -0.000198D0 /, + : (ITP(I,12),I=1,5)/ +0, -1, +0, +2, 0 / + DATA TP(13)/ +0.000173D0 /, + : (ITP(I,13),I=1,5)/ +0, +3, +0, +0, 0 / + DATA TP(14)/ +0.000167D0 /, + : (ITP(I,14),I=1,5)/ +0, -1, +4, +0, 0 / + DATA TP(15)/ -0.000111D0 /, + : (ITP(I,15),I=1,5)/ +1, +0, +0, +0, 1 / + DATA TP(16)/ +0.000103D0 /, + : (ITP(I,16),I=1,5)/ +0, -2, +4, +0, 0 / + DATA TP(17)/ -0.000084D0 /, + : (ITP(I,17),I=1,5)/ +0, +2, -2, +0, 0 / + DATA TP(18)/ -0.000083D0 /, + : (ITP(I,18),I=1,5)/ +1, +0, +2, +0, 1 / + DATA TP(19)/ +0.000079D0 /, + : (ITP(I,19),I=1,5)/ +0, +2, +2, +0, 0 / + DATA TP(20)/ +0.000072D0 /, + : (ITP(I,20),I=1,5)/ +0, +0, +4, +0, 0 / + DATA TP(21)/ +0.000064D0 /, + : (ITP(I,21),I=1,5)/ -1, +1, +2, +0, 1 / + DATA TP(22)/ -0.000063D0 /, + : (ITP(I,22),I=1,5)/ +1, -1, +2, +0, 1 / + DATA TP(23)/ +0.000041D0 /, + : (ITP(I,23),I=1,5)/ +1, +0, +1, +0, 1 / + DATA TP(24)/ +0.000035D0 /, + : (ITP(I,24),I=1,5)/ -1, +2, +0, +0, 1 / + DATA TP(25)/ -0.000033D0 /, + : (ITP(I,25),I=1,5)/ +0, +3, -2, +0, 0 / + DATA TP(26)/ -0.000030D0 /, + : (ITP(I,26),I=1,5)/ +0, +1, +1, +0, 0 / + DATA TP(27)/ -0.000029D0 /, + : (ITP(I,27),I=1,5)/ +0, +0, -2, +2, 0 / + DATA TP(28)/ -0.000029D0 /, + : (ITP(I,28),I=1,5)/ +1, +2, +0, +0, 1 / + DATA TP(29)/ +0.000026D0 /, + : (ITP(I,29),I=1,5)/ -2, +0, +2, +0, 2 / + DATA TP(30)/ -0.000023D0 /, + : (ITP(I,30),I=1,5)/ +0, +1, -2, +2, 0 / + DATA TP(31)/ +0.000019D0 /, + : (ITP(I,31),I=1,5)/ -1, -1, +4, +0, 1 / + + + +* Centuries since J1900 + T=(DATE-15019.5D0)/36525D0 + +* +* Fundamental arguments (radians) and derivatives (radians per +* Julian century) for the current epoch +* + +* Moon's mean longitude + ELP=D2R*MOD(ELP0+(ELP1+(ELP2+ELP3*T)*T)*T,360D0) + DELP=D2R*(ELP1+(2D0*ELP2+3D0*ELP3*T)*T) + +* Sun's mean anomaly + EM=D2R*MOD(EM0+(EM1+(EM2+EM3*T)*T)*T,360D0) + DEM=D2R*(EM1+(2D0*EM2+3D0*EM3*T)*T) + +* Moon's mean anomaly + EMP=D2R*MOD(EMP0+(EMP1+(EMP2+EMP3*T)*T)*T,360D0) + DEMP=D2R*(EMP1+(2D0*EMP2+3D0*EMP3*T)*T) + +* Moon's mean elongation + D=D2R*MOD(D0+(D1+(D2+D3*T)*T)*T,360D0) + DD=D2R*(D1+(2D0*D2+3D0*D3*T)*T) + +* Mean distance of the Moon from its ascending node + F=D2R*MOD(F0+(F1+(F2+F3*T)*T)*T,360D0) + DF=D2R*(F1+(2D0*F2+3D0*F3*T)*T) + +* Longitude of the Moon's ascending node + OM=D2R*MOD(OM0+(OM1+(OM2+OM3*T)*T)*T,360D0) + DOM=D2R*(OM1+(2D0*OM2+3D0*OM3*T)*T) + SINOM=SIN(OM) + COSOM=COS(OM) + DOMCOM=DOM*COSOM + +* Add the periodic variations + THETA=D2R*(PA0+PA1*T) + WA=SIN(THETA) + DWA=D2R*PA1*COS(THETA) + THETA=D2R*(PE0+(PE1+PE2*T)*T) + WB=PEC*SIN(THETA) + DWB=D2R*PEC*(PE1+2D0*PE2*T)*COS(THETA) + ELP=ELP+D2R*(PAC*WA+WB+PFC*SINOM) + DELP=DELP+D2R*(PAC*DWA+DWB+PFC*DOMCOM) + EM=EM+D2R*PBC*WA + DEM=DEM+D2R*PBC*DWA + EMP=EMP+D2R*(PCC*WA+WB+PGC*SINOM) + DEMP=DEMP+D2R*(PCC*DWA+DWB+PGC*DOMCOM) + D=D+D2R*(PDC*WA+WB+PHC*SINOM) + DD=DD+D2R*(PDC*DWA+DWB+PHC*DOMCOM) + WOM=OM+D2R*(PJ0+PJ1*T) + DWOM=DOM+D2R*PJ1 + SINWOM=SIN(WOM) + COSWOM=COS(WOM) + F=F+D2R*(WB+PIC*SINOM+PJC*SINWOM) + DF=DF+D2R*(DWB+PIC*DOMCOM+PJC*DWOM*COSWOM) + +* E-factor, and square + E=1D0+(E1+E2*T)*T + DE=E1+2D0*E2*T + ESQ=E*E + DESQ=2D0*E*DE + +* +* Series expansions +* + +* Longitude + V=0D0 + DV=0D0 + DO N=NL,1,-1 + COEFF=TL(N) + EMN=DBLE(ITL(1,N)) + EMPN=DBLE(ITL(2,N)) + DN=DBLE(ITL(3,N)) + FN=DBLE(ITL(4,N)) + I=ITL(5,N) + IF (I.EQ.0) THEN + EN=1D0 + DEN=0D0 + ELSE IF (I.EQ.1) THEN + EN=E + DEN=DE + ELSE + EN=ESQ + DEN=DESQ + END IF + THETA=EMN*EM+EMPN*EMP+DN*D+FN*F + DTHETA=EMN*DEM+EMPN*DEMP+DN*DD+FN*DF + FTHETA=SIN(THETA) + V=V+COEFF*FTHETA*EN + DV=DV+COEFF*(COS(THETA)*DTHETA*EN+FTHETA*DEN) + END DO + EL=ELP+D2R*V + DEL=(DELP+D2R*DV)/CJ + +* Latitude + V=0D0 + DV=0D0 + DO N=NB,1,-1 + COEFF=TB(N) + EMN=DBLE(ITB(1,N)) + EMPN=DBLE(ITB(2,N)) + DN=DBLE(ITB(3,N)) + FN=DBLE(ITB(4,N)) + I=ITB(5,N) + IF (I.EQ.0) THEN + EN=1D0 + DEN=0D0 + ELSE IF (I.EQ.1) THEN + EN=E + DEN=DE + ELSE + EN=ESQ + DEN=DESQ + END IF + THETA=EMN*EM+EMPN*EMP+DN*D+FN*F + DTHETA=EMN*DEM+EMPN*DEMP+DN*DD+FN*DF + FTHETA=SIN(THETA) + V=V+COEFF*FTHETA*EN + DV=DV+COEFF*(COS(THETA)*DTHETA*EN+FTHETA*DEN) + END DO + BF=1D0-CW1*COSOM-CW2*COSWOM + DBF=CW1*DOM*SINOM+CW2*DWOM*SINWOM + B=D2R*V*BF + DB=D2R*(DV*BF+V*DBF)/CJ + +* Parallax + V=0D0 + DV=0D0 + DO N=NP,1,-1 + COEFF=TP(N) + EMN=DBLE(ITP(1,N)) + EMPN=DBLE(ITP(2,N)) + DN=DBLE(ITP(3,N)) + FN=DBLE(ITP(4,N)) + I=ITP(5,N) + IF (I.EQ.0) THEN + EN=1D0 + DEN=0D0 + ELSE IF (I.EQ.1) THEN + EN=E + DEN=DE + ELSE + EN=ESQ + DEN=DESQ + END IF + THETA=EMN*EM+EMPN*EMP+DN*D+FN*F + DTHETA=EMN*DEM+EMPN*DEMP+DN*DD+FN*DF + FTHETA=COS(THETA) + V=V+COEFF*FTHETA*EN + DV=DV+COEFF*(-SIN(THETA)*DTHETA*EN+FTHETA*DEN) + END DO + P=D2R*V + DP=D2R*DV/CJ + +* +* Transformation into final form +* + +* Parallax to distance (AU, AU/sec) + SP=SIN(P) + R=ERADAU/SP + DR=-R*DP*COS(P)/SP + +* Longitude, latitude to x,y,z (AU) + SEL=SIN(EL) + CEL=COS(EL) + SB=SIN(B) + CB=COS(B) + RCB=R*CB + RBD=R*DB + W=RBD*SB-CB*DR + X=RCB*CEL + Y=RCB*SEL + Z=R*SB + XD=-Y*DEL-W*CEL + YD=X*DEL-W*SEL + ZD=RBD*CB+SB*DR + +* Julian centuries since J2000 + T=(DATE-51544.5D0)/36525D0 + +* Fricke equinox correction + EPJ=2000D0+T*100D0 + EQCOR=DS2R*(0.035D0+0.00085D0*(EPJ-B1950)) + +* Mean obliquity (IAU 1976) + EPS=DAS2R*(84381.448D0+(-46.8150D0+(-0.00059D0+0.001813D0*T)*T)*T) + +* To the equatorial system, mean of date, FK5 system + SINEPS=SIN(EPS) + COSEPS=COS(EPS) + ES=EQCOR*SINEPS + EC=EQCOR*COSEPS + PV(1)=X-EC*Y+ES*Z + PV(2)=EQCOR*X+Y*COSEPS-Z*SINEPS + PV(3)=Y*SINEPS+Z*COSEPS + PV(4)=XD-EC*YD+ES*ZD + PV(5)=EQCOR*XD+YD*COSEPS-ZD*SINEPS + PV(6)=YD*SINEPS+ZD*COSEPS + + END + SUBROUTINE sla_DMXV (DM, VA, VB) +*+ +* - - - - - +* D M X V +* - - - - - +* +* Performs the 3-D forward unitary transformation: +* +* vector VB = matrix DM * vector VA +* +* (double precision) +* +* Given: +* DM dp(3,3) matrix +* VA dp(3) vector +* +* Returned: +* VB dp(3) result vector +* +* To comply with the ANSI Fortran 77 standard, VA and VB must be +* different arrays. However, the routine is coded so as to work +* properly on many platforms even if this rule is violated. +* +* Last revision: 26 December 2004 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DM(3,3),VA(3),VB(3) + + INTEGER I,J + DOUBLE PRECISION W,VW(3) + + +* Matrix DM * vector VA -> vector VW + DO J=1,3 + W=0D0 + DO I=1,3 + W=W+DM(J,I)*VA(I) + END DO + VW(J)=W + END DO + +* Vector VW -> vector VB + DO J=1,3 + VB(J)=VW(J) + END DO + + END + DOUBLE PRECISION FUNCTION sla_DRANGE (ANGLE) +*+ +* - - - - - - - +* D R A N G E +* - - - - - - - +* +* Normalize angle into range +/- pi (double precision) +* +* Given: +* ANGLE dp the angle in radians +* +* The result (double precision) is ANGLE expressed in the range +/- pi. +* +* P.T.Wallace Starlink 23 November 1995 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION ANGLE + + DOUBLE PRECISION DPI,D2PI + PARAMETER (DPI=3.141592653589793238462643D0) + PARAMETER (D2PI=6.283185307179586476925287D0) + + + sla_DRANGE=MOD(ANGLE,D2PI) + IF (ABS(sla_DRANGE).GE.DPI) + : sla_DRANGE=sla_DRANGE-SIGN(D2PI,ANGLE) + + END + DOUBLE PRECISION FUNCTION sla_DRANRM (ANGLE) +*+ +* - - - - - - - +* D R A N R M +* - - - - - - - +* +* Normalize angle into range 0-2 pi (double precision) +* +* Given: +* ANGLE dp the angle in radians +* +* The result is ANGLE expressed in the range 0-2 pi. +* +* Last revision: 22 July 2004 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION ANGLE + + DOUBLE PRECISION D2PI + PARAMETER (D2PI=6.283185307179586476925286766559D0) + + + sla_DRANRM = MOD(ANGLE,D2PI) + IF (sla_DRANRM.LT.0D0) sla_DRANRM = sla_DRANRM+D2PI + + END + DOUBLE PRECISION FUNCTION sla_DTT (UTC) +*+ +* - - - - +* D T T +* - - - - +* +* Increment to be applied to Coordinated Universal Time UTC to give +* Terrestrial Time TT (formerly Ephemeris Time ET) +* +* (double precision) +* +* Given: +* UTC d UTC date as a modified JD (JD-2400000.5) +* +* Result: TT-UTC in seconds +* +* Notes: +* +* 1 The UTC is specified to be a date rather than a time to indicate +* that care needs to be taken not to specify an instant which lies +* within a leap second. Though in most cases UTC can include the +* fractional part, correct behaviour on the day of a leap second +* can only be guaranteed up to the end of the second 23:59:59. +* +* 2 Pre 1972 January 1 a fixed value of 10 + ET-TAI is returned. +* +* 3 See also the routine sla_DT, which roughly estimates ET-UT for +* historical epochs. +* +* Called: sla_DAT +* +* P.T.Wallace Starlink 6 December 1994 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION UTC + + DOUBLE PRECISION sla_DAT + + + sla_DTT=32.184D0+sla_DAT(UTC) + + END + SUBROUTINE sla_ECMAT (DATE, RMAT) +*+ +* - - - - - - +* E C M A T +* - - - - - - +* +* Form the equatorial to ecliptic rotation matrix - IAU 1980 theory +* (double precision) +* +* Given: +* DATE dp TDB (loosely ET) as Modified Julian Date +* (JD-2400000.5) +* Returned: +* RMAT dp(3,3) matrix +* +* Reference: +* Murray,C.A., Vectorial Astrometry, section 4.3. +* +* Note: +* The matrix is in the sense V(ecl) = RMAT * V(equ); the +* equator, equinox and ecliptic are mean of date. +* +* Called: sla_DEULER +* +* P.T.Wallace Starlink 23 August 1996 +* +* Copyright (C) 1996 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DATE,RMAT(3,3) + +* Arc seconds to radians + DOUBLE PRECISION AS2R + PARAMETER (AS2R=0.484813681109535994D-5) + + DOUBLE PRECISION T,EPS0 + + + +* Interval between basic epoch J2000.0 and current epoch (JC) + T = (DATE-51544.5D0)/36525D0 + +* Mean obliquity + EPS0 = AS2R* + : (84381.448D0+(-46.8150D0+(-0.00059D0+0.001813D0*T)*T)*T) + +* Matrix + CALL sla_DEULER('X',EPS0,0D0,0D0,RMAT) + + END + DOUBLE PRECISION FUNCTION sla_EPJ (DATE) +*+ +* - - - - +* E P J +* - - - - +* +* Conversion of Modified Julian Date to Julian Epoch (double precision) +* +* Given: +* DATE dp Modified Julian Date (JD - 2400000.5) +* +* The result is the Julian Epoch. +* +* Reference: +* Lieske,J.H., 1979. Astron.Astrophys.,73,282. +* +* P.T.Wallace Starlink February 1984 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DATE + + + sla_EPJ = 2000D0 + (DATE-51544.5D0)/365.25D0 + + END + SUBROUTINE sla_EQECL (DR, DD, DATE, DL, DB) +*+ +* - - - - - - +* E Q E C L +* - - - - - - +* +* Transformation from J2000.0 equatorial coordinates to +* ecliptic coordinates (double precision) +* +* Given: +* DR,DD dp J2000.0 mean RA,Dec (radians) +* DATE dp TDB (loosely ET) as Modified Julian Date +* (JD-2400000.5) +* Returned: +* DL,DB dp ecliptic longitude and latitude +* (mean of date, IAU 1980 theory, radians) +* +* Called: +* sla_DCS2C, sla_PREC, sla_EPJ, sla_DMXV, sla_ECMAT, sla_DCC2S, +* sla_DRANRM, sla_DRANGE +* +* P.T.Wallace Starlink March 1986 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DR,DD,DATE,DL,DB + + DOUBLE PRECISION sla_EPJ,sla_DRANRM,sla_DRANGE + + DOUBLE PRECISION RMAT(3,3),V1(3),V2(3) + + + +* Spherical to Cartesian + CALL sla_DCS2C(DR,DD,V1) + +* Mean J2000 to mean of date + CALL sla_PREC(2000D0,sla_EPJ(DATE),RMAT) + CALL sla_DMXV(RMAT,V1,V2) + +* Equatorial to ecliptic + CALL sla_ECMAT(DATE,RMAT) + CALL sla_DMXV(RMAT,V2,V1) + +* Cartesian to spherical + CALL sla_DCC2S(V1,DL,DB) + +* Express in conventional ranges + DL=sla_DRANRM(DL) + DB=sla_DRANGE(DB) + + END + DOUBLE PRECISION FUNCTION sla_EQEQX (DATE) +*+ +* - - - - - - +* E Q E Q X +* - - - - - - +* +* Equation of the equinoxes (IAU 1994, double precision) +* +* Given: +* DATE dp TDB (loosely ET) as Modified Julian Date +* (JD-2400000.5) +* +* The result is the equation of the equinoxes (double precision) +* in radians: +* +* Greenwich apparent ST = GMST + sla_EQEQX +* +* References: IAU Resolution C7, Recommendation 3 (1994) +* Capitaine, N. & Gontier, A.-M., Astron. Astrophys., +* 275, 645-650 (1993) +* +* Called: sla_NUTC +* +* Patrick Wallace Starlink 23 August 1996 +* +* Copyright (C) 1996 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DATE + +* Turns to arc seconds and arc seconds to radians + DOUBLE PRECISION T2AS,AS2R + PARAMETER (T2AS=1296000D0, + : AS2R=0.484813681109535994D-5) + + DOUBLE PRECISION T,OM,DPSI,DEPS,EPS0 + + + +* Interval between basic epoch J2000.0 and current epoch (JC) + T=(DATE-51544.5D0)/36525D0 + +* Longitude of the mean ascending node of the lunar orbit on the +* ecliptic, measured from the mean equinox of date + OM=AS2R*(450160.280D0+(-5D0*T2AS-482890.539D0 + : +(7.455D0+0.008D0*T)*T)*T) + +* Nutation + CALL sla_NUTC(DATE,DPSI,DEPS,EPS0) + +* Equation of the equinoxes + sla_EQEQX=DPSI*COS(EPS0)+AS2R*(0.00264D0*SIN(OM)+ + : 0.000063D0*SIN(OM+OM)) + + END + SUBROUTINE sla_GEOC (P, H, R, Z) +*+ +* - - - - - +* G E O C +* - - - - - +* +* Convert geodetic position to geocentric (double precision) +* +* Given: +* P dp latitude (geodetic, radians) +* H dp height above reference spheroid (geodetic, metres) +* +* Returned: +* R dp distance from Earth axis (AU) +* Z dp distance from plane of Earth equator (AU) +* +* Notes: +* +* 1 Geocentric latitude can be obtained by evaluating ATAN2(Z,R). +* +* 2 IAU 1976 constants are used. +* +* Reference: +* +* Green,R.M., Spherical Astronomy, CUP 1985, p98. +* +* Last revision: 22 July 2004 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION P,H,R,Z + +* Earth equatorial radius (metres) + DOUBLE PRECISION A0 + PARAMETER (A0=6378140D0) + +* Reference spheroid flattening factor and useful function + DOUBLE PRECISION F,B + PARAMETER (F=1D0/298.257D0,B=(1D0-F)**2) + +* Astronomical unit in metres + DOUBLE PRECISION AU + PARAMETER (AU=1.49597870D11) + + DOUBLE PRECISION SP,CP,C,S + + + +* Geodetic to geocentric conversion + SP = SIN(P) + CP = COS(P) + C = 1D0/SQRT(CP*CP+B*SP*SP) + S = B*C + R = (A0*C+H)*CP/AU + Z = (A0*S+H)*SP/AU + + END + DOUBLE PRECISION FUNCTION sla_GMST (UT1) +*+ +* - - - - - +* G M S T +* - - - - - +* +* Conversion from universal time to sidereal time (double precision) +* +* Given: +* UT1 dp universal time (strictly UT1) expressed as +* modified Julian Date (JD-2400000.5) +* +* The result is the Greenwich mean sidereal time (double +* precision, radians). +* +* The IAU 1982 expression (see page S15 of 1984 Astronomical Almanac) +* is used, but rearranged to reduce rounding errors. This expression +* is always described as giving the GMST at 0 hours UT. In fact, it +* gives the difference between the GMST and the UT, which happens to +* equal the GMST (modulo 24 hours) at 0 hours UT each day. In this +* routine, the entire UT is used directly as the argument for the +* standard formula, and the fractional part of the UT is added +* separately. Note that the factor 1.0027379... does not appear in the +* IAU 1982 expression explicitly but in the form of the coefficient +* 8640184.812866, which is 86400x36525x0.0027379... +* +* See also the routine sla_GMSTA, which delivers better numerical +* precision by accepting the UT date and time as separate arguments. +* +* Called: sla_DRANRM +* +* P.T.Wallace Starlink 14 October 2001 +* +* Copyright (C) 2001 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION UT1 + + DOUBLE PRECISION sla_DRANRM + + DOUBLE PRECISION D2PI,S2R + PARAMETER (D2PI=6.283185307179586476925286766559D0, + : S2R=7.272205216643039903848711535369D-5) + + DOUBLE PRECISION TU + + + +* Julian centuries from fundamental epoch J2000 to this UT + TU=(UT1-51544.5D0)/36525D0 + +* GMST at this UT + sla_GMST=sla_DRANRM(MOD(UT1,1D0)*D2PI+ + : (24110.54841D0+ + : (8640184.812866D0+ + : (0.093104D0-6.2D-6*TU)*TU)*TU)*S2R) + + END + SUBROUTINE sla_NUTC (DATE, DPSI, DEPS, EPS0) +*+ +* - - - - - +* N U T C +* - - - - - +* +* Nutation: longitude & obliquity components and mean obliquity, +* using the Shirai & Fukushima (2001) theory. +* +* Given: +* DATE d TDB (loosely ET) as Modified Julian Date +* (JD-2400000.5) +* Returned: +* DPSI,DEPS d nutation in longitude,obliquity +* EPS0 d mean obliquity +* +* Notes: +* +* 1 The routine predicts forced nutation (but not free core nutation) +* plus corrections to the IAU 1976 precession model. +* +* 2 Earth attitude predictions made by combining the present nutation +* model with IAU 1976 precession are accurate to 1 mas (with respect +* to the ICRF) for a few decades around 2000. +* +* 3 The sla_NUTC80 routine is the equivalent of the present routine +* but using the IAU 1980 nutation theory. The older theory is less +* accurate, leading to errors as large as 350 mas over the interval +* 1900-2100, mainly because of the error in the IAU 1976 precession. +* +* References: +* +* Shirai, T. & Fukushima, T., Astron.J. 121, 3270-3283 (2001). +* +* Fukushima, T., Astron.Astrophys. 244, L11 (1991). +* +* Simon, J. L., Bretagnon, P., Chapront, J., Chapront-Touze, M., +* Francou, G. & Laskar, J., Astron.Astrophys. 282, 663 (1994). +* +* This revision: 24 November 2005 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DATE,DPSI,DEPS,EPS0 + +* Degrees to radians + DOUBLE PRECISION DD2R + PARAMETER (DD2R=1.745329251994329576923691D-2) + +* Arc seconds to radians + DOUBLE PRECISION DAS2R + PARAMETER (DAS2R=4.848136811095359935899141D-6) + +* Arc seconds in a full circle + DOUBLE PRECISION TURNAS + PARAMETER (TURNAS=1296000D0) + +* Reference epoch (J2000), MJD + DOUBLE PRECISION DJM0 + PARAMETER (DJM0=51544.5D0 ) + +* Days per Julian century + DOUBLE PRECISION DJC + PARAMETER (DJC=36525D0) + + INTEGER I,J + DOUBLE PRECISION T,EL,ELP,F,D,OM,VE,MA,JU,SA,THETA,C,S,DP,DE + +* Number of terms in the nutation model + INTEGER NTERMS + PARAMETER (NTERMS=194) + +* The SF2001 forced nutation model + INTEGER NA(9,NTERMS) + DOUBLE PRECISION PSI(4,NTERMS), EPS(4,NTERMS) + +* Coefficients of fundamental angles + DATA ( ( NA(I,J), I=1,9 ), J=1,10 ) / + : 0, 0, 0, 0, -1, 0, 0, 0, 0, + : 0, 0, 2, -2, 2, 0, 0, 0, 0, + : 0, 0, 2, 0, 2, 0, 0, 0, 0, + : 0, 0, 0, 0, -2, 0, 0, 0, 0, + : 0, 1, 0, 0, 0, 0, 0, 0, 0, + : 0, 1, 2, -2, 2, 0, 0, 0, 0, + : 1, 0, 0, 0, 0, 0, 0, 0, 0, + : 0, 0, 2, 0, 1, 0, 0, 0, 0, + : 1, 0, 2, 0, 2, 0, 0, 0, 0, + : 0, -1, 2, -2, 2, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=11,20 ) / + : 0, 0, 2, -2, 1, 0, 0, 0, 0, + : -1, 0, 2, 0, 2, 0, 0, 0, 0, + : -1, 0, 0, 2, 0, 0, 0, 0, 0, + : 1, 0, 0, 0, 1, 0, 0, 0, 0, + : 1, 0, 0, 0, -1, 0, 0, 0, 0, + : -1, 0, 2, 2, 2, 0, 0, 0, 0, + : 1, 0, 2, 0, 1, 0, 0, 0, 0, + : -2, 0, 2, 0, 1, 0, 0, 0, 0, + : 0, 0, 0, 2, 0, 0, 0, 0, 0, + : 0, 0, 2, 2, 2, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=21,30 ) / + : 2, 0, 0, -2, 0, 0, 0, 0, 0, + : 2, 0, 2, 0, 2, 0, 0, 0, 0, + : 1, 0, 2, -2, 2, 0, 0, 0, 0, + : -1, 0, 2, 0, 1, 0, 0, 0, 0, + : 2, 0, 0, 0, 0, 0, 0, 0, 0, + : 0, 0, 2, 0, 0, 0, 0, 0, 0, + : 0, 1, 0, 0, 1, 0, 0, 0, 0, + : -1, 0, 0, 2, 1, 0, 0, 0, 0, + : 0, 2, 2, -2, 2, 0, 0, 0, 0, + : 0, 0, 2, -2, 0, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=31,40 ) / + : -1, 0, 0, 2, -1, 0, 0, 0, 0, + : 0, 1, 0, 0, -1, 0, 0, 0, 0, + : 0, 2, 0, 0, 0, 0, 0, 0, 0, + : -1, 0, 2, 2, 1, 0, 0, 0, 0, + : 1, 0, 2, 2, 2, 0, 0, 0, 0, + : 0, 1, 2, 0, 2, 0, 0, 0, 0, + : -2, 0, 2, 0, 0, 0, 0, 0, 0, + : 0, 0, 2, 2, 1, 0, 0, 0, 0, + : 0, -1, 2, 0, 2, 0, 0, 0, 0, + : 0, 0, 0, 2, 1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=41,50 ) / + : 1, 0, 2, -2, 1, 0, 0, 0, 0, + : 2, 0, 0, -2, -1, 0, 0, 0, 0, + : 2, 0, 2, -2, 2, 0, 0, 0, 0, + : 2, 0, 2, 0, 1, 0, 0, 0, 0, + : 0, 0, 0, 2, -1, 0, 0, 0, 0, + : 0, -1, 2, -2, 1, 0, 0, 0, 0, + : -1, -1, 0, 2, 0, 0, 0, 0, 0, + : 2, 0, 0, -2, 1, 0, 0, 0, 0, + : 1, 0, 0, 2, 0, 0, 0, 0, 0, + : 0, 1, 2, -2, 1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=51,60 ) / + : 1, -1, 0, 0, 0, 0, 0, 0, 0, + : -2, 0, 2, 0, 2, 0, 0, 0, 0, + : 0, -1, 0, 2, 0, 0, 0, 0, 0, + : 3, 0, 2, 0, 2, 0, 0, 0, 0, + : 0, 0, 0, 1, 0, 0, 0, 0, 0, + : 1, -1, 2, 0, 2, 0, 0, 0, 0, + : 1, 0, 0, -1, 0, 0, 0, 0, 0, + : -1, -1, 2, 2, 2, 0, 0, 0, 0, + : -1, 0, 2, 0, 0, 0, 0, 0, 0, + : 2, 0, 0, 0, -1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=61,70 ) / + : 0, -1, 2, 2, 2, 0, 0, 0, 0, + : 1, 1, 2, 0, 2, 0, 0, 0, 0, + : 2, 0, 0, 0, 1, 0, 0, 0, 0, + : 1, 1, 0, 0, 0, 0, 0, 0, 0, + : 1, 0, -2, 2, -1, 0, 0, 0, 0, + : 1, 0, 2, 0, 0, 0, 0, 0, 0, + : -1, 1, 0, 1, 0, 0, 0, 0, 0, + : 1, 0, 0, 0, 2, 0, 0, 0, 0, + : -1, 0, 1, 0, 1, 0, 0, 0, 0, + : 0, 0, 2, 1, 2, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=71,80 ) / + : -1, 1, 0, 1, 1, 0, 0, 0, 0, + : -1, 0, 2, 4, 2, 0, 0, 0, 0, + : 0, -2, 2, -2, 1, 0, 0, 0, 0, + : 1, 0, 2, 2, 1, 0, 0, 0, 0, + : 1, 0, 0, 0, -2, 0, 0, 0, 0, + : -2, 0, 2, 2, 2, 0, 0, 0, 0, + : 1, 1, 2, -2, 2, 0, 0, 0, 0, + : -2, 0, 2, 4, 2, 0, 0, 0, 0, + : -1, 0, 4, 0, 2, 0, 0, 0, 0, + : 2, 0, 2, -2, 1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=81,90 ) / + : 1, 0, 0, -1, -1, 0, 0, 0, 0, + : 2, 0, 2, 2, 2, 0, 0, 0, 0, + : 1, 0, 0, 2, 1, 0, 0, 0, 0, + : 3, 0, 0, 0, 0, 0, 0, 0, 0, + : 0, 0, 2, -2, -1, 0, 0, 0, 0, + : 3, 0, 2, -2, 2, 0, 0, 0, 0, + : 0, 0, 4, -2, 2, 0, 0, 0, 0, + : -1, 0, 0, 4, 0, 0, 0, 0, 0, + : 0, 1, 2, 0, 1, 0, 0, 0, 0, + : 0, 0, 2, -2, 3, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=91,100 ) / + : -2, 0, 0, 4, 0, 0, 0, 0, 0, + : -1, -1, 0, 2, 1, 0, 0, 0, 0, + : -2, 0, 2, 0, -1, 0, 0, 0, 0, + : 0, 0, 2, 0, -1, 0, 0, 0, 0, + : 0, -1, 2, 0, 1, 0, 0, 0, 0, + : 0, 1, 0, 0, 2, 0, 0, 0, 0, + : 0, 0, 2, -1, 2, 0, 0, 0, 0, + : 2, 1, 0, -2, 0, 0, 0, 0, 0, + : 0, 0, 2, 4, 2, 0, 0, 0, 0, + : -1, -1, 0, 2, -1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=101,110 ) / + : -1, 1, 0, 2, 0, 0, 0, 0, 0, + : 1, -1, 0, 0, 1, 0, 0, 0, 0, + : 0, -1, 2, -2, 0, 0, 0, 0, 0, + : 0, 1, 0, 0, -2, 0, 0, 0, 0, + : 1, -1, 2, 2, 2, 0, 0, 0, 0, + : 1, 0, 0, 2, -1, 0, 0, 0, 0, + : -1, 1, 2, 2, 2, 0, 0, 0, 0, + : 3, 0, 2, 0, 1, 0, 0, 0, 0, + : 0, 1, 2, 2, 2, 0, 0, 0, 0, + : 1, 0, 2, -2, 0, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=111,120 ) / + : -1, 0, -2, 4, -1, 0, 0, 0, 0, + : -1, -1, 2, 2, 1, 0, 0, 0, 0, + : 0, -1, 2, 2, 1, 0, 0, 0, 0, + : 2, -1, 2, 0, 2, 0, 0, 0, 0, + : 0, 0, 0, 2, 2, 0, 0, 0, 0, + : 1, -1, 2, 0, 1, 0, 0, 0, 0, + : -1, 1, 2, 0, 2, 0, 0, 0, 0, + : 0, 1, 0, 2, 0, 0, 0, 0, 0, + : 0, 1, 2, -2, 0, 0, 0, 0, 0, + : 0, 3, 2, -2, 2, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=121,130 ) / + : 0, 0, 0, 1, 1, 0, 0, 0, 0, + : -1, 0, 2, 2, 0, 0, 0, 0, 0, + : 2, 1, 2, 0, 2, 0, 0, 0, 0, + : 1, 1, 0, 0, 1, 0, 0, 0, 0, + : 2, 0, 0, 2, 0, 0, 0, 0, 0, + : 1, 1, 2, 0, 1, 0, 0, 0, 0, + : -1, 0, 0, 2, 2, 0, 0, 0, 0, + : 1, 0, -2, 2, 0, 0, 0, 0, 0, + : 0, -1, 0, 2, -1, 0, 0, 0, 0, + : -1, 0, 1, 0, 2, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=131,140 ) / + : 0, 1, 0, 1, 0, 0, 0, 0, 0, + : 1, 0, -2, 2, -2, 0, 0, 0, 0, + : 0, 0, 0, 1, -1, 0, 0, 0, 0, + : 1, -1, 0, 0, -1, 0, 0, 0, 0, + : 0, 0, 0, 4, 0, 0, 0, 0, 0, + : 1, -1, 0, 2, 0, 0, 0, 0, 0, + : 1, 0, 2, 1, 2, 0, 0, 0, 0, + : 1, 0, 2, -1, 2, 0, 0, 0, 0, + : -1, 0, 0, 2, -2, 0, 0, 0, 0, + : 0, 0, 2, 1, 1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=141,150 ) / + : -1, 0, 2, 0, -1, 0, 0, 0, 0, + : -1, 0, 2, 4, 1, 0, 0, 0, 0, + : 0, 0, 2, 2, 0, 0, 0, 0, 0, + : 1, 1, 2, -2, 1, 0, 0, 0, 0, + : 0, 0, 1, 0, 1, 0, 0, 0, 0, + : -1, 0, 2, -1, 1, 0, 0, 0, 0, + : -2, 0, 2, 2, 1, 0, 0, 0, 0, + : 2, -1, 0, 0, 0, 0, 0, 0, 0, + : 4, 0, 2, 0, 2, 0, 0, 0, 0, + : 2, 1, 2, -2, 2, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=151,160 ) / + : 0, 1, 2, 1, 2, 0, 0, 0, 0, + : 1, 0, 4, -2, 2, 0, 0, 0, 0, + : 1, 1, 0, 0, -1, 0, 0, 0, 0, + : -2, 0, 2, 4, 1, 0, 0, 0, 0, + : 2, 0, 2, 0, 0, 0, 0, 0, 0, + : -1, 0, 1, 0, 0, 0, 0, 0, 0, + : 1, 0, 0, 1, 0, 0, 0, 0, 0, + : 0, 1, 0, 2, 1, 0, 0, 0, 0, + : -1, 0, 4, 0, 1, 0, 0, 0, 0, + : -1, 0, 0, 4, 1, 0, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=161,170 ) / + : 2, 0, 2, 2, 1, 0, 0, 0, 0, + : 2, 1, 0, 0, 0, 0, 0, 0, 0, + : 0, 0, 5, -5, 5, -3, 0, 0, 0, + : 0, 0, 0, 0, 0, 0, 0, 2, 0, + : 0, 0, 1, -1, 1, 0, 0, -1, 0, + : 0, 0, -1, 1, -1, 1, 0, 0, 0, + : 0, 0, -1, 1, 0, 0, 2, 0, 0, + : 0, 0, 3, -3, 3, 0, 0, -1, 0, + : 0, 0, -8, 8, -7, 5, 0, 0, 0, + : 0, 0, -1, 1, -1, 0, 2, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=171,180 ) / + : 0, 0, -2, 2, -2, 2, 0, 0, 0, + : 0, 0, -6, 6, -6, 4, 0, 0, 0, + : 0, 0, -2, 2, -2, 0, 8, -3, 0, + : 0, 0, 6, -6, 6, 0, -8, 3, 0, + : 0, 0, 4, -4, 4, -2, 0, 0, 0, + : 0, 0, -3, 3, -3, 2, 0, 0, 0, + : 0, 0, 4, -4, 3, 0, -8, 3, 0, + : 0, 0, -4, 4, -5, 0, 8, -3, 0, + : 0, 0, 0, 0, 0, 2, 0, 0, 0, + : 0, 0, -4, 4, -4, 3, 0, 0, 0 / + DATA ( ( NA(I,J), I=1,9 ), J=181,190 ) / + : 0, 1, -1, 1, -1, 0, 0, 1, 0, + : 0, 0, 0, 0, 0, 0, 0, 1, 0, + : 0, 0, 1, -1, 1, 1, 0, 0, 0, + : 0, 0, 2, -2, 2, 0, -2, 0, 0, + : 0, -1, -7, 7, -7, 5, 0, 0, 0, + : -2, 0, 2, 0, 2, 0, 0, -2, 0, + : -2, 0, 2, 0, 1, 0, 0, -3, 0, + : 0, 0, 2, -2, 2, 0, 0, -2, 0, + : 0, 0, 1, -1, 1, 0, 0, 1, 0, + : 0, 0, 0, 0, 0, 0, 0, 0, 2 / + DATA ( ( NA(I,J), I=1,9 ), J=191,NTERMS ) / + : 0, 0, 0, 0, 0, 0, 0, 0, 1, + : 2, 0, -2, 0, -2, 0, 0, 3, 0, + : 0, 0, 1, -1, 1, 0, 0, -2, 0, + : 0, 0, -7, 7, -7, 5, 0, 0, 0 / + +* Nutation series: longitude + DATA ( ( PSI(I,J), I=1,4 ), J=1,10 ) / + : 3341.5D0, 17206241.8D0, 3.1D0, 17409.5D0, + : -1716.8D0, -1317185.3D0, 1.4D0, -156.8D0, + : 285.7D0, -227667.0D0, 0.3D0, -23.5D0, + : -68.6D0, -207448.0D0, 0.0D0, -21.4D0, + : 950.3D0, 147607.9D0, -2.3D0, -355.0D0, + : -66.7D0, -51689.1D0, 0.2D0, 122.6D0, + : -108.6D0, 71117.6D0, 0.0D0, 7.0D0, + : 35.6D0, -38740.2D0, 0.1D0, -36.2D0, + : 85.4D0, -30127.6D0, 0.0D0, -3.1D0, + : 9.0D0, 21583.0D0, 0.1D0, -50.3D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=11,20 ) / + : 22.1D0, 12822.8D0, 0.0D0, 13.3D0, + : 3.4D0, 12350.8D0, 0.0D0, 1.3D0, + : -21.1D0, 15699.4D0, 0.0D0, 1.6D0, + : 4.2D0, 6313.8D0, 0.0D0, 6.2D0, + : -22.8D0, 5796.9D0, 0.0D0, 6.1D0, + : 15.7D0, -5961.1D0, 0.0D0, -0.6D0, + : 13.1D0, -5159.1D0, 0.0D0, -4.6D0, + : 1.8D0, 4592.7D0, 0.0D0, 4.5D0, + : -17.5D0, 6336.0D0, 0.0D0, 0.7D0, + : 16.3D0, -3851.1D0, 0.0D0, -0.4D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=21,30 ) / + : -2.8D0, 4771.7D0, 0.0D0, 0.5D0, + : 13.8D0, -3099.3D0, 0.0D0, -0.3D0, + : 0.2D0, 2860.3D0, 0.0D0, 0.3D0, + : 1.4D0, 2045.3D0, 0.0D0, 2.0D0, + : -8.6D0, 2922.6D0, 0.0D0, 0.3D0, + : -7.7D0, 2587.9D0, 0.0D0, 0.2D0, + : 8.8D0, -1408.1D0, 0.0D0, 3.7D0, + : 1.4D0, 1517.5D0, 0.0D0, 1.5D0, + : -1.9D0, -1579.7D0, 0.0D0, 7.7D0, + : 1.3D0, -2178.6D0, 0.0D0, -0.2D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=31,40 ) / + : -4.8D0, 1286.8D0, 0.0D0, 1.3D0, + : 6.3D0, 1267.2D0, 0.0D0, -4.0D0, + : -1.0D0, 1669.3D0, 0.0D0, -8.3D0, + : 2.4D0, -1020.0D0, 0.0D0, -0.9D0, + : 4.5D0, -766.9D0, 0.0D0, 0.0D0, + : -1.1D0, 756.5D0, 0.0D0, -1.7D0, + : -1.4D0, -1097.3D0, 0.0D0, -0.5D0, + : 2.6D0, -663.0D0, 0.0D0, -0.6D0, + : 0.8D0, -714.1D0, 0.0D0, 1.6D0, + : 0.4D0, -629.9D0, 0.0D0, -0.6D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=41,50 ) / + : 0.3D0, 580.4D0, 0.0D0, 0.6D0, + : -1.6D0, 577.3D0, 0.0D0, 0.5D0, + : -0.9D0, 644.4D0, 0.0D0, 0.0D0, + : 2.2D0, -534.0D0, 0.0D0, -0.5D0, + : -2.5D0, 493.3D0, 0.0D0, 0.5D0, + : -0.1D0, -477.3D0, 0.0D0, -2.4D0, + : -0.9D0, 735.0D0, 0.0D0, -1.7D0, + : 0.7D0, 406.2D0, 0.0D0, 0.4D0, + : -2.8D0, 656.9D0, 0.0D0, 0.0D0, + : 0.6D0, 358.0D0, 0.0D0, 2.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=51,60 ) / + : -0.7D0, 472.5D0, 0.0D0, -1.1D0, + : -0.1D0, -300.5D0, 0.0D0, 0.0D0, + : -1.2D0, 435.1D0, 0.0D0, -1.0D0, + : 1.8D0, -289.4D0, 0.0D0, 0.0D0, + : 0.6D0, -422.6D0, 0.0D0, 0.0D0, + : 0.8D0, -287.6D0, 0.0D0, 0.6D0, + : -38.6D0, -392.3D0, 0.0D0, 0.0D0, + : 0.7D0, -281.8D0, 0.0D0, 0.6D0, + : 0.6D0, -405.7D0, 0.0D0, 0.0D0, + : -1.2D0, 229.0D0, 0.0D0, 0.2D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=61,70 ) / + : 1.1D0, -264.3D0, 0.0D0, 0.5D0, + : -0.7D0, 247.9D0, 0.0D0, -0.5D0, + : -0.2D0, 218.0D0, 0.0D0, 0.2D0, + : 0.6D0, -339.0D0, 0.0D0, 0.8D0, + : -0.7D0, 198.7D0, 0.0D0, 0.2D0, + : -1.5D0, 334.0D0, 0.0D0, 0.0D0, + : 0.1D0, 334.0D0, 0.0D0, 0.0D0, + : -0.1D0, -198.1D0, 0.0D0, 0.0D0, + : -106.6D0, 0.0D0, 0.0D0, 0.0D0, + : -0.5D0, 165.8D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=71,80 ) / + : 0.0D0, 134.8D0, 0.0D0, 0.0D0, + : 0.9D0, -151.6D0, 0.0D0, 0.0D0, + : 0.0D0, -129.7D0, 0.0D0, 0.0D0, + : 0.8D0, -132.8D0, 0.0D0, -0.1D0, + : 0.5D0, -140.7D0, 0.0D0, 0.0D0, + : -0.1D0, 138.4D0, 0.0D0, 0.0D0, + : 0.0D0, 129.0D0, 0.0D0, -0.3D0, + : 0.5D0, -121.2D0, 0.0D0, 0.0D0, + : -0.3D0, 114.5D0, 0.0D0, 0.0D0, + : -0.1D0, 101.8D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=81,90 ) / + : -3.6D0, -101.9D0, 0.0D0, 0.0D0, + : 0.8D0, -109.4D0, 0.0D0, 0.0D0, + : 0.2D0, -97.0D0, 0.0D0, 0.0D0, + : -0.7D0, 157.3D0, 0.0D0, 0.0D0, + : 0.2D0, -83.3D0, 0.0D0, 0.0D0, + : -0.3D0, 93.3D0, 0.0D0, 0.0D0, + : -0.1D0, 92.1D0, 0.0D0, 0.0D0, + : -0.5D0, 133.6D0, 0.0D0, 0.0D0, + : -0.1D0, 81.5D0, 0.0D0, 0.0D0, + : 0.0D0, 123.9D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=91,100 ) / + : -0.3D0, 128.1D0, 0.0D0, 0.0D0, + : 0.1D0, 74.1D0, 0.0D0, -0.3D0, + : -0.2D0, -70.3D0, 0.0D0, 0.0D0, + : -0.4D0, 66.6D0, 0.0D0, 0.0D0, + : 0.1D0, -66.7D0, 0.0D0, 0.0D0, + : -0.7D0, 69.3D0, 0.0D0, -0.3D0, + : 0.0D0, -70.4D0, 0.0D0, 0.0D0, + : -0.1D0, 101.5D0, 0.0D0, 0.0D0, + : 0.5D0, -69.1D0, 0.0D0, 0.0D0, + : -0.2D0, 58.5D0, 0.0D0, 0.2D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=101,110 ) / + : 0.1D0, -94.9D0, 0.0D0, 0.2D0, + : 0.0D0, 52.9D0, 0.0D0, -0.2D0, + : 0.1D0, 86.7D0, 0.0D0, -0.2D0, + : -0.1D0, -59.2D0, 0.0D0, 0.2D0, + : 0.3D0, -58.8D0, 0.0D0, 0.1D0, + : -0.3D0, 49.0D0, 0.0D0, 0.0D0, + : -0.2D0, 56.9D0, 0.0D0, -0.1D0, + : 0.3D0, -50.2D0, 0.0D0, 0.0D0, + : -0.2D0, 53.4D0, 0.0D0, -0.1D0, + : 0.1D0, -76.5D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=111,120 ) / + : -0.2D0, 45.3D0, 0.0D0, 0.0D0, + : 0.1D0, -46.8D0, 0.0D0, 0.0D0, + : 0.2D0, -44.6D0, 0.0D0, 0.0D0, + : 0.2D0, -48.7D0, 0.0D0, 0.0D0, + : 0.1D0, -46.8D0, 0.0D0, 0.0D0, + : 0.1D0, -42.0D0, 0.0D0, 0.0D0, + : 0.0D0, 46.4D0, 0.0D0, -0.1D0, + : 0.2D0, -67.3D0, 0.0D0, 0.1D0, + : 0.0D0, -65.8D0, 0.0D0, 0.2D0, + : -0.1D0, -43.9D0, 0.0D0, 0.3D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=121,130 ) / + : 0.0D0, -38.9D0, 0.0D0, 0.0D0, + : -0.3D0, 63.9D0, 0.0D0, 0.0D0, + : -0.2D0, 41.2D0, 0.0D0, 0.0D0, + : 0.0D0, -36.1D0, 0.0D0, 0.2D0, + : -0.3D0, 58.5D0, 0.0D0, 0.0D0, + : -0.1D0, 36.1D0, 0.0D0, 0.0D0, + : 0.0D0, -39.7D0, 0.0D0, 0.0D0, + : 0.1D0, -57.7D0, 0.0D0, 0.0D0, + : -0.2D0, 33.4D0, 0.0D0, 0.0D0, + : 36.4D0, 0.0D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=131,140 ) / + : -0.1D0, 55.7D0, 0.0D0, -0.1D0, + : 0.1D0, -35.4D0, 0.0D0, 0.0D0, + : 0.1D0, -31.0D0, 0.0D0, 0.0D0, + : -0.1D0, 30.1D0, 0.0D0, 0.0D0, + : -0.3D0, 49.2D0, 0.0D0, 0.0D0, + : -0.2D0, 49.1D0, 0.0D0, 0.0D0, + : -0.1D0, 33.6D0, 0.0D0, 0.0D0, + : 0.1D0, -33.5D0, 0.0D0, 0.0D0, + : 0.1D0, -31.0D0, 0.0D0, 0.0D0, + : -0.1D0, 28.0D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=141,150 ) / + : 0.1D0, -25.2D0, 0.0D0, 0.0D0, + : 0.1D0, -26.2D0, 0.0D0, 0.0D0, + : -0.2D0, 41.5D0, 0.0D0, 0.0D0, + : 0.0D0, 24.5D0, 0.0D0, 0.1D0, + : -16.2D0, 0.0D0, 0.0D0, 0.0D0, + : 0.0D0, -22.3D0, 0.0D0, 0.0D0, + : 0.0D0, 23.1D0, 0.0D0, 0.0D0, + : -0.1D0, 37.5D0, 0.0D0, 0.0D0, + : 0.2D0, -25.7D0, 0.0D0, 0.0D0, + : 0.0D0, 25.2D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=151,160 ) / + : 0.1D0, -24.5D0, 0.0D0, 0.0D0, + : -0.1D0, 24.3D0, 0.0D0, 0.0D0, + : 0.1D0, -20.7D0, 0.0D0, 0.0D0, + : 0.1D0, -20.8D0, 0.0D0, 0.0D0, + : -0.2D0, 33.4D0, 0.0D0, 0.0D0, + : 32.9D0, 0.0D0, 0.0D0, 0.0D0, + : 0.1D0, -32.6D0, 0.0D0, 0.0D0, + : 0.0D0, 19.9D0, 0.0D0, 0.0D0, + : -0.1D0, 19.6D0, 0.0D0, 0.0D0, + : 0.0D0, -18.7D0, 0.0D0, 0.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=161,170 ) / + : 0.1D0, -19.0D0, 0.0D0, 0.0D0, + : 0.1D0, -28.6D0, 0.0D0, 0.0D0, + : 4.0D0, 178.8D0,-11.8D0, 0.3D0, + : 39.8D0, -107.3D0, -5.6D0, -1.0D0, + : 9.9D0, 164.0D0, -4.1D0, 0.1D0, + : -4.8D0, -135.3D0, -3.4D0, -0.1D0, + : 50.5D0, 75.0D0, 1.4D0, -1.2D0, + : -1.1D0, -53.5D0, 1.3D0, 0.0D0, + : -45.0D0, -2.4D0, -0.4D0, 6.6D0, + : -11.5D0, -61.0D0, -0.9D0, 0.4D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=171,180 ) / + : 4.4D0, -68.4D0, -3.4D0, 0.0D0, + : 7.7D0, -47.1D0, -4.7D0, -1.0D0, + : -42.9D0, -12.6D0, -1.2D0, 4.2D0, + : -42.8D0, 12.7D0, -1.2D0, -4.2D0, + : -7.6D0, -44.1D0, 2.1D0, -0.5D0, + : -64.1D0, 1.7D0, 0.2D0, 4.5D0, + : 36.4D0, -10.4D0, 1.0D0, 3.5D0, + : 35.6D0, 10.2D0, 1.0D0, -3.5D0, + : -1.7D0, 39.5D0, 2.0D0, 0.0D0, + : 50.9D0, -8.2D0, -0.8D0, -5.0D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=181,190 ) / + : 0.0D0, 52.3D0, 1.2D0, 0.0D0, + : -42.9D0, -17.8D0, 0.4D0, 0.0D0, + : 2.6D0, 34.3D0, 0.8D0, 0.0D0, + : -0.8D0, -48.6D0, 2.4D0, -0.1D0, + : -4.9D0, 30.5D0, 3.7D0, 0.7D0, + : 0.0D0, -43.6D0, 2.1D0, 0.0D0, + : 0.0D0, -25.4D0, 1.2D0, 0.0D0, + : 2.0D0, 40.9D0, -2.0D0, 0.0D0, + : -2.1D0, 26.1D0, 0.6D0, 0.0D0, + : 22.6D0, -3.2D0, -0.5D0, -0.5D0 / + DATA ( ( PSI(I,J), I=1,4 ), J=191,NTERMS ) / + : -7.6D0, 24.9D0, -0.4D0, -0.2D0, + : -6.2D0, 34.9D0, 1.7D0, 0.3D0, + : 2.0D0, 17.4D0, -0.4D0, 0.1D0, + : -3.9D0, 20.5D0, 2.4D0, 0.6D0 / + +* Nutation series: obliquity + DATA ( ( EPS(I,J), I=1,4 ), J=1,10 ) / + : 9205365.8D0, -1506.2D0, 885.7D0, -0.2D0, + : 573095.9D0, -570.2D0, -305.0D0, -0.3D0, + : 97845.5D0, 147.8D0, -48.8D0, -0.2D0, + : -89753.6D0, 28.0D0, 46.9D0, 0.0D0, + : 7406.7D0, -327.1D0, -18.2D0, 0.8D0, + : 22442.3D0, -22.3D0, -67.6D0, 0.0D0, + : -683.6D0, 46.8D0, 0.0D0, 0.0D0, + : 20070.7D0, 36.0D0, 1.6D0, 0.0D0, + : 12893.8D0, 39.5D0, -6.2D0, 0.0D0, + : -9593.2D0, 14.4D0, 30.2D0, -0.1D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=11,20 ) / + : -6899.5D0, 4.8D0, -0.6D0, 0.0D0, + : -5332.5D0, -0.1D0, 2.7D0, 0.0D0, + : -125.2D0, 10.5D0, 0.0D0, 0.0D0, + : -3323.4D0, -0.9D0, -0.3D0, 0.0D0, + : 3142.3D0, 8.9D0, 0.3D0, 0.0D0, + : 2552.5D0, 7.3D0, -1.2D0, 0.0D0, + : 2634.4D0, 8.8D0, 0.2D0, 0.0D0, + : -2424.4D0, 1.6D0, -0.4D0, 0.0D0, + : -123.3D0, 3.9D0, 0.0D0, 0.0D0, + : 1642.4D0, 7.3D0, -0.8D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=21,30 ) / + : 47.9D0, 3.2D0, 0.0D0, 0.0D0, + : 1321.2D0, 6.2D0, -0.6D0, 0.0D0, + : -1234.1D0, -0.3D0, 0.6D0, 0.0D0, + : -1076.5D0, -0.3D0, 0.0D0, 0.0D0, + : -61.6D0, 1.8D0, 0.0D0, 0.0D0, + : -55.4D0, 1.6D0, 0.0D0, 0.0D0, + : 856.9D0, -4.9D0, -2.1D0, 0.0D0, + : -800.7D0, -0.1D0, 0.0D0, 0.0D0, + : 685.1D0, -0.6D0, -3.8D0, 0.0D0, + : -16.9D0, -1.5D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=31,40 ) / + : 695.7D0, 1.8D0, 0.0D0, 0.0D0, + : 642.2D0, -2.6D0, -1.6D0, 0.0D0, + : 13.3D0, 1.1D0, -0.1D0, 0.0D0, + : 521.9D0, 1.6D0, 0.0D0, 0.0D0, + : 325.8D0, 2.0D0, -0.1D0, 0.0D0, + : -325.1D0, -0.5D0, 0.9D0, 0.0D0, + : 10.1D0, 0.3D0, 0.0D0, 0.0D0, + : 334.5D0, 1.6D0, 0.0D0, 0.0D0, + : 307.1D0, 0.4D0, -0.9D0, 0.0D0, + : 327.2D0, 0.5D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=41,50 ) / + : -304.6D0, -0.1D0, 0.0D0, 0.0D0, + : 304.0D0, 0.6D0, 0.0D0, 0.0D0, + : -276.8D0, -0.5D0, 0.1D0, 0.0D0, + : 268.9D0, 1.3D0, 0.0D0, 0.0D0, + : 271.8D0, 1.1D0, 0.0D0, 0.0D0, + : 271.5D0, -0.4D0, -0.8D0, 0.0D0, + : -5.2D0, 0.5D0, 0.0D0, 0.0D0, + : -220.5D0, 0.1D0, 0.0D0, 0.0D0, + : -20.1D0, 0.3D0, 0.0D0, 0.0D0, + : -191.0D0, 0.1D0, 0.5D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=51,60 ) / + : -4.1D0, 0.3D0, 0.0D0, 0.0D0, + : 130.6D0, -0.1D0, 0.0D0, 0.0D0, + : 3.0D0, 0.3D0, 0.0D0, 0.0D0, + : 122.9D0, 0.8D0, 0.0D0, 0.0D0, + : 3.7D0, -0.3D0, 0.0D0, 0.0D0, + : 123.1D0, 0.4D0, -0.3D0, 0.0D0, + : -52.7D0, 15.3D0, 0.0D0, 0.0D0, + : 120.7D0, 0.3D0, -0.3D0, 0.0D0, + : 4.0D0, -0.3D0, 0.0D0, 0.0D0, + : 126.5D0, 0.5D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=61,70 ) / + : 112.7D0, 0.5D0, -0.3D0, 0.0D0, + : -106.1D0, -0.3D0, 0.3D0, 0.0D0, + : -112.9D0, -0.2D0, 0.0D0, 0.0D0, + : 3.6D0, -0.2D0, 0.0D0, 0.0D0, + : 107.4D0, 0.3D0, 0.0D0, 0.0D0, + : -10.9D0, 0.2D0, 0.0D0, 0.0D0, + : -0.9D0, 0.0D0, 0.0D0, 0.0D0, + : 85.4D0, 0.0D0, 0.0D0, 0.0D0, + : 0.0D0, -88.8D0, 0.0D0, 0.0D0, + : -71.0D0, -0.2D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=71,80 ) / + : -70.3D0, 0.0D0, 0.0D0, 0.0D0, + : 64.5D0, 0.4D0, 0.0D0, 0.0D0, + : 69.8D0, 0.0D0, 0.0D0, 0.0D0, + : 66.1D0, 0.4D0, 0.0D0, 0.0D0, + : -61.0D0, -0.2D0, 0.0D0, 0.0D0, + : -59.5D0, -0.1D0, 0.0D0, 0.0D0, + : -55.6D0, 0.0D0, 0.2D0, 0.0D0, + : 51.7D0, 0.2D0, 0.0D0, 0.0D0, + : -49.0D0, -0.1D0, 0.0D0, 0.0D0, + : -52.7D0, -0.1D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=81,90 ) / + : -49.6D0, 1.4D0, 0.0D0, 0.0D0, + : 46.3D0, 0.4D0, 0.0D0, 0.0D0, + : 49.6D0, 0.1D0, 0.0D0, 0.0D0, + : -5.1D0, 0.1D0, 0.0D0, 0.0D0, + : -44.0D0, -0.1D0, 0.0D0, 0.0D0, + : -39.9D0, -0.1D0, 0.0D0, 0.0D0, + : -39.5D0, -0.1D0, 0.0D0, 0.0D0, + : -3.9D0, 0.1D0, 0.0D0, 0.0D0, + : -42.1D0, -0.1D0, 0.0D0, 0.0D0, + : -17.2D0, 0.1D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=91,100 ) / + : -2.3D0, 0.1D0, 0.0D0, 0.0D0, + : -39.2D0, 0.0D0, 0.0D0, 0.0D0, + : -38.4D0, 0.1D0, 0.0D0, 0.0D0, + : 36.8D0, 0.2D0, 0.0D0, 0.0D0, + : 34.6D0, 0.1D0, 0.0D0, 0.0D0, + : -32.7D0, 0.3D0, 0.0D0, 0.0D0, + : 30.4D0, 0.0D0, 0.0D0, 0.0D0, + : 0.4D0, 0.1D0, 0.0D0, 0.0D0, + : 29.3D0, 0.2D0, 0.0D0, 0.0D0, + : 31.6D0, 0.1D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=101,110 ) / + : 0.8D0, -0.1D0, 0.0D0, 0.0D0, + : -27.9D0, 0.0D0, 0.0D0, 0.0D0, + : 2.9D0, 0.0D0, 0.0D0, 0.0D0, + : -25.3D0, 0.0D0, 0.0D0, 0.0D0, + : 25.0D0, 0.1D0, 0.0D0, 0.0D0, + : 27.5D0, 0.1D0, 0.0D0, 0.0D0, + : -24.4D0, -0.1D0, 0.0D0, 0.0D0, + : 24.9D0, 0.2D0, 0.0D0, 0.0D0, + : -22.8D0, -0.1D0, 0.0D0, 0.0D0, + : 0.9D0, -0.1D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=111,120 ) / + : 24.4D0, 0.1D0, 0.0D0, 0.0D0, + : 23.9D0, 0.1D0, 0.0D0, 0.0D0, + : 22.5D0, 0.1D0, 0.0D0, 0.0D0, + : 20.8D0, 0.1D0, 0.0D0, 0.0D0, + : 20.1D0, 0.0D0, 0.0D0, 0.0D0, + : 21.5D0, 0.1D0, 0.0D0, 0.0D0, + : -20.0D0, 0.0D0, 0.0D0, 0.0D0, + : 1.4D0, 0.0D0, 0.0D0, 0.0D0, + : -0.2D0, -0.1D0, 0.0D0, 0.0D0, + : 19.0D0, 0.0D0, -0.1D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=121,130 ) / + : 20.5D0, 0.0D0, 0.0D0, 0.0D0, + : -2.0D0, 0.0D0, 0.0D0, 0.0D0, + : -17.6D0, -0.1D0, 0.0D0, 0.0D0, + : 19.0D0, 0.0D0, 0.0D0, 0.0D0, + : -2.4D0, 0.0D0, 0.0D0, 0.0D0, + : -18.4D0, -0.1D0, 0.0D0, 0.0D0, + : 17.1D0, 0.0D0, 0.0D0, 0.0D0, + : 0.4D0, 0.0D0, 0.0D0, 0.0D0, + : 18.4D0, 0.1D0, 0.0D0, 0.0D0, + : 0.0D0, 17.4D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=131,140 ) / + : -0.6D0, 0.0D0, 0.0D0, 0.0D0, + : -15.4D0, 0.0D0, 0.0D0, 0.0D0, + : -16.8D0, -0.1D0, 0.0D0, 0.0D0, + : 16.3D0, 0.0D0, 0.0D0, 0.0D0, + : -2.0D0, 0.0D0, 0.0D0, 0.0D0, + : -1.5D0, 0.0D0, 0.0D0, 0.0D0, + : -14.3D0, -0.1D0, 0.0D0, 0.0D0, + : 14.4D0, 0.0D0, 0.0D0, 0.0D0, + : -13.4D0, 0.0D0, 0.0D0, 0.0D0, + : -14.3D0, -0.1D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=141,150 ) / + : -13.7D0, 0.0D0, 0.0D0, 0.0D0, + : 13.1D0, 0.1D0, 0.0D0, 0.0D0, + : -1.7D0, 0.0D0, 0.0D0, 0.0D0, + : -12.8D0, 0.0D0, 0.0D0, 0.0D0, + : 0.0D0, -14.4D0, 0.0D0, 0.0D0, + : 12.4D0, 0.0D0, 0.0D0, 0.0D0, + : -12.0D0, 0.0D0, 0.0D0, 0.0D0, + : -0.8D0, 0.0D0, 0.0D0, 0.0D0, + : 10.9D0, 0.1D0, 0.0D0, 0.0D0, + : -10.8D0, 0.0D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=151,160 ) / + : 10.5D0, 0.0D0, 0.0D0, 0.0D0, + : -10.4D0, 0.0D0, 0.0D0, 0.0D0, + : -11.2D0, 0.0D0, 0.0D0, 0.0D0, + : 10.5D0, 0.1D0, 0.0D0, 0.0D0, + : -1.4D0, 0.0D0, 0.0D0, 0.0D0, + : 0.0D0, 0.1D0, 0.0D0, 0.0D0, + : 0.7D0, 0.0D0, 0.0D0, 0.0D0, + : -10.3D0, 0.0D0, 0.0D0, 0.0D0, + : -10.0D0, 0.0D0, 0.0D0, 0.0D0, + : 9.6D0, 0.0D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=161,170 ) / + : 9.4D0, 0.1D0, 0.0D0, 0.0D0, + : 0.6D0, 0.0D0, 0.0D0, 0.0D0, + : -87.7D0, 4.4D0, -0.4D0, -6.3D0, + : 46.3D0, 22.4D0, 0.5D0, -2.4D0, + : 15.6D0, -3.4D0, 0.1D0, 0.4D0, + : 5.2D0, 5.8D0, 0.2D0, -0.1D0, + : -30.1D0, 26.9D0, 0.7D0, 0.0D0, + : 23.2D0, -0.5D0, 0.0D0, 0.6D0, + : 1.0D0, 23.2D0, 3.4D0, 0.0D0, + : -12.2D0, -4.3D0, 0.0D0, 0.0D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=171,180 ) / + : -2.1D0, -3.7D0, -0.2D0, 0.1D0, + : -18.6D0, -3.8D0, -0.4D0, 1.8D0, + : 5.5D0, -18.7D0, -1.8D0, -0.5D0, + : -5.5D0, -18.7D0, 1.8D0, -0.5D0, + : 18.4D0, -3.6D0, 0.3D0, 0.9D0, + : -0.6D0, 1.3D0, 0.0D0, 0.0D0, + : -5.6D0, -19.5D0, 1.9D0, 0.0D0, + : 5.5D0, -19.1D0, -1.9D0, 0.0D0, + : -17.3D0, -0.8D0, 0.0D0, 0.9D0, + : -3.2D0, -8.3D0, -0.8D0, 0.3D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=181,190 ) / + : -0.1D0, 0.0D0, 0.0D0, 0.0D0, + : -5.4D0, 7.8D0, -0.3D0, 0.0D0, + : -14.8D0, 1.4D0, 0.0D0, 0.3D0, + : -3.8D0, 0.4D0, 0.0D0, -0.2D0, + : 12.6D0, 3.2D0, 0.5D0, -1.5D0, + : 0.1D0, 0.0D0, 0.0D0, 0.0D0, + : -13.6D0, 2.4D0, -0.1D0, 0.0D0, + : 0.9D0, 1.2D0, 0.0D0, 0.0D0, + : -11.9D0, -0.5D0, 0.0D0, 0.3D0, + : 0.4D0, 12.0D0, 0.3D0, -0.2D0 / + DATA ( ( EPS(I,J), I=1,4 ), J=191,NTERMS ) / + : 8.3D0, 6.1D0, -0.1D0, 0.1D0, + : 0.0D0, 0.0D0, 0.0D0, 0.0D0, + : 0.4D0, -10.8D0, 0.3D0, 0.0D0, + : 9.6D0, 2.2D0, 0.3D0, -1.2D0 / + + + +* Interval between fundamental epoch J2000.0 and given epoch (JC). + T = (DATE-DJM0)/DJC + +* Mean anomaly of the Moon. + EL = 134.96340251D0*DD2R+ + : MOD(T*(1717915923.2178D0+ + : T*( 31.8792D0+ + : T*( 0.051635D0+ + : T*( - 0.00024470D0)))),TURNAS)*DAS2R + +* Mean anomaly of the Sun. + ELP = 357.52910918D0*DD2R+ + : MOD(T*( 129596581.0481D0+ + : T*( - 0.5532D0+ + : T*( 0.000136D0+ + : T*( - 0.00001149D0)))),TURNAS)*DAS2R + +* Mean argument of the latitude of the Moon. + F = 93.27209062D0*DD2R+ + : MOD(T*(1739527262.8478D0+ + : T*( - 12.7512D0+ + : T*( - 0.001037D0+ + : T*( 0.00000417D0)))),TURNAS)*DAS2R + +* Mean elongation of the Moon from the Sun. + D = 297.85019547D0*DD2R+ + : MOD(T*(1602961601.2090D0+ + : T*( - 6.3706D0+ + : T*( 0.006539D0+ + : T*( - 0.00003169D0)))),TURNAS)*DAS2R + +* Mean longitude of the ascending node of the Moon. + OM = 125.04455501D0*DD2R+ + : MOD(T*( - 6962890.5431D0+ + : T*( 7.4722D0+ + : T*( 0.007702D0+ + : T*( - 0.00005939D0)))),TURNAS)*DAS2R + +* Mean longitude of Venus. + VE = 181.97980085D0*DD2R+MOD(210664136.433548D0*T,TURNAS)*DAS2R + +* Mean longitude of Mars. + MA = 355.43299958D0*DD2R+MOD( 68905077.493988D0*T,TURNAS)*DAS2R + +* Mean longitude of Jupiter. + JU = 34.35151874D0*DD2R+MOD( 10925660.377991D0*T,TURNAS)*DAS2R + +* Mean longitude of Saturn. + SA = 50.07744430D0*DD2R+MOD( 4399609.855732D0*T,TURNAS)*DAS2R + +* Geodesic nutation (Fukushima 1991) in microarcsec. + DP = -153.1D0*SIN(ELP)-1.9D0*SIN(2D0*ELP) + DE = 0D0 + +* Shirai & Fukushima (2001) nutation series. + DO J=NTERMS,1,-1 + THETA = DBLE(NA(1,J))*EL+ + : DBLE(NA(2,J))*ELP+ + : DBLE(NA(3,J))*F+ + : DBLE(NA(4,J))*D+ + : DBLE(NA(5,J))*OM+ + : DBLE(NA(6,J))*VE+ + : DBLE(NA(7,J))*MA+ + : DBLE(NA(8,J))*JU+ + : DBLE(NA(9,J))*SA + C = COS(THETA) + S = SIN(THETA) + DP = DP+(PSI(1,J)+PSI(3,J)*T)*C+(PSI(2,J)+PSI(4,J)*T)*S + DE = DE+(EPS(1,J)+EPS(3,J)*T)*C+(EPS(2,J)+EPS(4,J)*T)*S + END DO + +* Change of units, and addition of the precession correction. + DPSI = (DP*1D-6-0.042888D0-0.29856D0*T)*DAS2R + DEPS = (DE*1D-6-0.005171D0-0.02408D0*T)*DAS2R + +* Mean obliquity of date (Simon et al. 1994). + EPS0 = (84381.412D0+ + : (-46.80927D0+ + : (-0.000152D0+ + : (0.0019989D0+ + : (-0.00000051D0+ + : (-0.000000025D0)*T)*T)*T)*T)*T)*DAS2R + + END + SUBROUTINE sla_NUT (DATE, RMATN) +*+ +* - - - - +* N U T +* - - - - +* +* Form the matrix of nutation for a given date - Shirai & Fukushima +* 2001 theory (double precision) +* +* Reference: +* Shirai, T. & Fukushima, T., Astron.J. 121, 3270-3283 (2001). +* +* Given: +* DATE d TDB (loosely ET) as Modified Julian Date +* (=JD-2400000.5) +* Returned: +* RMATN d(3,3) nutation matrix +* +* Notes: +* +* 1 The matrix is in the sense v(true) = rmatn * v(mean) . +* where v(true) is the star vector relative to the true equator and +* equinox of date and v(mean) is the star vector relative to the +* mean equator and equinox of date. +* +* 2 The matrix represents forced nutation (but not free core +* nutation) plus corrections to the IAU~1976 precession model. +* +* 3 Earth attitude predictions made by combining the present nutation +* matrix with IAU~1976 precession are accurate to 1~mas (with +* respect to the ICRS) for a few decades around 2000. +* +* 4 The distinction between the required TDB and TT is always +* negligible. Moreover, for all but the most critical applications +* UTC is adequate. +* +* Called: sla_NUTC, sla_DEULER +* +* Last revision: 1 December 2005 +* +* Copyright P.T.Wallace. All rights reserved. +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION DATE,RMATN(3,3) + + DOUBLE PRECISION DPSI,DEPS,EPS0 + + + +* Nutation components and mean obliquity + CALL sla_NUTC(DATE,DPSI,DEPS,EPS0) + +* Rotation matrix + CALL sla_DEULER('XZX',EPS0,-DPSI,-(EPS0+DEPS),RMATN) + + END + SUBROUTINE sla_PREBN (BEP0, BEP1, RMATP) +*+ +* - - - - - - +* P R E B N +* - - - - - - +* +* Generate the matrix of precession between two epochs, +* using the old, pre-IAU1976, Bessel-Newcomb model, using +* Kinoshita's formulation (double precision) +* +* Given: +* BEP0 dp beginning Besselian epoch +* BEP1 dp ending Besselian epoch +* +* Returned: +* RMATP dp(3,3) precession matrix +* +* The matrix is in the sense V(BEP1) = RMATP * V(BEP0) +* +* Reference: +* Kinoshita, H. (1975) 'Formulas for precession', SAO Special +* Report No. 364, Smithsonian Institution Astrophysical +* Observatory, Cambridge, Massachusetts. +* +* Called: sla_DEULER +* +* P.T.Wallace Starlink 23 August 1996 +* +* Copyright (C) 1996 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION BEP0,BEP1,RMATP(3,3) + +* Arc seconds to radians + DOUBLE PRECISION AS2R + PARAMETER (AS2R=0.484813681109535994D-5) + + DOUBLE PRECISION BIGT,T,TAS2R,W,ZETA,Z,THETA + + + +* Interval between basic epoch B1850.0 and beginning epoch in TC + BIGT = (BEP0-1850D0)/100D0 + +* Interval over which precession required, in tropical centuries + T = (BEP1-BEP0)/100D0 + +* Euler angles + TAS2R = T*AS2R + W = 2303.5548D0+(1.39720D0+0.000059D0*BIGT)*BIGT + + ZETA = (W+(0.30242D0-0.000269D0*BIGT+0.017996D0*T)*T)*TAS2R + Z = (W+(1.09478D0+0.000387D0*BIGT+0.018324D0*T)*T)*TAS2R + THETA = (2005.1125D0+(-0.85294D0-0.000365D0*BIGT)*BIGT+ + : (-0.42647D0-0.000365D0*BIGT-0.041802D0*T)*T)*TAS2R + +* Rotation matrix + CALL sla_DEULER('ZYZ',-ZETA,THETA,-Z,RMATP) + + END + SUBROUTINE sla_PRECES (SYSTEM, EP0, EP1, RA, DC) +*+ +* - - - - - - - +* P R E C E S +* - - - - - - - +* +* Precession - either FK4 (Bessel-Newcomb, pre IAU 1976) or +* FK5 (Fricke, post IAU 1976) as required. +* +* Given: +* SYSTEM char precession to be applied: 'FK4' or 'FK5' +* EP0,EP1 dp starting and ending epoch +* RA,DC dp RA,Dec, mean equator & equinox of epoch EP0 +* +* Returned: +* RA,DC dp RA,Dec, mean equator & equinox of epoch EP1 +* +* Called: sla_DRANRM, sla_PREBN, sla_PREC, sla_DCS2C, +* sla_DMXV, sla_DCC2S +* +* Notes: +* +* 1) Lowercase characters in SYSTEM are acceptable. +* +* 2) The epochs are Besselian if SYSTEM='FK4' and Julian if 'FK5'. +* For example, to precess coordinates in the old system from +* equinox 1900.0 to 1950.0 the call would be: +* CALL sla_PRECES ('FK4', 1900D0, 1950D0, RA, DC) +* +* 3) This routine will NOT correctly convert between the old and +* the new systems - for example conversion from B1950 to J2000. +* For these purposes see sla_FK425, sla_FK524, sla_FK45Z and +* sla_FK54Z. +* +* 4) If an invalid SYSTEM is supplied, values of -99D0,-99D0 will +* be returned for both RA and DC. +* +* P.T.Wallace Starlink 20 April 1990 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + CHARACTER SYSTEM*(*) + DOUBLE PRECISION EP0,EP1,RA,DC + + DOUBLE PRECISION PM(3,3),V1(3),V2(3) + CHARACTER SYSUC*3 + + DOUBLE PRECISION sla_DRANRM + + + + +* Convert to uppercase and validate SYSTEM + SYSUC=SYSTEM + IF (SYSUC(1:1).EQ.'f') SYSUC(1:1)='F' + IF (SYSUC(2:2).EQ.'k') SYSUC(2:2)='K' + IF (SYSUC.NE.'FK4'.AND.SYSUC.NE.'FK5') THEN + RA=-99D0 + DC=-99D0 + ELSE + +* Generate appropriate precession matrix + IF (SYSUC.EQ.'FK4') THEN + CALL sla_PREBN(EP0,EP1,PM) + ELSE + CALL sla_PREC(EP0,EP1,PM) + END IF + +* Convert RA,Dec to x,y,z + CALL sla_DCS2C(RA,DC,V1) + +* Precess + CALL sla_DMXV(PM,V1,V2) + +* Back to RA,Dec + CALL sla_DCC2S(V2,RA,DC) + RA=sla_DRANRM(RA) + + END IF + + END + SUBROUTINE sla_PREC (EP0, EP1, RMATP) +*+ +* - - - - - +* P R E C +* - - - - - +* +* Form the matrix of precession between two epochs (IAU 1976, FK5) +* (double precision) +* +* Given: +* EP0 dp beginning epoch +* EP1 dp ending epoch +* +* Returned: +* RMATP dp(3,3) precession matrix +* +* Notes: +* +* 1) The epochs are TDB (loosely ET) Julian epochs. +* +* 2) The matrix is in the sense V(EP1) = RMATP * V(EP0) +* +* 3) Though the matrix method itself is rigorous, the precession +* angles are expressed through canonical polynomials which are +* valid only for a limited time span. There are also known +* errors in the IAU precession rate. The absolute accuracy +* of the present formulation is better than 0.1 arcsec from +* 1960AD to 2040AD, better than 1 arcsec from 1640AD to 2360AD, +* and remains below 3 arcsec for the whole of the period +* 500BC to 3000AD. The errors exceed 10 arcsec outside the +* range 1200BC to 3900AD, exceed 100 arcsec outside 4200BC to +* 5600AD and exceed 1000 arcsec outside 6800BC to 8200AD. +* The SLALIB routine sla_PRECL implements a more elaborate +* model which is suitable for problems spanning several +* thousand years. +* +* References: +* Lieske,J.H., 1979. Astron.Astrophys.,73,282. +* equations (6) & (7), p283. +* Kaplan,G.H., 1981. USNO circular no. 163, pA2. +* +* Called: sla_DEULER +* +* P.T.Wallace Starlink 23 August 1996 +* +* Copyright (C) 1996 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION EP0,EP1,RMATP(3,3) + +* Arc seconds to radians + DOUBLE PRECISION AS2R + PARAMETER (AS2R=0.484813681109535994D-5) + + DOUBLE PRECISION T0,T,TAS2R,W,ZETA,Z,THETA + + + +* Interval between basic epoch J2000.0 and beginning epoch (JC) + T0 = (EP0-2000D0)/100D0 + +* Interval over which precession required (JC) + T = (EP1-EP0)/100D0 + +* Euler angles + TAS2R = T*AS2R + W = 2306.2181D0+(1.39656D0-0.000139D0*T0)*T0 + + ZETA = (W+((0.30188D0-0.000344D0*T0)+0.017998D0*T)*T)*TAS2R + Z = (W+((1.09468D0+0.000066D0*T0)+0.018203D0*T)*T)*TAS2R + THETA = ((2004.3109D0+(-0.85330D0-0.000217D0*T0)*T0) + : +((-0.42665D0-0.000217D0*T0)-0.041833D0*T)*T)*TAS2R + +* Rotation matrix + CALL sla_DEULER('ZYZ',-ZETA,THETA,-Z,RMATP) + + END + SUBROUTINE sla_PVOBS (P, H, STL, PV) +*+ +* - - - - - - +* P V O B S +* - - - - - - +* +* Position and velocity of an observing station (double precision) +* +* Given: +* P dp latitude (geodetic, radians) +* H dp height above reference spheroid (geodetic, metres) +* STL dp local apparent sidereal time (radians) +* +* Returned: +* PV dp(6) position/velocity 6-vector (AU, AU/s, true equator +* and equinox of date) +* +* Called: sla_GEOC +* +* IAU 1976 constants are used. +* +* P.T.Wallace Starlink 14 November 1994 +* +* Copyright (C) 1995 Rutherford Appleton Laboratory +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + DOUBLE PRECISION P,H,STL,PV(6) + + DOUBLE PRECISION R,Z,S,C,V + +* Mean sidereal rate (at J2000) in radians per (UT1) second + DOUBLE PRECISION SR + PARAMETER (SR=7.292115855306589D-5) + + + +* Geodetic to geocentric conversion + CALL sla_GEOC(P,H,R,Z) + +* Functions of ST + S=SIN(STL) + C=COS(STL) + +* Speed + V=SR*R + +* Position + PV(1)=R*C + PV(2)=R*S + PV(3)=Z + +* Velocity + PV(4)=-V*S + PV(5)=V*C + PV(6)=0D0 + + END diff --git a/wsjtx_lib/lib/sleep.h b/wsjtx_lib/lib/sleep.h new file mode 100644 index 0000000..df60bc9 --- /dev/null +++ b/wsjtx_lib/lib/sleep.h @@ -0,0 +1,32 @@ +/* + * sleep.h 1.0 02/03/10 + * + * Defines cross-platform sleep, usleep, etc. + * + * By Wu Yongwei + * + */ + +#ifndef _SLEEP_H +#define _SLEEP_H + +#ifdef _WIN32 +# if defined(_NEED_SLEEP_ONLY) && (defined(_MSC_VER) || defined(__MINGW32__)) +# include +# define sleep(t) _sleep((t) * 1000) +# else +# include +# define sleep(t) Sleep((t) * 1000) +# endif +# ifndef _NEED_SLEEP_ONLY +# define msleep(t) Sleep(t) +# define usleep(t) Sleep((t) / 1000) +# endif +#else +# include +# ifndef _NEED_SLEEP_ONLY +# define msleep(t) usleep((t) * 1000) +# endif +#endif + +#endif /* _SLEEP_H */ diff --git a/wsjtx_lib/lib/sleep_msec.f90 b/wsjtx_lib/lib/sleep_msec.f90 new file mode 100644 index 0000000..1a8dbe4 --- /dev/null +++ b/wsjtx_lib/lib/sleep_msec.f90 @@ -0,0 +1,4 @@ +subroutine sleep_msec(n) + call usleep(n*1000) + return +end subroutine sleep_msec diff --git a/wsjtx_lib/lib/slope.f90 b/wsjtx_lib/lib/slope.f90 new file mode 100644 index 0000000..e842097 --- /dev/null +++ b/wsjtx_lib/lib/slope.f90 @@ -0,0 +1,40 @@ +subroutine slope(y,npts,xpk) + +! Remove best-fit slope from data in y(i). When fitting the straight line, +! ignore the peak around xpk +/- 4 bins + + real y(npts) + + sumw=0. + sumx=0. + sumy=0. + sumx2=0. + sumxy=0. + sumy2=0. + do i=1,npts + if(abs(i-xpk).gt.4.0) then + sumw=sumw + 1.0 + x=i + sumx=sumx + x + sumy=sumy + y(i) + sumx2=sumx2 + x*x + sumxy=sumxy + x*y(i) + sumy2=sumy2 + y(i)**2 + endif + enddo + + delta=sumw*sumx2 - sumx**2 + a=(sumx2*sumy - sumx*sumxy) / delta + b=(sumw*sumxy - sumx*sumy) / delta + + sq=0. + do i=1,npts + y(i)=y(i)-(a + b*i) + if(abs(i-xpk).gt.4.0) sq=sq + y(i)**2 + enddo + rms=sqrt(sq/(sumw-4.0)) + y=y/rms + + return +end subroutine slope + diff --git a/wsjtx_lib/lib/smo.f90 b/wsjtx_lib/lib/smo.f90 new file mode 100644 index 0000000..c42de7c --- /dev/null +++ b/wsjtx_lib/lib/smo.f90 @@ -0,0 +1,19 @@ +subroutine smo(x,npts,y,nadd) + + real x(npts) + real y(npts) + + nh=nadd/2 + do i=1+nh,npts-nh + sum=0. + do j=-nh,nh + sum=sum + x(i+j) + enddo + y(i)=sum + enddo + x=y + x(:nh)=0. + x(npts-nh+1:)=0. + + return +end subroutine smo diff --git a/wsjtx_lib/lib/smo121.f90 b/wsjtx_lib/lib/smo121.f90 new file mode 100644 index 0000000..d50b790 --- /dev/null +++ b/wsjtx_lib/lib/smo121.f90 @@ -0,0 +1,13 @@ +subroutine smo121(x,nz) + + real x(nz) + + x0=x(1) + do i=2,nz-1 + x1=x(i) + x(i)=0.5*x(i) + 0.25*(x0+x(i+1)) + x0=x1 + enddo + + return +end subroutine smo121 diff --git a/wsjtx_lib/lib/smolorentz.f90 b/wsjtx_lib/lib/smolorentz.f90 new file mode 100644 index 0000000..70132f5 --- /dev/null +++ b/wsjtx_lib/lib/smolorentz.f90 @@ -0,0 +1,42 @@ +!program smolorentz +subroutine smolorentz(s1,nz,w,s2) + +! parameter (nz=512) + real s1(nz),s2(nz) + real y(-50:50) +! character*8 arg + +! s1=0. +! s1(256)=1. + +! call getarg(1,arg) +! read(arg,*) w + + do i=-50,50 + x=i + z=x/(0.5*w) + y(i)=0. + if(abs(z).lt.3.0) then + d=1.0 + z*z + y(i)=(1.0/d - 0.1)*10.0/9.0 + endif + enddo + + jz=nint(1.5*w) + if(jz.gt.50) jz=50 + do i=1,nz + s=0. + sy=0. + do j=-jz,jz + k=i+j + if(k.ge.1 .and. k.le.nz) then + s=s + s1(k)*y(j) + sy=sy+y(j) + endif + enddo + s2(i)=s/sy +! write(52,3002) i-256,s1(i),s2(i) +!3002 format(i5,2f10.4) + enddo + +end subroutine smolorentz diff --git a/wsjtx_lib/lib/softsym.f90 b/wsjtx_lib/lib/softsym.f90 new file mode 100644 index 0000000..4b7f9bc --- /dev/null +++ b/wsjtx_lib/lib/softsym.f90 @@ -0,0 +1,54 @@ +subroutine softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, & + freq,drift,a3,schk,i1SoftSymbols) + +! Compute the soft symbols + + use timer_module, only: timer + + parameter (NZ2=1512,NZ3=1360) + logical, intent(inout) :: newdat + complex c2(0:NZ2-1) + complex c3(0:NZ3-1) + complex c5(0:NZ3-1) + real a(3) + integer*1 i1SoftSymbolsScrambled(207) + integer*1 i1SoftSymbols(207) + include 'jt9sync.f90' + + nspsd=16 + ndown=nsps8/nspsd + +! Mix, low-pass filter, and downsample to 16 samples per symbol + call timer('downsam9',0) + call downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2) + call timer('downsam9',1) + + call peakdt9(c2,nsps8,nspsd,c3,xdt) !Find DT + + fsample=1500.0/ndown + a=0. + call timer('afc9 ',0) + call afc9(c3,nz3,fsample,a,syncpk) !Find deltaF, fDot, extra DT + call timer('afc9 ',1) + freq=fpk - a(1) + drift=-2.0*a(2) +! write(*,3301) fpk,freq,a +!3301 format(2f9.3,3f10.4) + a3=a(3) + a(3)=0. + + call timer('twkfreq ',0) + call twkfreq(c3,c5,nz3,fsample,a) !Correct for delta f, f1, f2 ==> a(1:3) + call timer('twkfreq ',1) + +! Compute soft symbols (in scrambled order) + call timer('symspec2',0) + call symspec2(c5,nz3,nsps8,nspsd,fsample,freq,drift,snrdb,schk, & + i1SoftSymbolsScrambled) + call timer('symspec2',1) + +! Remove interleaving + call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols) + + return +end subroutine softsym diff --git a/wsjtx_lib/lib/softsym9f.f90 b/wsjtx_lib/lib/softsym9f.f90 new file mode 100644 index 0000000..bb505f0 --- /dev/null +++ b/wsjtx_lib/lib/softsym9f.f90 @@ -0,0 +1,55 @@ +subroutine softsym9f(ss2,ss3,i1SoftSymbols) + +! Compute soft symbols and S/N + + real ss2(0:8,85) + real ss3(0:7,69) + integer*1 i1SoftSymbolsScrambled(207) + integer*1 i1SoftSymbols(207) + + ss=0. + sig=0. + if(ss2(0,1).eq.-999.0) return !Silence compiler warning + do j=1,69 + smax=0. + do i=0,7 + smax=max(smax,ss3(i,j)) + ss=ss+ss3(i,j) + enddo + sig=sig+smax + ss=ss-smax + enddo + ave=ss/(69*7) !Baseline +! call pctile(ss2,9*85,35,xmed) !### better? ### + ss3=ss3/ave + sig=sig/69. !Signal + + m0=3 + k=0 + scale=10.0 + do j=1,69 + do m=m0-1,0,-1 !Get bit-wise soft symbols + if(m.eq.2) then + r1=max(ss3(4,j),ss3(5,j),ss3(6,j),ss3(7,j)) + r0=max(ss3(0,j),ss3(1,j),ss3(2,j),ss3(3,j)) + else if(m.eq.1) then + r1=max(ss3(2,j),ss3(3,j),ss3(4,j),ss3(5,j)) + r0=max(ss3(0,j),ss3(1,j),ss3(6,j),ss3(7,j)) + else + r1=max(ss3(1,j),ss3(2,j),ss3(4,j),ss3(7,j)) + r0=max(ss3(0,j),ss3(3,j),ss3(5,j),ss3(6,j)) + endif + + k=k+1 + i4=nint(scale*(r1-r0)) + if(i4.lt.-127) i4=-127 + if(i4.gt.127) i4=127 + i1SoftSymbolsScrambled(k)=i4 + enddo + enddo + + + call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols) + + return +end subroutine softsym9f diff --git a/wsjtx_lib/lib/softsym9w.f90 b/wsjtx_lib/lib/softsym9w.f90 new file mode 100644 index 0000000..c9b1d0a --- /dev/null +++ b/wsjtx_lib/lib/softsym9w.f90 @@ -0,0 +1,125 @@ +subroutine softsym9w(id2,npts,xdt0,f0,width,nsubmode,xdt1,snrdb,i1softsymbols) + + parameter (NFFT=6912,NH=NFFT/2,NQ=NH/2) + real s(NQ) + real s2(0:8,85) + real s3(0:7,69) + real x(NFFT) + complex cx(0:NH) + integer*2 id2(60*12000) + integer*1 i1SoftSymbolsScrambled(207) + integer*1 i1softsymbols(207) + include 'jt9sync.f90' + equivalence (x,cx) + + if(npts.eq.-99) stop !Silence compiler warning + df=12000.0/NFFT + i0a=max(1.0,(xdt0-1.0)*12000.0) + i0b=(xdt0+1.0)*12000.0 + k1=max(1,nint((f0-0.5*width)/df)) + k2=min(NQ,nint((f0+0.5*width)/df)) + smax=0. + i0pk=1 + i1softsymbols=0 + + do i0=i0a,i0b,432 + s=0. + ssum=0. + do j=1,16 + ia=i0 + (ii(j)-1)*nfft + ib=ia+NFFT-1 + x=1.e-6*id2(ia:ib) + call four2a(x,nfft,1,-1,0) !r2c FFT + do k=1,NQ + s(k)=s(k) + real(cx(k))**2 + aimag(cx(k))**2 + enddo + enddo + ssum=ssum + sum(s(k1:k2)) + if(ssum.gt.smax) then + smax=ssum + i0pk=i0 + else + if(ssum.lt.0.7*smax) exit + endif + end do + xdt1=(i0pk-1)/12000.0 + + if(i0pk.le.0) go to 999 + + m=0 + do j=1,85 + ia=i0pk + (j-1)*nfft + ib=ia+NFFT-1 + x=1.e-6*id2(ia:ib) + call four2a(x,nfft,1,-1,0) !r2c FFT + do k=1,NQ + s(k)=real(cx(k))**2 + aimag(cx(k))**2 + enddo + + dtone=df*(2**nsubmode) + do i=0,8 + f=f0 + i*dtone + k1=max(1,nint((f-0.5*width)/df)) + k2=min(NQ,nint((f+0.5*width)/df)) + s2(i,j)=sum(s(k1:k2)) !Symbol spectra, including sync + enddo + + if(isync(j).eq.0) then + m=m+1 + s3(0:7,m)=s2(1:8,j) !Symbol spectra, data only + endif + +! write(19,3101) j,s2(0:8,j) +!3101 format(i2,9f8.2) + enddo + + ss=0. + sig=0. + do j=1,69 + smax=0. + do i=0,7 + smax=max(smax,s3(i,j)) + ss=ss+s3(i,j) + enddo + sig=sig+smax + ss=ss-smax + enddo + ave=ss/(69*7) !Baseline + call pctile(s2,9*85,35,xmed) + s3=s3/ave + sig=sig/69. !Signal + snrdb=db(sig/xmed) - 28.0 + + m0=3 + k=0 + do j=1,69 + smax=0. + do i=0,7 + if(s3(i,j).gt.smax) smax=s3(i,j) + enddo + + do m=m0-1,0,-1 !Get bit-wise soft symbols + if(m.eq.2) then + r1=max(s3(4,j),s3(5,j),s3(6,j),s3(7,j)) + r0=max(s3(0,j),s3(1,j),s3(2,j),s3(3,j)) + else if(m.eq.1) then + r1=max(s3(2,j),s3(3,j),s3(4,j),s3(5,j)) + r0=max(s3(0,j),s3(1,j),s3(6,j),s3(7,j)) + else + r1=max(s3(1,j),s3(2,j),s3(4,j),s3(7,j)) + r0=max(s3(0,j),s3(3,j),s3(5,j),s3(6,j)) + endif + + k=k+1 + i4=nint(10.0*(r1-r0)) + if(i4.lt.-127) i4=-127 + if(i4.gt.127) i4=127 + i1SoftSymbolsScrambled(k)=i4 + enddo + enddo + +! Remove interleaving + call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols) + +999 return +end subroutine softsym9w diff --git a/wsjtx_lib/lib/sort.f90 b/wsjtx_lib/lib/sort.f90 new file mode 100644 index 0000000..0a90a6b --- /dev/null +++ b/wsjtx_lib/lib/sort.f90 @@ -0,0 +1,96 @@ +subroutine sort(n,arr) + + integer n,m,nstack + real arr(n) + parameter (m=7,nstack=50) + integer i,ir,j,jstack,k,l,istack(nstack) + real a,temp + + jstack=0 + l=1 + ir=n + n0=n + +1 if(ir-l.lt.m) then + do j=l+1,ir + a=arr(j) + do i=j-1,1,-1 + if(arr(i).le.a) goto 2 + arr(i+1)=arr(i) + enddo + i=0 +2 arr(i+1)=a + enddo + + if(jstack.eq.0) return + + ir=istack(jstack) + l=istack(jstack-1) + jstack=jstack-2 + + else + k=(l+ir)/2 + temp=arr(k) + arr(k)=arr(l+1) + arr(l+1)=temp + + if(arr(l+1).gt.arr(ir)) then + temp=arr(l+1) + arr(l+1)=arr(ir) + arr(ir)=temp + endif + + if(arr(l).gt.arr(ir)) then + temp=arr(l) + arr(l)=arr(ir) + arr(ir)=temp + endif + + if(arr(l+1).gt.arr(l)) then + temp=arr(l+1) + arr(l+1)=arr(l) + arr(l)=temp + endif + + i=l+1 + j=ir + a=arr(l) +3 i=i+1 + if(i.gt.n0) then + do jj=1,n0 + write(99,3001) jj,arr(jj),i,n,ir +3001 format(i10,e12.3,3i10) + enddo + close(99) + stop 'Bounds error in sort.f90' + endif + if(arr(i).lt.a) goto 3 + +4 j=j-1 + if(arr(j).gt.a) goto 4 + + if(j.lt.i) goto 5 + temp=arr(i) + arr(i)=arr(j) + arr(j)=temp + goto 3 + +5 arr(l)=arr(j) + arr(j)=a + jstack=jstack+2 + if(jstack.gt.nstack) stop 'nstack too small in sort' + + if(ir-i+1.ge.j-l) then + istack(jstack)=ir + istack(jstack-1)=i + ir=j-1 + else + istack(jstack)=j-1 + istack(jstack-1)=l + l=i + endif + + endif + goto 1 + +end subroutine sort diff --git a/wsjtx_lib/lib/spec64.f90 b/wsjtx_lib/lib/spec64.f90 new file mode 100644 index 0000000..7932205 --- /dev/null +++ b/wsjtx_lib/lib/spec64.f90 @@ -0,0 +1,53 @@ +subroutine spec64(c0,npts,nsps,mode_q65,jpk,s3,LL,NN) + + parameter (MAXFFT=20736) + complex c0(0:npts-1) !Complex spectrum of dd() + complex cs(0:MAXFFT-1) !Complex symbol spectrum + real s3(LL,NN) !Synchronized symbol spectra + real xbase0(LL),xbase(LL) +! integer ipk1(1) + integer isync(22) !Indices of sync symbols + data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + + nfft=nsps + j=0 + n=1 + do k=1,84 + if(k.eq.isync(n)) then + n=n+1 + cycle + endif + j=j+1 + ja=(k-1)*nsps + jpk + jb=ja+nsps-1 + if(ja.lt.0) ja=0 + if(jb.gt.npts-1) jb=npts-1 + nz=jb-ja + cs(0:nz)=c0(ja:jb) + if(nz.lt.nfft-1) cs(nz+1:)=0. + call four2a(cs,nsps,1,-1,1) !c2c FFT to frequency + do ii=1,LL + i=ii-65+mode_q65 !mode_q65 = 1 2 4 8 16 for Q65 A B C D E + if(i.lt.0) i=i+nsps + s3(ii,j)=real(cs(i))**2 + aimag(cs(i))**2 + enddo + enddo + + df=6000.0/nfft + do i=1,LL + call pctile(s3(i,1:NN),NN,45,xbase0(i)) !Get baseline for passband shape + enddo + + nh=25 + xbase(1:nh-1)=sum(xbase0(1:nh-1))/(nh-1.0) + xbase(LL-nh+1:LL)=sum(xbase0(LL-nh+1:LL))/(nh-1.0) + do i=nh,LL-nh + xbase(i)=sum(xbase0(i-nh+1:i+nh))/(2*nh+1) !Smoothed passband shape + enddo + + do i=1,LL + s3(i,1:NN)=s3(i,1:NN)/(xbase(i)+0.001) !Apply frequency equalization + enddo + + return +end subroutine spec64 diff --git a/wsjtx_lib/lib/spec9f.f90 b/wsjtx_lib/lib/spec9f.f90 new file mode 100644 index 0000000..96dac29 --- /dev/null +++ b/wsjtx_lib/lib/spec9f.f90 @@ -0,0 +1,30 @@ +subroutine spec9f(id2,npts,nsps,s1,jz,nq) + +! Compute symbol spectra at quarter-symbol steps. + + integer*2 id2(0:npts) + real s1(nq,jz) + real x(960) + complex c(0:480) + equivalence (x,c) + + nfft=2*nsps !FFTs at twice the symbol length + nh=nfft/2 + do j=1,jz + ia=(j-1)*nsps/4 + ib=ia+nsps-1 + if(ib.gt.npts) exit + x(1:nh)=id2(ia:ib) + x(nh+1:)=0. + call four2a(x,nfft,1,-1,0) !r2c + k=mod(j-1,340)+1 + do i=1,NQ + s1(i,j)=1.e-10*(real(c(i))**2 + aimag(c(i))**2) + enddo + enddo + +!### Reference spectrum should be applied here (or possibly earlier?) ### +!### Normalize so that rms (or level?) is 1.0 ? ### + + return +end subroutine spec9f diff --git a/wsjtx_lib/lib/spec_qra65.f90 b/wsjtx_lib/lib/spec_qra65.f90 new file mode 100644 index 0000000..15e8fd0 --- /dev/null +++ b/wsjtx_lib/lib/spec_qra65.f90 @@ -0,0 +1,50 @@ +subroutine spec_qra65(c0,nsps,s3,LL,NN) + +! Compute synchronized symbol spectra. + + complex c0(0:85*nsps-1) !Synchronized complex data at 6000 S/s + complex, allocatable :: cs(:) !Complex symbol spectrum + real s3(LL,NN) !Synchronized symbol spectra + real xbase0(LL),xbase(LL) !Work arrays + integer isync(22) !Indices of sync symbols + data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/ + + allocate(cs(0:nsps-1)) + fac=1.0/nsps + j=0 + n=1 + do k=1,84 + if(k.eq.isync(n)) then + n=n+1 + cycle + endif + j=j+1 + ja=(k-1)*nsps + jb=ja+nsps-1 + cs=fac*c0(ja:jb) + call four2a(cs,nsps,1,-1,1) !c2c FFT to frequency + do ii=1,LL + i=ii-65 + if(i.lt.0) i=i+nsps + s3(ii,j)=real(cs(i))**2 + aimag(cs(i))**2 + enddo + enddo + + df=6000.0/nsps + do i=1,LL + call pctile(s3(i,1:NN),NN,45,xbase0(i)) !Get baseline for passband shape + enddo + + nh=9 + xbase(1:nh-1)=sum(xbase0(1:nh-1))/(nh-1.0) + xbase(LL-nh+1:LL)=sum(xbase0(LL-nh+1:LL))/(nh-1.0) + do i=nh,LL-nh + xbase(i)=sum(xbase0(i-nh+1:i+nh))/(2*nh+1) !Smoothed passband shape + enddo + + do i=1,LL + s3(i,1:NN)=s3(i,1:NN)/(xbase(i)+0.001) !Apply frequency equalization + enddo + + return +end subroutine spec_qra65 diff --git a/wsjtx_lib/lib/ss.bat b/wsjtx_lib/lib/ss.bat new file mode 100644 index 0000000..3ea6cc6 --- /dev/null +++ b/wsjtx_lib/lib/ss.bat @@ -0,0 +1 @@ +svn status | grep -v "?" diff --git a/wsjtx_lib/lib/stats.f90 b/wsjtx_lib/lib/stats.f90 new file mode 100644 index 0000000..a864f6a --- /dev/null +++ b/wsjtx_lib/lib/stats.f90 @@ -0,0 +1,66 @@ +program stats + + character*8 arg + character*40 infile + character decoded*22 + + nargs=iargc() + if(nargs.lt.1) then + print*,'Usage: stats file1 ...' + go to 999 + endif + + ttol=0.1 + nftol=1 + write(*,1000) +1000 format(' SNR Files Sync BM FT Hint Total False BadSync'/ & + 56('-')) + + do ifile=1,nargs + call getarg(ifile,infile) + open(10,file=infile,status='old') + i1=index(infile,".")+1 + i2=40 + if(index(infile,"_").gt.1) i2=index(infile,"_") - 1 + snrgen=0. + read(infile(i1:i2),*,err=1) snrgen +1 snrgen=-snrgen + nsynced=0 + nbm=0 + nftok=0 + nhint=0 + ngood=0 + nbad=0 + nbadsync=0 + + do iline=1,999999 + read(10,1010,end=100) nutc,sync,nsnr,dt,nfreq,ncandidates,nhard, & + ntotal,rtt,ntry,nft,nqual,decoded +1010 format(i4.4,f5.1,i4,f5.1,i5,i6,i3,i4,f6.3,i8,i2,i3,1x,a22) + + ndfreq=abs(nfreq-1500) + if(sync.ge.1.0 .and. abs(dt).le.ttol .and. ndfreq.le.nftol) then + nsynced=nsynced+1 + else + nbadsync=nbadsync+1 + endif + + if(decoded.eq.' ') cycle + if(nft.eq.2 .or. (ntotal.le.81 .and. rtt.le.0.87)) then !nag=0 + if(decoded(1:11).eq.'K1ABC W9XYZ') then + ngood=ngood+1 + if(nft.eq.1 .and. ncandidates.eq.0) nbm=nbm+1 + if(nft.eq.1) nftok=nftok+1 + if(nft.ge.2) nhint=nhint+1 + else + nbad=nbad+1 + endif + endif + enddo + +100 write(*,1100) snrgen,nutc,nsynced,nbm,nftok,nhint,ngood,nbad, & + nbadsync +1100 format(f5.1,8i6) + enddo + +999 end program stats diff --git a/wsjtx_lib/lib/stdmsg.f90 b/wsjtx_lib/lib/stdmsg.f90 new file mode 100644 index 0000000..b4f4104 --- /dev/null +++ b/wsjtx_lib/lib/stdmsg.f90 @@ -0,0 +1,43 @@ +function stdmsg(msg0) + + ! Returns .true. if msg0 a standard "JT-style" message + + ! i3.n3 + ! 0.0 Free text + ! 0.1 DXpeditiion mode + ! 0.2 EU VHF Contest + ! 0.3 ARRL Field Day <=16 transmitters + ! 0.4 ARRL Field Day >16 transmitters + ! 0.5 telemetry + ! 0.6 + ! 0.7 + ! 1 Standard 77-bit structured message (optional /R) + ! 2 EU VHF Contest (optional /P) + ! 3 ARRL RTTY Contest + ! 4 Nonstandard calls + + use iso_c_binding, only: c_bool + use packjt + use packjt77 + + character*37 msg0,msg1 + character*77 c77 + logical(c_bool) :: stdmsg + + msg1=msg0 + i3=-1 + n3=-1 + call pack77(msg1,i3,n3,c77) + stdmsg=(i3.gt.0 .or. n3.gt.0) + +!### +! rewind 82 +! do i=1,nzhash +! write(82,3082) i,nzhash,callsign(i),ihash10(i),ihash12(i),ihash22(i) +!3082 format(2i5,2x,a13,3i10) +! enddo +! flush(82) +!### + + return +end function stdmsg diff --git a/wsjtx_lib/lib/subtract65.f90 b/wsjtx_lib/lib/subtract65.f90 new file mode 100644 index 0000000..cf6e00e --- /dev/null +++ b/wsjtx_lib/lib/subtract65.f90 @@ -0,0 +1,112 @@ +subroutine subtract65(dd,npts,f0,dt) + +! Subtract a jt65 signal +! +! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) +! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) +! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ] +! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt} + + use packjt + use timer_module, only: timer + + integer correct(63) + parameter (NMAX=60*12000) !Samples per 60 s + parameter (NFILT=1600) + real*4 dd(NMAX), window(-NFILT/2:NFILT/2) + complex cref,camp,cfilt,cw + integer nprc(126) + real*8 dphi,phi + logical first + data nprc/ & + 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & + 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & + 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & + 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & + 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & + 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & + 1,1,1,1,1,1/ + data first/.true./ + common/chansyms65/correct + common/heap1/cref(NMAX),camp(NMAX),cfilt(NMAX),cw(NMAX) + save first + + pi=4.0*atan(1.0) + +! Symbol duration is 4096/11025 s. +! Sample rate is 12000/s, so 12000*(4096/11025)=4458.23 samples/symbol. +! For now, call it 4458 samples/symbol. Over the message duration, we'll be off +! by about (4458.23-4458)*126=28.98 samples; 29 samples, or 0.7% of 1 symbol. +! Could eliminate accumulated error by injecting one extra sample every +! 5 or so symbols... Maybe try this later. + + nstart=dt*12000+1; + nsym=126 + ns=4458 + nref=nsym*ns + nend=nstart+nref-1 + phi=0.0 + iref=1 + ind=1 + isym=1 + call timer('subtr_1 ',0) + do k=1,nsym + if( nprc(k) .eq. 1 ) then + omega=2*pi*f0 + else + omega=2*pi*(f0+2.6917*(correct(isym)+2)) + isym=isym+1 + endif + dphi=omega/12000.0 + do i=1,ns + cref(ind)=cexp(cmplx(0.0,phi)) + phi=modulo(phi+dphi,2*pi) + id=nstart-1+ind + if(id.ge.1) camp(ind)=dd(id)*conjg(cref(ind)) + ind=ind+1 + enddo + enddo + call timer('subtr_1 ',1) + + call timer('subtr_2 ',0) +! Smoothing filter: do the convolution by means of FFTs. Ignore end-around +! cyclic effects for now. + + nfft=564480 + + if(first) then +! Create and normalize the filter + sum=0.0 + do j=-NFILT/2,NFILT/2 + window(j)=cos(pi*j/NFILT)**2 + sum=sum+window(j) + enddo + cw=0. + do i=-NFILT/2,NFILT/2 + j=i+1 + if(j.lt.1) j=j+nfft + cw(j)=window(i)/sum + enddo + call four2a(cw,nfft,1,-1,1) + first=.false. + endif + + nz=561708 + cfilt(1:nz)=camp(1:nz) + cfilt(nz+1:nfft)=0. + call four2a(cfilt,nfft,1,-1,1) + fac=1.0/float(nfft) + cfilt(1:nfft)=fac*cfilt(1:nfft)*cw(1:nfft) + call four2a(cfilt,nfft,1,1,1) + call timer('subtr_2 ',1) + +! Subtract the reconstructed signal + call timer('subtr_3 ',0) + do i=1,nref + j=nstart+i-1 + if(j.ge.1 .and. j.le.npts) dd(j)=dd(j)-2*REAL(cfilt(i)*cref(i)) + enddo + call timer('subtr_3 ',1) + + return +end subroutine subtract65 diff --git a/wsjtx_lib/lib/sumsim.f90 b/wsjtx_lib/lib/sumsim.f90 new file mode 100644 index 0000000..594b8b2 --- /dev/null +++ b/wsjtx_lib/lib/sumsim.f90 @@ -0,0 +1,42 @@ +program sumsim + +! Sum a number of *.wav files so that multiple signals are present + + use wavhdr + parameter (NMAX=60*12000) + type(hdr) h !Header for the .wav file + integer*2 iwave(NMAX) !i*2 data + real wave(NMAX) !r*4 data + character*80 fname + + nargs=iargc() + if(nargs.lt.1) then + print*,'Usage: sumsim file1 [file2, ...]' + go to 999 + endif + wave=0. + + do ifile=1,nargs + call getarg(ifile,fname) + open(10,file=trim(fname),status='old',access='stream') + read(10) h + npts=h%ndata/2 + nfsample=h%nsamrate + read(10) iwave(1:npts) + n=len(trim(fname)) + wave(1:npts)=wave(1:npts) + iwave(1:npts) + rms=sqrt(dot_product(wave(1:npts),wave(1:npts))/npts) + write(*,1000) ifile,npts,float(npts)/nfsample,rms,fname(n-14:n) +1000 format(i3,i8,f6.1,f10.3,2x,a15) + close(10) + enddo + +! fac=1.0/sqrt(float(nargs)) + fac=1.0/nargs + iwave(1:npts)=nint(fac*wave(1:npts)) + + open(12,file='000001_0000.wav',access='stream',status='unknown') + write(12) h,iwave(1:npts) + close(12) + +999 end program sumsim diff --git a/wsjtx_lib/lib/sun.f90 b/wsjtx_lib/lib/sun.f90 new file mode 100644 index 0000000..abecf7e --- /dev/null +++ b/wsjtx_lib/lib/sun.f90 @@ -0,0 +1,88 @@ +subroutine sun(y,m,DD,UT,lon,lat,RA,Dec,LST,Az,El,mjd,day) + + implicit none + + integer y !Year + integer m !Month + integer DD !Day + integer mjd !Modified Julian Date + real UT !UT!in hours + real RA,Dec !RA and Dec of sun + +! NB: Double caps here are single caps in the writeup. + +! Orbital elements of the Sun (also N=0, i=0, a=1): + real w !Argument of perihelion + real e !Eccentricity + real MM !Mean anomaly + real Ls !Mean longitude + +! Other standard variables: + real v !True anomaly + real EE !Eccentric anomaly + real ecl !Obliquity of the ecliptic + real d !Ephemeris time argument in days + real r !Distance to sun, AU + real xv,yv !x and y coords in ecliptic + real lonsun !Ecliptic long and lat of sun +!Ecliptic coords of sun (geocentric) + real xs,ys +!Equatorial coords of sun (geocentric) + real xe,ye,ze + real lon,lat + real GMST0,LST,HA + real xx,yy,zz + real xhor,yhor,zhor + real Az,El + + real day + real rad + data rad/57.2957795/ + +! Time in days, with Jan 0, 2000 equal to 0.0: + d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + DD - 730530 + UT/24.0 + mjd=d + 51543 + ecl = 23.4393 - 3.563e-7 * d + +! Compute updated orbital elements for Sun: + w = 282.9404 + 4.70935e-5 * d + e = 0.016709 - 1.151e-9 * d + MM = mod(356.0470d0 + 0.9856002585d0 * d + 360000.d0,360.d0) + Ls = mod(w+MM+720.0,360.0) + + EE = MM + e*rad*sin(MM/rad) * (1.0 + e*cos(M/rad)) + EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.0 - e*cos(EE/rad)) + + xv = cos(EE/rad) - e + yv = sqrt(1.0-e*e) * sin(EE/rad) + v = rad*atan2(yv,xv) + r = sqrt(xv*xv + yv*yv) + lonsun = mod(v + w + 720.0,360.0) +! Ecliptic coordinates of sun (rectangular): + xs = r * cos(lonsun/rad) + ys = r * sin(lonsun/rad) + +! Equatorial coordinates of sun (rectangular): + xe = xs + ye = ys * cos(ecl/rad) + ze = ys * sin(ecl/rad) + +! RA and Dec in degrees: + RA = rad*atan2(ye,xe) + Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye)) + + GMST0 = (Ls + 180.0)/15.0 + LST = mod(GMST0+UT+lon/15.0+48.0,24.0) !LST in hours + HA = 15.0*LST - RA !HA in degrees + xx = cos(HA/rad)*cos(Dec/rad) + yy = sin(HA/rad)*cos(Dec/rad) + zz = sin(Dec/rad) + xhor = xx*sin(lat/rad) - zz*cos(lat/rad) + yhor = yy + zhor = xx*cos(lat/rad) + zz*sin(lat/rad) + Az = mod(rad*atan2(yhor,xhor) + 180.0 + 360.0,360.0) + El = rad*asin(zhor) + day=d-1.5 + + return +end subroutine sun diff --git a/wsjtx_lib/lib/symspec.f90 b/wsjtx_lib/lib/symspec.f90 new file mode 100644 index 0000000..49adf10 --- /dev/null +++ b/wsjtx_lib/lib/symspec.f90 @@ -0,0 +1,126 @@ +subroutine symspec(shared_data,k,TRperiod,nsps,ingain,bLowSidelobes, & + nminw,pxdb,s,df3,ihsym,npts8,pxdbmax,npct) + +! Input: +! k pointer to the most recent new data +! TRperiod T/R sequence length, seconds +! nsps samples per symbol, at 12000 Hz +! bLowSidelobes true to use windowed FFTs +! ndiskdat 0/1 to indicate if data from disk + +! Output: +! pxdb raw power (0-90 dB) +! s() current spectrum for waterfall display +! ihsym index number of this half-symbol (1-184) for 60 s modes + +! jt9com +! ss() JT9 symbol spectra at half-symbol steps +! savg() average spectra for waterfall display + + use, intrinsic :: iso_c_binding, only: c_int, c_short, c_float, c_char + include 'jt9com.f90' + + type(dec_data) :: shared_data + real*8 TRperiod + real*4 w3(MAXFFT3) + real*4 s(NSMAX) + real*4 ssum(NSMAX) + real*4 xc(0:MAXFFT3-1) + real*4 tmp(NSMAX) + complex cx(0:MAXFFT3/2) + integer nch(7) + logical*1 bLowSidelobes + + common/spectra/syellow(NSMAX),ref(0:3456),filter(0:3456) + data k0/99999999/,nfft3z/0/ + data nch/1,2,4,9,18,36,72/ + equivalence (xc,cx) + save + + if(TRperiod+npct.eq.-999.9) stop !Silence compiler warning + nfft3=16384 !df=12000.0/16384 = 0.732422 + jstep=nsps/2 !Step size = half-symbol in id2() + if(k.gt.NMAX) go to 900 + if(k.lt.2048) then !(2048 was nfft3) (Any need for this ???) + ihsym=0 + go to 900 !Wait for enough samples to start + endif + + if(nfft3.ne.nfft3z) then +! Compute new window + pi=4.0*atan(1.0) + w3=0 + call nuttal_window(w3,nfft3) + nfft3z=nfft3 + endif + + if(k.lt.k0) then !Start a new data block + k0=0 + ja=0 + ssum=0. + ihsym=0 + if(.not. shared_data%params%ndiskdat) shared_data%id2(k+1:)=0 !Needed to prevent "ghosts". Not sure why. + endif + gain=10.0**(0.1*ingain) + sq=0. + pxmax=0.; + + do i=k0+1,k + if(k0.eq.0 .and. i.le.10) cycle + x1=shared_data%id2(i) + if (abs(x1).gt.pxmax) pxmax = abs(x1); + sq=sq + x1*x1 + enddo + pxdb = 0. + if(sq.gt.0.0) pxdb=10*log10(sq/(k-k0)) + pxdbmax=0. + if(pxmax.gt.0) pxdbmax = 20*log10(pxmax) + + k0=k + ja=ja+jstep !Index of first sample + + fac0=0.1 + do i=0,nfft3-1 !Copy data into cx + j=ja+i-(nfft3-1) + xc(i)=0. + if(j.ge.1 .and.j.le.NMAX) xc(i)=fac0*shared_data%id2(j) + enddo + ihsym=ihsym+1 + + if(bLowSidelobes) xc(0:nfft3-1)=w3(1:nfft3)*xc(0:nfft3-1) !Apply window + call four2a(xc,nfft3,1,-1,0) !Real-to-complex FFT + + df3=12000.0/nfft3 !JT9: 0.732 Hz = 0.42 * tone spacing + iz=min(NSMAX,nint(5000.0/df3)) + fac=(1.0/nfft3)**2 + do i=1,iz + j=i-1 + if(j.lt.0) j=j+nfft3 + sx=fac*(real(cx(j))**2 + aimag(cx(j))**2) + if(ihsym.le.184) shared_data%ss(ihsym,i)=sx + ssum(i)=ssum(i) + sx + s(i)=1000.0*gain*sx + enddo + + shared_data%savg=ssum/ihsym + + if(mod(ihsym,10).eq.0) then + mode4=nch(nminw+1) + nsmo=min(10*mode4,150) + nsmo=4*nsmo + call flat1(shared_data%savg,iz,nsmo,syellow) + if(mode4.ge.2) call smo(syellow,iz,tmp,mode4) + if(mode4.ge.2) call smo(syellow,iz,tmp,mode4) + syellow(1:250)=0. + ia=500./df3 + ib=2700.0/df3 + smin=minval(syellow(ia:ib)) + smax=maxval(syellow(1:iz)) + syellow=(50.0/(smax-smin))*(syellow-smin) + where(syellow<0) syellow=0. + endif + +900 npts8=k/8 + + return +end subroutine symspec diff --git a/wsjtx_lib/lib/symspec2.f90 b/wsjtx_lib/lib/symspec2.f90 new file mode 100644 index 0000000..90d0241 --- /dev/null +++ b/wsjtx_lib/lib/symspec2.f90 @@ -0,0 +1,88 @@ +subroutine symspec2(c5,nz3,nsps8,nspsd,fsample,freq,drift,snrdb,schk, & + i1SoftSymbolsScrambled) + +! Compute soft symbols from the final downsampled data + + complex c5(0:4096-1) + complex z + integer*1 i1SoftSymbolsScrambled(207) + real aa(3) + real ss2(0:8,85) + real ss3(0:7,69) + include 'jt9sync.f90' + data scale/10.0/ + + aa(1)=-1500.0/nsps8 + aa(2)=0. + aa(3)=0. + do i=0,8 !Loop over the 9 tones + if(i.ge.1) call twkfreq(c5,c5,nz3,fsample,aa) + m=0 + k=-1 + do j=1,85 !Loop over all symbols + z=0. + do n=1,nspsd !Sum over 16 samples + k=k+1 + z=z+c5(k) + enddo + ss2(i,j)=real(z)**2 + aimag(z)**2 !Symbol speactra, data and sync + if(i.ge.1 .and. isync(j).eq.0) then + m=m+1 + ss3(i-1,m)=ss2(i,j) !Symbol speactra, data only + endif + enddo + enddo + + call chkss2(ss2,freq,drift,schk) + + ss=0. + sig=0. + do j=1,69 + smax=0. + do i=0,7 + smax=max(smax,ss3(i,j)) + ss=ss+ss3(i,j) + enddo + sig=sig+smax + ss=ss-smax + enddo + ave=ss/(69*7) !Baseline + call pctile(ss2,9*85,35,xmed) + ss3=ss3/ave + sig=sig/69. !Signal + t=max(1.0,sig - 1.0) + snrdb=db(t) - 61.3 + + m0=3 + k=0 + do j=1,69 + smax=0. + do i=0,7 + if(ss3(i,j).gt.smax) smax=ss3(i,j) + enddo + + do m=m0-1,0,-1 !Get bit-wise soft symbols + if(m.eq.2) then + r1=max(ss3(4,j),ss3(5,j),ss3(6,j),ss3(7,j)) + r0=max(ss3(0,j),ss3(1,j),ss3(2,j),ss3(3,j)) + else if(m.eq.1) then + r1=max(ss3(2,j),ss3(3,j),ss3(4,j),ss3(5,j)) + r0=max(ss3(0,j),ss3(1,j),ss3(6,j),ss3(7,j)) + else + r1=max(ss3(1,j),ss3(2,j),ss3(4,j),ss3(7,j)) + r0=max(ss3(0,j),ss3(3,j),ss3(5,j),ss3(6,j)) + endif + + k=k+1 + i4=nint(scale*(r1-r0)) + if(i4.lt.-127) i4=-127 + if(i4.gt.127) i4=127 +! i4=i4+128 +! if(i4.le.127) i1SoftSymbolsScrambled(k)=i4 +! if(i4.ge.128) i1SoftSymbolsScrambled(k)=i4-256 + i1SoftSymbolsScrambled(k)=i4 + enddo + enddo + + return +end subroutine symspec2 diff --git a/wsjtx_lib/lib/symspec65.f90 b/wsjtx_lib/lib/symspec65.f90 new file mode 100644 index 0000000..b0dc284 --- /dev/null +++ b/wsjtx_lib/lib/symspec65.f90 @@ -0,0 +1,68 @@ +!subroutine symspec65(dd,npts,ss,nqsym,savg) +subroutine symspec65(dd,npts,nqsym,savg) + +! Compute JT65 symbol spectra at quarter-symbol steps + + parameter (NFFT=8192) + parameter (NSZ=3413) !NFFT*5000/12000 + parameter (MAXHSYM=322) + parameter (MAXQSYM=552) + real*8 hstep + real*4 dd(npts) +! real*4 ss(MAXHSYM,NSZ) + real*4 ss(MAXQSYM,NSZ) + real*4 savg(NSZ) + real*4 x(NFFT) + real*4 w(NFFT) + complex c(0:NFFT/2) + logical first + common/refspec/dfref,ref(NSZ) + equivalence (x,c) + data first/.true./ + save /refspec/,first,w + common/sync/ss + + hstep=2048.d0*12000.d0/11025.d0 !half-symbol = 2229.116 samples + qstep=hstep/2.0 !quarter-symbol = 1114.558 samples + nsps=nint(2*hstep) + df=12000.0/NFFT + nhsym=(npts-NFFT)/hstep + nqsym=(npts-NFFT)/qstep + savg=0. + fac1=1.e-3 + + if(first) then +! Compute the FFT window +! width=0.25*nsps + do i=1,NFFT +! z=(i-NFFT/2)/width + w(i)=1 + if(i.gt.4458) w(i)=0 +! w(i)=exp(-z*z) + enddo + first=.false. + endif + + do j=1,nqsym + i0=(j-1)*qstep + x=fac1*w*dd(i0+1:i0+NFFT) + call four2a(c,NFFT,1,-1,0) !r2c forward FFT + do i=1,NSZ + s=real(c(i))**2 + aimag(c(i))**2 + ss(j,i)=s + savg(i)=savg(i)+s + enddo + enddo + savg=savg/nhsym + +! call flat65(ss,nhsym,MAXQSYM,NSZ,ref) !Flatten the 2d spectrum, saving + call flat65(ss,nqsym,MAXQSYM,NSZ,ref) !Flatten the 2d spectrum, saving + dfref=df ! the reference spectrum ref() + savg=savg/ref +! do j=1,nhsym + do j=1,nqsym + ss(j,1:NSZ)=ss(j,1:NSZ)/ref + enddo + + return +end subroutine symspec65 diff --git a/wsjtx_lib/lib/sync4.f90 b/wsjtx_lib/lib/sync4.f90 new file mode 100644 index 0000000..7d0889f --- /dev/null +++ b/wsjtx_lib/lib/sync4.f90 @@ -0,0 +1,146 @@ +subroutine sync4(dat,jz,ntol,nfqso,mode,mode4,minwidth,dtx,dfx,snrx, & + snrsync,flip,width) + +! Synchronizes JT4 data, finding the best-fit DT and DF. + + parameter (NFFTMAX=2520) !Max length of FFTs + parameter (NHMAX=NFFTMAX/2) !Max length of power spectra + parameter (NSMAX=525) !Max number of half-symbol steps + integer ntol !Range of DF search + real dat(jz) + real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols + real ccfblue(-5:540) !CCF with pseudorandom sequence + real ccfred(NHMAX) !Peak of ccfblue, as function of freq + real red(NHMAX) !Peak of ccfblue, as function of freq + integer ipk1(1) + integer nch(7) + logical savered + equivalence (ipk1,ipk1a) + data nch/1,2,4,9,18,36,72/ + save + +! Do FFTs of twice symbol length, stepped by half symbols. Note that +! we have already downsampled the data by factor of 2. + nsym=207 + nfft=2520 + nh=nfft/2 + nq=nfft/4 + nsteps=jz/nq - 1 + df=0.5*11025.0/nfft + ftop=nfqso + 7*mode4*df + if(ftop.gt.11025.0/4.0) then + print*,'*** Rx Freq is set too high for this submode ***' + go to 900 + endif + + if(mode.eq.-999) width=0. !Silence compiler warning + + do j=1,nsteps !Compute spectrum for each step, get average + k=(j-1)*nq + 1 + call ps4(dat(k),nfft,s2(1,j)) + enddo + +! Set freq and lag ranges + ia=(nfqso-ntol)/df !Index of lowest tone, bottom of search range + ib=(nfqso+ntol)/df !Index of lowest tone, top of search range + iamin=nint(100.0/df) + if(ia.lt.iamin) ia=iamin + ibmax=nint(2700.0/df) - 6*mode4 + if(ib.gt.ibmax) ib=ibmax + + lag1=-5 + lag2=59 + syncbest=-1.e30 + snrx=-26.0 + ccfred=0. + red=0. + i0=nint(nfqso/df) + + do ich=minwidth,7 !Find best width + kz=nch(ich)/2 + savered=.false. + iaa=ia+kz + ibb=ib-kz + do i=iaa,ibb !Find best frequency channel for CCF + call xcor4(s2,i,nsteps,nsym,lag1,lag2,ich,mode4,ccfblue,ccf0, & + lagpk0,flip) + ccfred(i)=ccf0 + +! Find rms of the CCF, without main peak + call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0) + sync=abs(ccfblue(lagpk0)) +! write(*,3000) ich,i,i*df,ccf0,sync,syncbest +!3000 format(2i5,4f12.3) + +! Find best sync value + if(sync.gt.syncbest*1.03) then + ipk=i + lagpk=lagpk0 + ichpk=ich + syncbest=sync + savered=.true. + endif + enddo + if(savered) red=ccfred + enddo + if(syncbest.lt.-1.e29) go to 900 + ccfred=red + call pctile(ccfred(ia:ib),ib-ia+1,45,base) + ccfred=ccfred-base + + dfx=ipk*df + +! Peak up in time, at best whole-channel frequency + call xcor4(s2,ipk,nsteps,nsym,lag1,lag2,ichpk,mode4,ccfblue,ccfmax, & + lagpk,flip) + xlag=lagpk + if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then + call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2) + xlag=lagpk+dx2 + endif + +! Find rms of the CCF, without the main peak + call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0) + sq=0. + nsq=0 + do lag=lag1,lag2 + if(abs(lag-xlag).gt.2.0) then + sq=sq+ccfblue(lag)**2 + nsq=nsq+1 + endif + enddo + rms=sqrt(sq/nsq) + snrsync=max(0.0,db(abs(ccfblue(lagpk)/rms - 1.0)) - 4.5) + dt=2.0/11025.0 + istart=xlag*nq + dtx=istart*dt + + ipk1=maxloc(ccfred) + ccf10=0.5*maxval(ccfred) + do i=ipk1a,ia,-1 + if(ccfred(i).le.ccf10) exit + enddo + i1=i + do i=ipk1a,ib + if(ccfred(i).le.ccf10) exit + enddo + nw=i-i1 + width=nw*df + + sq=0. + ns=0 + iaa=max(ipk1a-10*nw,ia) + ibb=min(ipk1a+10*nw,ib) + jmax=2*mode4/3 + do i=iaa,ibb + j=abs(i-ipk1a) + if(j.gt.nw .and. j.lt.jmax) then + sq=sq + ccfred(j)*ccfred(j) + ns=ns+1 + endif + enddo + rms=sqrt(sq/ns) + snrx=10.0*log10(ccfred(ipk1a)/rms) - 41.2 + +900 return +end subroutine sync4 diff --git a/wsjtx_lib/lib/sync65.f90 b/wsjtx_lib/lib/sync65.f90 new file mode 100644 index 0000000..cfb3acc --- /dev/null +++ b/wsjtx_lib/lib/sync65.f90 @@ -0,0 +1,94 @@ +subroutine sync65(nfa,nfb,ntol,nqsym,ca,ncand,nrobust,bVHF) + + parameter (NSZ=3413,NFFT=8192,MAXCAND=300) + real ss(552,NSZ) + real ccfblue(-32:82) !CCF with pseudorandom sequence + real ccfred(NSZ) !Peak of ccfblue, as function of freq + logical bVHF + + type candidate + real freq + real dt + real sync + real flip + end type candidate + type(candidate) ca(MAXCAND) + + common/steve/thresh0 + common/sync/ss + + if(ntol.eq.-99) stop !Silence compiler warning + call setup65 + + df=12000.0/NFFT !df = 12000.0/8192 = 1.465 Hz + ia=max(2,nint(nfa/df)) + ib=min(NSZ-1,nint(nfb/df)) +! lag1=-11 +! lag2=59 +! lag1=-22 +! lag2=118 + lag1=-32 + lag2=82 !may need to be extended for EME + nsym=126 + ncand=0 + fdot=0. + ccfred=0. + ccfblue=0. + ccfmax=0. + ipk=0 + do i=ia,ib + call xcor(i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk0,flip,fdot,nrobust) +! Remove best-fit slope from ccfblue and normalize so baseline rms=1.0 + if(.not.bVHF) call slope(ccfblue(lag1),lag2-lag1+1, & + lagpk0-lag1+1.0) + ccfred(i)=ccfblue(lagpk0) + if(ccfred(i).gt.ccfmax) then + ccfmax=ccfred(i) + ipk=i + endif + enddo + call pctile(ccfred(ia:ib),ib-ia+1,35,xmed) + ccfred(ia:ib)=ccfred(ia:ib)-xmed + ccfred(ia-1)=ccfred(ia) + ccfred(ib+1)=ccfred(ib) + + do i=ia,ib + freq=i*df + itry=0 + if(bVHF) then + if(i.ne.ipk .or. ccfmax.lt.thresh0) cycle + itry=1 + ncand=ncand+1 + else + if(ccfred(i).ge.thresh0 .and. ccfred(i).gt.ccfred(i-1) .and. & + ccfred(i).gt.ccfred(i+1)) then + itry=1 + ncand=ncand+1 + endif + endif + if(itry.ne.0) then + call xcor(i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk,flip,fdot,nrobust) + if(.not.bVHF) call slope(ccfblue(lag1),lag2-lag1+1, & + lagpk-lag1+1.0) + xlag=lagpk + if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then + call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2) + xlag=lagpk+dx2 + endif + dtx=xlag*1024.0/11025.0 + ccfblue(lag1)=0. + ccfblue(lag2)=0. + ca(ncand)%freq=freq + ca(ncand)%dt=dtx + ca(ncand)%flip=flip + if(bVHF) then + ca(ncand)%sync=db(ccfred(i)) - 16.0 + else + ca(ncand)%sync=ccfred(i) + endif + endif + if(ncand.eq.MAXCAND) exit + enddo + + return +end subroutine sync65 diff --git a/wsjtx_lib/lib/sync9.f90 b/wsjtx_lib/lib/sync9.f90 new file mode 100644 index 0000000..8056038 --- /dev/null +++ b/wsjtx_lib/lib/sync9.f90 @@ -0,0 +1,96 @@ +subroutine sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipkbest) + + include 'constants.f90' + real ss(184,NSMAX) + real ss1(184) + real ccfred(NSMAX) + real savg(NSMAX) + real savg2(NSMAX) + real smo(-5:25) + real sq(NSMAX) + real red2(NSMAX) + character*27 cr + data cr/'(C) 2016, Joe Taylor - K1JT'/ + include 'jt9sync.f90' + + ipk=0 + ipkbest=0 + sbest=0. + ccfred=0. + + do i=ia,ib !Loop over freq range + ss1=ss(1:184,i) + call pctile(ss1,nzhsym,40,xmed) + + ss1=ss1/xmed - 1.0 + do j=1,nzhsym + if(ss1(j).gt.3.0) ss1(j)=3.0 + enddo + + call pctile(ss1,nzhsym,45,sbase) + ss1=ss1-sbase + sq0=dot_product(ss1(1:nzhsym),ss1(1:nzhsym)) + rms=sqrt(sq0/(nzhsym-1)) + + smax=0. + do lag=lag1,lag2 !DT = 2.5 to 5.0 s + sum1=0. + sq2=sq0 + nsum=nzhsym + do j=1,16 !Sum over 16 sync symbols + k=ii2(j) + lag + if(k.ge.1 .and. k.le.nzhsym) then + sum1=sum1 + ss1(k) + sq2=sq2 - ss1(k)*ss1(k) + nsum=nsum-1 + endif + enddo + if(sum1.gt.smax) then + smax=sum1 + ipk=i + endif + rms=sqrt(sq2/(nsum-1)) + enddo + ccfred(i)=smax !Best at this freq, over all lags + if(smax.gt.sbest) then + sbest=smax + ipkbest=ipk + endif + enddo + + call pctile(ccfred(ia),ib-ia+1,50,xmed) + if(xmed.le.0.0) xmed=1.0 + ccfred=2.0*ccfred/xmed + + savg=0. + do j=1,nzhsym + savg(ia:ib)=savg(ia:ib) + ss(j,ia:ib) + enddo + savg(ia:ib)=savg(ia:ib)/nzhsym + smo(0:20)=1.0/21.0 + smo(-5:-1)=-(1.0/21.0)*(21.0/10.0) + smo(21:25)=smo(-5) + + do i=ia,ib + sm=0. + do j=-5,25 + if(i+j.ge.1 .and. i+j.lt.NSMAX) sm=sm + smo(j)*savg(i+j) + enddo + savg2(i)=sm + sq(i)=sm*sm + enddo + + call pctile(sq(ia:ib),ib-ia+1,20,sq0) + rms=sqrt(sq0) + savg2(ia:ib)=savg2(ia:ib)/(5.0*rms) + + red2=0. + do i=ia+11,ib-10 + ref=max(savg2(i-10),savg2(i+10)) + red2(i)=savg2(i)-ref + if(red2(i).lt.-99.0) red2(i)=-99.0 + if(red2(i).gt.99.0) red2(i)=99.0 + enddo + + return +end subroutine sync9 diff --git a/wsjtx_lib/lib/sync9f.f90 b/wsjtx_lib/lib/sync9f.f90 new file mode 100644 index 0000000..8aca06b --- /dev/null +++ b/wsjtx_lib/lib/sync9f.f90 @@ -0,0 +1,55 @@ +subroutine sync9f(s2,nq,nfa,nfb,ss2,ss3,lagpk,ipk,ccfbest) + +! Look for JT9 sync pattern in the folded symbol spectra, s2. +! Frequency search extends from nfa to nfb. Synchronized symbol +! spectra are put into ss2() and ss3(). + + integer ii4(16) + real s2(240,340) + real ss2(0:8,85) + real ss3(0:7,69) + include 'jt9sync.f90' + + ii4=4*ii-3 + ccf=0. + ccfbest=0. + nfft=4*nq + df=12000.0/nfft + ia=nfa/df + ib=nfb/df + 0.9999 + + do i=ia,ib + do lag=0,339 + t=0. + do n=1,16 + j=ii4(n)+lag + if(j.gt.340) j=j-340 + t=t + s2(i,j) + enddo + if(t.gt.ccfbest) then + lagpk=lag + ipk=i + ccfbest=t + endif + enddo + enddo + + do i=0,8 + j4=lagpk-4 + i2=2*i + ipk + if(i2.lt.1) i2=1 + m=0 + do j=1,85 + j4=j4+4 + if(j4.gt.340) j4=j4-340 + if(j4.lt.1) j4=j4+340 + ss2(i,j)=s2(i2,j4) + if(i.ge.1 .and. isync(j).eq.0) then + m=m+1 + ss3(i-1,m)=ss2(i,j) + endif + enddo + enddo + + return +end subroutine sync9f diff --git a/wsjtx_lib/lib/sync9w.f90 b/wsjtx_lib/lib/sync9w.f90 new file mode 100644 index 0000000..e25afab --- /dev/null +++ b/wsjtx_lib/lib/sync9w.f90 @@ -0,0 +1,81 @@ +subroutine sync9w(ss,nzhsym,lag1,lag2,ia,ib,ccfred,ccfblue,ipkbest,lagpk,nadd) + + include 'constants.f90' + real ss(184,NSMAX) + real ss1(184),ss1save(184) + real ccfred(NSMAX) + real ccfblue(-9:18) + real sa(NSMAX),sb(NSMAX) + include 'jt9sync.f90' + +! Smooth the symbol spectra (by an amount consistent with measured width??) + do j=1,nzhsym + sa=ss(j,1:NSMAX) + call smo(sa,NSMAX,sb,nadd) + call smo(sb,NSMAX,sa,nadd) + ss(j,1:NSMAX)=sa + enddo + + ipk=0 + ipkbest=0 + sbest=0. + ccfred=0. + df=12000.0/16384.0 + + do i=ia,ib !Loop over specified freq range + ss1=ss(1:184,i) !Symbol amplitudes at this freq + call pctile(ss1,nzhsym,50,xmed) !Median level at this freq + ss1=ss1/xmed - 1.0 + + smax=0. !Find DT in specified range + do lag=lag1,lag2 + sum1=0. + nsum=nzhsym + do j=1,16 !Sum over 16 sync symbols + k=ii2(j) + lag + if(k.ge.1 .and. k.le.nzhsym) then + sum1=sum1 + ss1(k) + nsum=nsum-1 + endif + enddo + if(sum1.gt.smax) then + smax=sum1 + ipk=i + endif + enddo + + ccfred(i)=smax !Best at this freq, over all lags + if(smax.gt.sbest) then + sbest=smax + ipkbest=ipk + ss1save=ss1 + endif + enddo + + call pctile(ccfred(ia),ib-ia+1,50,xmed) + if(xmed.le.0.0) xmed=1.0 + ccfred=ccfred/xmed + + ss1=ss1save + smax=0. !Find DT in specified range + do lag=lag1,lag2 + sum1=0. + nsum=nzhsym + do j=1,16 !Sum over 16 sync symbols + k=ii2(j) + lag + if(k.ge.1 .and. k.le.nzhsym) then + sum1=sum1 + ss1(k) + nsum=nsum-1 + endif + enddo + ccfblue(lag)=sum1 + if(sum1.gt.smax) then + smax=sum1 + lagpk=lag + endif + enddo + if(lagpk.eq.-9) lagpk=-8 !Protect the ends of ccfblue() + if(lagpk.eq.18) lagpk=17 + + return +end subroutine sync9w diff --git a/wsjtx_lib/lib/syncmsk.f90 b/wsjtx_lib/lib/syncmsk.f90 new file mode 100644 index 0000000..0e26d46 --- /dev/null +++ b/wsjtx_lib/lib/syncmsk.f90 @@ -0,0 +1,304 @@ +subroutine syncmsk(cdat,npts,jpk,ipk,idf,rmax,snr,metric,decoded) + +! Attempt synchronization, and if successful decode using Viterbi algorithm. + + use iso_c_binding, only: c_loc,c_size_t + use packjt + use hashing + use timer_module, only: timer + + parameter (NSPM=1404,NSAVE=2000) + complex cdat(npts) !Analytic signal + complex cb(66) !Complex waveform for Barker-11 code + complex cd(0:11,0:3) + complex c(0:NSPM-1) !Complex data for one message length + complex c2(0:NSPM-1) + complex cb3(1:NSPM,3) + real r(12000) + real rdat(12000) + real ss1(12000) + real symbol(234) + real rdata(198) + real rd2(198) + real rsave(NSAVE) + real xp(29) + complex z,z0,z1,z2,z3,cfac + integer*1 e1(198) + integer*1, target :: d8(13) + integer*1 i1hash(4) + integer*1 i1 + integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words + integer mettab(0:255,0:1) !Metric table for BPSK modulation + integer ipksave(NSAVE) + integer jpksave(NSAVE) + integer indx(NSAVE) + integer b11(11) !Barker-11 code + character*22 decoded + character*72 c72 + logical first + equivalence (i1,i4) + equivalence (ihash,i1hash) + data xp/0.500000, 0.401241, 0.309897, 0.231832, 0.168095, & + 0.119704, 0.083523, 0.057387, 0.039215, 0.026890, & + 0.018084, 0.012184, 0.008196, 0.005475, 0.003808, & + 0.002481, 0.001710, 0.001052, 0.000789, 0.000469, & + 0.000329, 0.000225, 0.000187, 0.000086, 0.000063, & + 0.000017, 0.000091, 0.000032, 0.000045/ + data first/.true./ + data b11/1,1,1,0,0,0,1,0,0,1,0/ + save first,cb,cd,twopi,dt,f0,f1,mettab + + phi=0. + if(first) then +! Get the metric table + bias=0.0 + scale=20.0 + xln2=log(2.0) + mettab=0 + do i=128,156 + x0=log(max(0.001,2.0*xp(i-127)))/xln2 + x1=log(max(0.001,2.0*(1.0-xp(i-127))))/xln2 + mettab(i,0)=nint(scale*(x0-bias)) + mettab(i,1)=nint(scale*(x1-bias)) + mettab(256-i,0)=mettab(i,1) + mettab(256-i,1)=mettab(i,0) + enddo + do i=157,255 + mettab(i,0)=mettab(156,0) + mettab(i,1)=mettab(156,1) + mettab(256-i,0)=mettab(i,1) + mettab(256-i,1)=mettab(i,0) + enddo + j=0 + twopi=8.0*atan(1.0) + dt=1.0/12000.0 + f0=1000.0 + f1=2000.0 + dphi=0 + do i=1,11 + if(b11(i).eq.0) dphi=twopi*f0*dt + if(b11(i).eq.1) dphi=twopi*f1*dt + do n=1,6 + j=j+1 + phi=phi+dphi + cb(j)=cmplx(cos(phi),sin(phi)) + enddo + enddo + cb3=0. + cb3(1:66,1)=cb + cb3(283:348,1)=cb + cb3(769:834,1)=cb + + cb3(1:66,2)=cb + cb3(487:552,2)=cb + cb3(1123:1188,2)=cb + + cb3(1:66,3)=cb + cb3(637:702,3)=cb + cb3(919:984,3)=cb + + phi=0. + do n=0,3 + k=-1 + dphi=twopi*f0*dt + if(n.ge.2) dphi=twopi*f1*dt + do i=0,5 + k=k+1 + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + cd(k,n)=cmplx(cos(phi),sin(phi)) + enddo + + dphi=twopi*f0*dt + if(mod(n,2).eq.1) dphi=twopi*f1*dt + do i=6,11 + k=k+1 + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + cd(k,n)=cmplx(cos(phi),sin(phi)) + enddo + enddo + + first=.false. + endif + + nfft=NSPM + jz=npts-nfft + decoded=" " + ipk=0 + jpk=0 + metric=-9999 + r=0. + + call timer('sync1 ',0) + do j=1,jz !Find the Barker-11 sync vectors + z=0. + ss=0. + do i=1,66 + ss=ss + real(cdat(j+i-1))**2 + aimag(cdat(j+i-1))**2 + z=z + cdat(j+i-1)*conjg(cb(i)) !Signal matching Barker 11 + enddo + ss=sqrt(ss/66.0)*66.0 + r(j)=abs(z)/(0.908*ss) !Goodness-of-fit to Barker 11 + ss1(j)=ss + enddo + call timer('sync1 ',1) + + call timer('sync2 ',0) + jz=npts-nfft + rmax=0. +! n1=35, n2=69, n3=94 + k=0 + do j=1,jz !Find best full-message sync + if(ss1(j).lt.85.0) cycle + r1=r(j) + r(j+282) + r(j+768) ! 6*(12+n1) 6*(24+n1+n2) + r2=r(j) + r(j+486) + r(j+1122) ! 6*(12+n2) 6*(24+n2+n3) + r3=r(j) + r(j+636) + r(j+918) ! 6*(12+n3) 6*(24+n3+n1) + if(r1.gt.rmax) then + rmax=r1 + jpk=j + ipk=1 + endif + if(r2.gt.rmax) then + rmax=r2 + jpk=j + ipk=2 + endif + if(r3.gt.rmax) then + rmax=r3 + jpk=j + ipk=3 + endif + rrmax=max(r1,r2,r3) + if(rrmax.gt.1.9) then + k=min(k+1,NSAVE) + if(r1.eq.rrmax) ipksave(k)=1 + if(r2.eq.rrmax) ipksave(k)=2 + if(r3.eq.rrmax) ipksave(k)=3 + jpksave(k)=j + rsave(k)=rrmax + endif + enddo + call timer('sync2 ',1) + kmax=k + + call indexx(rsave,kmax,indx) + + call timer('sync3 ',0) + do kk=1,kmax + k=indx(kmax+1-kk) + ipk=ipksave(k) + jpk=jpksave(k) + rmax=rsave(k) + + c=conjg(cb3(1:NSPM,ipk))*cdat(jpk:jpk+nfft-1) + smax=0. + dfx=0. + idfbest=0 + do itry=1,25 + idf=itry/2 + if(mod(itry,2).eq.0) idf=-idf + idf=4*idf + twk=idf + call tweak1(c,NSPM,-twk,c2) + z=sum(c2) + if(abs(z).gt.smax) then + dfx=twk + smax=abs(z) + phi=atan2(aimag(z),real(z)) !Carrier phase offset + idfbest=idf + endif + enddo + idf=idfbest + call tweak1(cdat,npts,-dfx,cdat) + cfac=cmplx(cos(phi),-sin(phi)) + cdat=cfac*cdat + + sig=0. + ref=0. + rdat(1:npts)=cdat + iz=11 + do k=1,234 !Compute soft symbols + j=jpk+6*(k-1) + + z0=2.0*dot_product(cdat(j:j+iz),cd(0:iz,0)) + z1=2.0*dot_product(cdat(j:j+iz),cd(0:iz,1)) + z2=2.0*dot_product(cdat(j:j+iz),cd(0:iz,2)) + z3=2.0*dot_product(cdat(j:j+iz),cd(0:iz,3)) + +!### Maybe these should be weighted by yellow() ? + if(j+1404+iz.lt.npts) then + z0=z0 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,0)) + z1=z1 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,1)) + z2=z2 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,2)) + z3=z3 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,3)) + endif + + if(j-1404.ge.1) then + z0=z0 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,0)) + z1=z1 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,1)) + z2=z2 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,2)) + z3=z3 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,3)) + endif + + sym=max(abs(real(z2)),abs(real(z3))) - max(abs(real(z0)),abs(real(z1))) + + if(sym.lt.0.0) then + phi=atan2(aimag(z0),real(z0)) + sig=sig + real(z0)**2 + ref=ref + aimag(z0)**2 + else + phi=atan2(aimag(z1),real(z1)) + sig=sig + real(z1)**2 + ref=ref + aimag(z1)**2 + endif + n=k + if(ipk.eq.2) n=k+47 + if(ipk.eq.3) n=k+128 + if(n.gt.234) n=n-234 + ibit=0 + if(sym.ge.0) ibit=1 + symbol(n)=sym + enddo + snr=db(sig/ref-1.0) + + rdata(1:35)=symbol(12:46) + rdata(36:104)=symbol(59:127) + rdata(105:198)=symbol(140:233) + +! Re-order the symbols and make them i*1 + j=0 + do i=1,99 + i4=128+rdata(i) !### Should be nint() ??? ### + if(i4.gt.255) i4=255 + if(i4.lt.0) i4=0 + j=j+1 + e1(j)=i1 + rd2(j)=rdata(i) + i4=128+rdata(i+99) + if(i4.gt.255) i4=255 + if(i4.lt.0) i4=0 + j=j+1 + e1(j)=i1 + rd2(j)=rdata(i+99) + enddo + +! Decode the message + nb1=87 + call vit213(e1,nb1,mettab,d8,metric) + ihash=nhash(c_loc(d8),int(9,c_size_t),146) + ihash=2*iand(ihash,32767) + decoded=' ' + if(d8(10).eq.i1hash(2) .and. d8(11).eq.i1hash(1)) then + write(c72,1012) d8(1:9) +1012 format(9b8.8) + read(c72,1014) i4Msg6BitWords +1014 format(12b6.6) + call unpackmsg(i4Msg6BitWords,decoded) !Unpack to get msgsent + endif + if(decoded.ne.' ') exit + enddo + call timer('sync3 ',1) + + return +end subroutine syncmsk diff --git a/wsjtx_lib/lib/tab.c b/wsjtx_lib/lib/tab.c new file mode 100644 index 0000000..3cd419a --- /dev/null +++ b/wsjtx_lib/lib/tab.c @@ -0,0 +1,36 @@ +/* 8-bit parity lookup table, generated by partab.c */ +unsigned char Partab[] = { + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, +}; + diff --git a/wsjtx_lib/lib/test_init_random_seed.f90 b/wsjtx_lib/lib/test_init_random_seed.f90 new file mode 100644 index 0000000..3b9dad1 --- /dev/null +++ b/wsjtx_lib/lib/test_init_random_seed.f90 @@ -0,0 +1,8 @@ +program test_init_random_seed + real :: r(10,4) + call init_random_seed() + call random_number(r) + do i =1,10 + write (*, *) (r(i,j),j=1,4) + end do +end program test_init_random_seed diff --git a/wsjtx_lib/lib/test_q65.f90 b/wsjtx_lib/lib/test_q65.f90 new file mode 100644 index 0000000..598de97 --- /dev/null +++ b/wsjtx_lib/lib/test_q65.f90 @@ -0,0 +1,191 @@ +program test_q65 + + character*84 cmd1,cmd2,line + character*22 msg + character*8 arg + character*1 csubmode + integer naptype(0:5) + logical decok + + nargs=iargc() + if(nargs.ne.12) then + print*,'Usage: test_q65 "msg" A-D depth freq DT fDop f1 Stp TRp Q nfiles SNR' + print*,'Example: test_q65 "K1ABC W9XYZ EN37" A 3 1500 0.0 5.0 0.0 1 60 3 100 -20' + print*,'Use SNR = 0 to loop over all relevant SNRs' + print*,'Use MyCall=K1ABC, HisCall=W9XYZ, HisGrid="EN37" for AP decodes' + print*,'Option Q sets QSOprogress (0-5) for AP decoding.' + print*,'Add 16 to requested depth to enable message averaging.' + go to 999 + endif + call getarg(1,msg) + call getarg(2,csubmode) + call getarg(3,arg) + read(arg,*) ndepth + call getarg(4,arg) + read(arg,*) nf0 + call getarg(5,arg) + read(arg,*) dt + call getarg(6,arg) + read(arg,*) fDop + call getarg(7,arg) + read(arg,*) f1 + call getarg(8,arg) + read(arg,*) nstp + call getarg(9,arg) + read(arg,*) ntrperiod + call getarg(10,arg) + read(arg,*) nQSOprogress + call getarg(11,arg) + read(arg,*) nfiles + call getarg(12,arg) + read(arg,*) snr + + if(ntrperiod.eq.15) then + nsps=1800 + i50=-23 + else if(ntrperiod.eq.30) then + nsps=3600 + i50=-26 + else if(ntrperiod.eq.60) then + nsps=7200 + i50=-29 + else if(ntrperiod.eq.120) then + nsps=16000 + i50=-31 + else if(ntrperiod.eq.300) then + nsps=41472 + i50=-35 + else + stop 'Invalid TR period' + endif + + i50=i50 + 8.0*log(1.0+fDop)/log(240.0) + ia=i50 + 7 + ib=i50 - 10 + if(snr.ne.0.0) then + ia=99 + ib=99 + endif + + baud=12000.0/nsps + tsym=1.0/baud + +! 1 2 3 4 5 6 7 +! 1234567890123456789012345678901234567890123456789012345678901234567890123456' + cmd1='q65sim "K1ABC W9XYZ EN37 " A 1500 5.0 0.0 0.0 1 60 100 -10.0 > junk0' + cmd2='jt9 -3 -p 15 -L 300 -H 3000 -d 3 -b A -Q 3 -f 1500 -X 32 *.wav > junk' + + write(cmd1(10:33),'(a)') '"'//msg//'"' + cmd1(35:35)=csubmode + write(cmd1(37:40),'(i4)') nf0 + write(cmd1(41:45),'(f5.0)') fDop + write(cmd1(46:50),'(f5.2)') dt + write(cmd1(51:56),'(i6)') nint(f1) + write(cmd1(57:59),'(i3)') nstp + write(cmd1(60:63),'(i4)') ntrperiod + write(cmd1(64:68),'(i5)') nfiles + + write(cmd2(11:13),'(i3)') ntrperiod + write(cmd2(33:35),'(i3)') ndepth + write(cmd2(45:45),'(i1)') nQSOprogress + write(cmd2(50:53),'(i4)') nf0 + cmd2(40:40)=csubmode + + call system('rm -f *.wav') + + write(*,1008) ntrperiod,csubmode,ndepth,fDop,f1,nstp +1008 format('Mode:',i4,a1,' Depth:',i3,' fDop:',f6.1,' Drift:',f8.1, & + ' Steps:',i3) + write(*,1010) (j,j=0,5) + write(12,1010) (j,j=0,5) +1010 format(' SNR Sync Avg Dec Bad',6i4,' tdec avg rms'/64('-')) + + dterr=tsym/4.0 + nferr=max(1,nint(0.5*baud),nint(fdop/3.0)) + ndec1z=nfiles + + do nsnr=ia,ib,-1 + snr1=nsnr + if(ia.eq.99) snr1=snr + nsync=0 + ndec1=0 + nfalse=0 + naptype=0 + ndecn=0 + write(cmd1(72:76),'(f5.1)') snr1 + call system(cmd1) + call sec0(0,tdec) + call system(cmd2) + call sec0(1,tdec) + open(10,file='junk',status='unknown') + n=0 + snrsum=0. + snrsq=0. + nsum=0 + do iline=1,9999 + read(10,'(a71)',end=10) line + if(index(line,'' + go to 999 + endif + call getarg(1,infile) + i0=index(infile,'_') + read(infile(1:i0-1),*) fspread0 !Generated Doppler spread + read(infile(i0+1:i0+3),*) snrdb0 !Generated SNR + open(10,file=trim(infile),status='old',access='stream') + read(10) h + npts=h%ndata/2 + npings=npts/NMAX + nfsample=h%nsamrate + df=12000.0/NFFT + s=0. + fac=1.0/NMAX + + do iping=1,npings + read(10) id2(1:NMAX) + x(1:NMAX)=fac*id2(1:NMAX) + x(NMAX+1:)=0. + call four2a(x,NFFT,1,-1,0) + do i=1,8192 !Accumulate spectrum 0 - 3 kHz + s(i)=s(i) + real(c(i))**2 + aimag(c(i))**2 + enddo + enddo + + sa=s(2049:6144) + sb=s(2049:6144) + + call echo_snr(sa,sb,fspread0,blue,red,snrdb,db_err,fpeak,snr_detect) + + nqual=min(10,int(snr_detect-4.0)) + + write(*,1010) fspread0,snrdb0,snrdb,snrdb-snrdb0,db_err,fpeak, & + snr_detect,nqual + +1010 format(5f6.1,2f7.1,i4) + + do i=1,8192 + write(12,1100) i*df,s(i) +1100 format(f10.3,e15.6) + enddo + +999 end program test_snr diff --git a/wsjtx_lib/lib/testfast9.f90 b/wsjtx_lib/lib/testfast9.f90 new file mode 100644 index 0000000..0315241 --- /dev/null +++ b/wsjtx_lib/lib/testfast9.f90 @@ -0,0 +1,42 @@ +program testfast9 + + parameter (NMAX=30*12000) + integer*2 id2(NMAX) + integer narg(0:11) + character*80 line(100) + character submode*1,infile*80 + + nargs=iargc() + if(nargs.ne.2) then + print*,'Usage: testfast9 submode infile' + print*,'Example: testfast9 E 150806_123300.wav' + go to 999 + endif + call getarg(1,submode) + call getarg(2,infile) + + open(10,file=infile,access='stream',status='old') + read(10) id2(1:22) !Skip 44 header bytes + npts=NMAX + read(10,end=1) id2(1:npts) !Read the raw data + +1 i1=index(infile,'.wav') + read(infile(i1-6:i1-1),*) narg(0) + narg(1)=NMAX + n=ichar(submode) + narg(2)=n-ichar('A') + if(n.ge.97 .and. n.le.104) narg(2)=n-ichar('a') + narg(3)=1 + narg(4)=0 + narg(5)=0 + narg(6)=0 + narg(7)=29951 + narg(8)=1 + narg(9)=102 + narg(10)=700 + narg(11)=500 + + call fast9(id2,narg,line) + print*,line(1) + +999 end program testfast9 diff --git a/wsjtx_lib/lib/testmsg.f90 b/wsjtx_lib/lib/testmsg.f90 new file mode 100644 index 0000000..eae851d --- /dev/null +++ b/wsjtx_lib/lib/testmsg.f90 @@ -0,0 +1,145 @@ + parameter (MAXTEST=75,NTEST=68) + character*22 testmsg(MAXTEST) + character*22 testmsgchk(MAXTEST) + ! Test msgs should include the extremes for the different types + ! See pfx.f90 + ! Type 1 P & A + ! Type 1 1A & E5 + data testmsg(1:NTEST)/ & + "CQ WB9XYZ EN34", & + "CQ DX WB9XYZ EN34", & + "QRZ WB9XYZ EN34", & + "KA1ABC WB9XYZ EN34", & + "KA1ABC WB9XYZ RO", & + "KA1ABC WB9XYZ -21", & + "KA1ABC WB9XYZ R-19", & + "KA1ABC WB9XYZ RRR", & + "KA1ABC WB9XYZ 73", & + "KA1ABC WB9XYZ", & + "CQ 010 WB9XYZ EN34", & + "CQ 999 WB9XYZ EN34", & + "CQ EU WB9XYZ EN34", & + "CQ WY WB9XYZ EN34", & + "1A/KA1ABC WB9XYZ", & + "E5/KA1ABC WB9XYZ", & + "KA1ABC 1A/WB9XYZ", & + "KA1ABC E5/WB9XYZ", & + "KA1ABC/P WB9XYZ", & + "KA1ABC/A WB9XYZ", & + "KA1ABC WB9XYZ/P", & + "KA1ABC WB9XYZ/A", & + "CQ KA1ABC/P", & + "CQ WB9XYZ/A", & + "QRZ KA1ABC/P", & + "QRZ WB9XYZ/A", & + "DE KA1ABC/P", & + "DE WB9XYZ/A", & + "CQ 1A/KA1ABC", & + "CQ E5/KA1ABC", & + "DE 1A/KA1ABC", & + "DE E5/KA1ABC", & + "QRZ 1A/KA1ABC", & + "QRZ E5/KA1ABC", & + "CQ WB9XYZ/1A", & + "CQ WB9XYZ/E5", & + "QRZ WB9XYZ/1A", & + "QRZ WB9XYZ/E5", & + "DE WB9XYZ/1A", & + "DE WB9XYZ/E5", & + "CQ A000/KA1ABC FM07", & + "CQ ZZZZ/KA1ABC FM07", & + "QRZ W4/KA1ABC FM07", & + "DE W4/KA1ABC FM07", & + "CQ W4/KA1ABC -22", & + "DE W4/KA1ABC -22", & + "QRZ W4/KA1ABC -22", & + "CQ W4/KA1ABC R-22", & + "DE W4/KA1ABC R-22", & + "QRZ W4/KA1ABC R-22", & + "DE W4/KA1ABC 73", & + "CQ KA1ABC FM07", & + "QRZ KA1ABC FM07", & + "DE KA1ABC/VE6 FM07", & + "CQ KA1ABC/VE6 -22", & + "DE KA1ABC/VE6 -22", & + "QRZ KA1ABC/VE6 -22", & + "CQ KA1ABC/VE6 R-22", & + "DE KA1ABC/VE6 R-22", & + "QRZ KA1ABC/VE6 R-22", & + "DE KA1ABC 73", & + "HELLO WORLD", & + "ZL4/KA1ABC 73", & + "KA1ABC XL/WB9XYZ", & + "KA1ABC WB9XYZ/W4", & + "DE KA1ABC/QRP 2W", & + "KA1ABC/1 WB9XYZ/1", & + "123456789ABCDEFGH"/ + data testmsgchk(1:NTEST)/ & + "CQ WB9XYZ EN34", & + "CQ DX WB9XYZ EN34", & + "QRZ WB9XYZ EN34", & + "KA1ABC WB9XYZ EN34", & + "KA1ABC WB9XYZ RO", & + "KA1ABC WB9XYZ -21", & + "KA1ABC WB9XYZ R-19", & + "KA1ABC WB9XYZ RRR", & + "KA1ABC WB9XYZ 73", & + "KA1ABC WB9XYZ", & + "CQ 000 WB9XYZ EN34", & + "CQ 999 WB9XYZ EN34", & + "CQ EU WB9XYZ EN34", & + "CQ WY WB9XYZ EN34", & + "1A/KA1ABC WB9XYZ", & + "E5/KA1ABC WB9XYZ", & + "KA1ABC 1A/WB9XYZ", & + "KA1ABC E5/WB9XYZ", & + "KA1ABC/P WB9XYZ", & + "KA1ABC/A WB9XYZ", & + "KA1ABC WB9XYZ/P", & + "KA1ABC WB9XYZ/A", & + "CQ KA1ABC/P", & + "CQ WB9XYZ/A", & + "QRZ KA1ABC/P", & + "QRZ WB9XYZ/A", & + "DE KA1ABC/P", & + "DE WB9XYZ/A", & + "CQ 1A/KA1ABC", & + "CQ E5/KA1ABC", & + "DE 1A/KA1ABC", & + "DE E5/KA1ABC", & + "QRZ 1A/KA1ABC", & + "QRZ E5/KA1ABC", & + "CQ WB9XYZ/1A", & + "CQ WB9XYZ/E5", & + "QRZ WB9XYZ/1A", & + "QRZ WB9XYZ/E5", & + "DE WB9XYZ/1A", & + "DE WB9XYZ/E5", & + "CQ A000/KA1ABC FM07", & + "CQ ZZZZ/KA1ABC FM07", & + "QRZ W4/KA1ABC FM07", & + "DE W4/KA1ABC FM07", & + "CQ W4/KA1ABC -22", & + "DE W4/KA1ABC -22", & + "QRZ W4/KA1ABC -22", & + "CQ W4/KA1ABC R-22", & + "DE W4/KA1ABC R-22", & + "QRZ W4/KA1ABC R-22", & + "DE W4/KA1ABC 73", & + "CQ KA1ABC FM07", & + "QRZ KA1ABC FM07", & + "DE KA1ABC/VE6 FM07", & + "CQ KA1ABC/VE6 -22", & + "DE KA1ABC/VE6 -22", & + "QRZ KA1ABC/VE6 -22", & + "CQ KA1ABC/VE6 R-22", & + "DE KA1ABC/VE6 R-22", & + "QRZ KA1ABC/VE6 R-22", & + "DE KA1ABC 73", & + "HELLO WORLD", & + "ZL4/KA1ABC 73", & + "KA1ABC XL/WB9", & + "KA1ABC WB9XYZ", & + "DE KA1ABC/QRP", & + "KA1ABC/1 WB9X", & + "123456789ABCD"/ diff --git a/wsjtx_lib/lib/timefft.f90 b/wsjtx_lib/lib/timefft.f90 new file mode 100644 index 0000000..72ab41b --- /dev/null +++ b/wsjtx_lib/lib/timefft.f90 @@ -0,0 +1,141 @@ +program timefft + +! Tests and times one-dimensional FFTs computed by FFTW3 + + use, intrinsic :: iso_c_binding + use FFTW3 + + complex(C_FLOAT_COMPLEX),pointer :: a(:),b(:),c(:) + real(C_FLOAT),pointer :: ar(:),br(:) + type(C_PTR) :: plan1,plan2 !Pointers to FFTW plans + type(C_PTR) :: pa,pb,pc + integer(C_INT) iret + integer*8 count0,count1,clkfreq + character problem*9 + logical linplace,lcomplex,lthreading + +! Get command-line parameters + call timefft_opts(npatience,maxthreads,linplace,lcomplex,nfft,problem,nflags) + lthreading=maxthreads.ge.1 + maxthreads=max(1,maxthreads) + + call sgran() ! see C rand generator (used in gran) + +! Allocate data arrays + pa=fftwf_alloc_complex(int(nfft,C_SIZE_T)) + call c_f_pointer(pa,a,[nfft]) + call c_f_pointer(pa,ar,[nfft]) + + pb=fftwf_alloc_complex(int(nfft,C_SIZE_T)) + call c_f_pointer(pb,b,[nfft]) + call c_f_pointer(pb,br,[nfft]) + + pc=fftwf_alloc_complex(int(nfft,C_SIZE_T)) + call c_f_pointer(pc,c,[nfft]) + +! Initialize FFTW threading + if(lthreading) iret=fftwf_init_threads() + +! Import FFTW wisdom, if available + iret=fftwf_import_wisdom_from_filename(C_CHAR_'wis.dat' // C_NULL_CHAR) + + do i=1,nfft !Generate random data + x=gran() + y=gran() + b(i)=cmplx(x,y) + enddo + iters=100 + + write(*,1000) +1000 format(/'Problem Threads Plan Time Gflops RMS iters'/ & + '--------------------------------------------------------') + +! Try nthreads = 1,maxthreads + do nthreads=1,maxthreads + a(1:nfft)=b(1:nfft) !Copy test data into a() + call system_clock(count0,clkfreq) +! Make the plans + if(lthreading) call fftwf_plan_with_nthreads(nthreads) + if(lcomplex) then + if(linplace) then + plan1=fftwf_plan_dft_1d(nfft,a,a,-1,nflags) + plan2=fftwf_plan_dft_1d(nfft,a,a,+1,nflags) + else + plan1=fftwf_plan_dft_1d(nfft,a,c,-1,nflags) + plan2=fftwf_plan_dft_1d(nfft,c,a,+1,nflags) + endif + else + if(linplace) then + plan1=fftwf_plan_dft_r2c_1d(nfft,ar,a,nflags) + plan2=fftwf_plan_dft_c2r_1d(nfft,a,ar,nflags) + else + plan1=fftwf_plan_dft_r2c_1d(nfft,ar,c,nflags) + plan2=fftwf_plan_dft_c2r_1d(nfft,c,ar,nflags) + endif + endif + call system_clock(count1,clkfreq) + tplan=0.5*float(count1-count0)/float(clkfreq) !Plan time for one transform + + total=0. + do iter=1,iters !Do many iterations + a=b !Copy test data into a() + call system_clock(count0,clkfreq) +! Compute the transforms + if(lcomplex) then + if(linplace) then + call fftwf_execute_dft(plan1,a,a) + call fftwf_execute_dft(plan2,a,a) + else + call fftwf_execute_dft(plan1,a,c) + call fftwf_execute_dft(plan2,c,a) + endif + else + if(linplace) then + call fftwf_execute_dft_r2c(plan1,ar,a) + call fftwf_execute_dft_c2r(plan2,a,ar) + else + call fftwf_execute_dft_r2c(plan1,ar,c) + call fftwf_execute_dft_c2r(plan2,c,ar) + endif + endif + call system_clock(count1,clkfreq) + total=total + float(count1-count0)/float(clkfreq) + if(total>=1.0 .and. iter>=10) go to 40 !Cut iterations short ? + enddo + iter=iters + +40 time=0.5*total/iter !Time for one FFT + gflops=5.0/(1.e9*time/(nfft*log(float(nfft))/log(2.0))) + a(1:nfft)=a(1:nfft)/nfft !Normalize the back-transformed data + +! Compute RMS difference between original data and back-transformed data. + sq=0. + if(lcomplex) then + do i=1,nfft + sq=sq + real(a(i)-b(i))**2 + aimag(a(i)-b(i))**2 + enddo + else + do i=1,nfft + sq=sq + (ar(i)-br(i))**2 + enddo + endif + rms=sqrt(sq/nfft) + +! Display results + write(*,1050) problem,nthreads,tplan,time,gflops,rms,iter +1050 format(a9,i4,f8.3,f10.6,f7.2,f11.7,i5) + enddo + +! Export accumulated FFTW wisdom + iret=fftwf_export_wisdom_to_filename(C_CHAR_'wis.dat' // C_NULL_CHAR) + +! Clean up + call fftwf_destroy_plan(plan1) + call fftwf_destroy_plan(plan2) + call fftwf_free(pa) + call fftwf_free(pb) + call fftwf_free(pc) + call fftwf_cleanup_threads() + call fftwf_cleanup() + +end program timefft diff --git a/wsjtx_lib/lib/timefft_opts.f90 b/wsjtx_lib/lib/timefft_opts.f90 new file mode 100644 index 0000000..cd58132 --- /dev/null +++ b/wsjtx_lib/lib/timefft_opts.f90 @@ -0,0 +1,48 @@ +subroutine timefft_opts(npatience,nthreads,linplace,lcomplex,nfft, & + problem,nflags) + + use FFTW3 + + logical linplace,lcomplex + character problem*9,arg*12 + + nargs=iargc() + if(nargs.lt.3) then + print*,'Usage: timefft npatience maxthreads [[o|i][r|c]]nfft' + print*,' npatience - 0 to 4' + print*,' maxthreads - suggest #CPUs or #CPUs-1' + print*,' o,i - out-of-place or in-place (default=in-place)' + print*,' r,c - real or complex (default=complex)' + print*,' ' + print*,'Examples:' + print*,' timefft 1 1 32768 (1 thread, in-place, complex)' + print*,' timefft 2 3 or32768 (more patient, 3 threads,' + print*,' out-of-place, real)' + stop + endif + + call getarg(1,arg) + read(arg,*) npatience + call getarg(2,arg) + read(arg,*) nthreads + call getarg(3,arg) + linplace=arg(1:1).ne.'o' .and. arg(2:2).ne.'o' + lcomplex=arg(1:1).ne.'r' .and. arg(2:2).ne.'r' + k=3 + if(ichar(arg(2:2)).ge.48 .and. ichar(arg(2:2)).le.57) k=2 + if(ichar(arg(1:1)).ge.48 .and. ichar(arg(1:1)).le.57) k=1 + read(arg(k:),*) nfft + + write(problem,'(i9)') nfft + problem='ic'//adjustl(problem) + if(.not.linplace) problem(1:1)='o' + if(.not.lcomplex) problem(2:2)='r' + + 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 + + return +end subroutine timefft_opts diff --git a/wsjtx_lib/lib/timer_C_wrapper.f90 b/wsjtx_lib/lib/timer_C_wrapper.f90 new file mode 100644 index 0000000..866a850 --- /dev/null +++ b/wsjtx_lib/lib/timer_C_wrapper.f90 @@ -0,0 +1,57 @@ +module timer_c_wrapper + use :: iso_c_binding, only: c_ptr + use timer_module, only: timer, null_timer + implicit none + + ! + ! C interoperable callback setup + ! + abstract interface + subroutine c_timer_callback (context, dname, k) + use, intrinsic :: iso_c_binding, only: c_ptr, c_char + implicit none + type(c_ptr), value, intent(in) :: context + character(c_char), intent(in) :: dname(*) + integer, intent(in), value :: k + end subroutine c_timer_callback + end interface + + public :: init, fini + + private + + ! + ! the following are singleton items which assumes that any timer + ! implementation should only assume one global instance, probably a + ! struct or class object whose address is stored the context below + ! + type(c_ptr), private :: the_context + procedure(C_timer_callback), pointer, private :: the_callback + +contains + subroutine timer_callback_wrapper (dname, k) + use, intrinsic :: iso_c_binding, only: c_null_char + implicit none + character(len=8), intent(in) :: dname + integer, intent(in) :: k + call the_callback (the_context, trim (dname) // c_null_char, k) + end subroutine timer_callback_wrapper + + subroutine init (context, callback) + use, intrinsic :: iso_c_binding, only: c_ptr, c_funptr, c_f_procpointer + use iso_c_utilities, only: c_to_f_string + use timer_module, only: timer + implicit none + type(c_ptr), value, intent(in) :: context + type(c_funptr), value, intent(in) :: callback + the_context=context + call c_f_procpointer (callback, the_callback) + timer => timer_callback_wrapper + end subroutine init + + subroutine fini () + implicit none + timer => null_timer + end subroutine fini + +end module timer_c_wrapper diff --git a/wsjtx_lib/lib/timer_common.inc b/wsjtx_lib/lib/timer_common.inc new file mode 100644 index 0000000..1e7f32a --- /dev/null +++ b/wsjtx_lib/lib/timer_common.inc @@ -0,0 +1,3 @@ + integer :: level, onlevel(0:10) + common/timer_private/ level, onlevel + !$omp threadprivate(/timer_private/) diff --git a/wsjtx_lib/lib/timer_impl.f90 b/wsjtx_lib/lib/timer_impl.f90 new file mode 100644 index 0000000..221db9e --- /dev/null +++ b/wsjtx_lib/lib/timer_impl.f90 @@ -0,0 +1,266 @@ +module timer_impl + !$ use omp_lib + use :: iso_c_binding, only: c_ptr + use timer_module, only: timer_callback + implicit none + + public :: init_timer, fini_timer + integer, public :: limtrace=0 +! integer, public :: limtrace=10000000 + + private + + integer, parameter :: MAXCALL=100 + integer :: lu=6 + real :: dut + integer :: i,nmax=0,ncall(MAXCALL),nlevel(MAXCALL),nparent(MAXCALL) + character(len=8) :: name(MAXCALL),space=' ' + logical :: on(MAXCALL) + real :: total,sum,sumf,ut(MAXCALL),ut0(MAXCALL) + !$ integer :: j,l,m,ntid(MAXCALL) + + ! + ! C interoperable callback setup + ! + public :: C_init_timer + abstract interface + subroutine C_timer_callback (context, dname, k) + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none + type(c_ptr), intent(in) :: context + character(len=8), intent(in) :: dname + integer, intent(in) :: k + end subroutine C_timer_callback + end interface + type(c_ptr), private :: the_context + procedure(C_timer_callback), pointer, private :: the_C_callback + +contains + subroutine timer_callback_wrapper (dname, k) + implicit none + character(len=8), intent(in) :: dname + integer, intent(in) :: k + call the_C_callback (the_context, dname, k) + end subroutine timer_callback_wrapper + + subroutine C_init_timer (context, callback) bind(C) + use, intrinsic :: iso_c_binding, only: c_ptr, c_funptr, c_f_procpointer + use iso_c_utilities, only: c_to_f_string + use timer_module, only: timer + implicit none + type(c_ptr), intent(in) :: context + type(c_funptr), intent(in) :: callback + the_context=context + call c_f_procpointer (callback, the_C_callback) + timer => timer_callback_wrapper + end subroutine C_init_timer + + ! + ! default Fortran implementation which is thread safe using OpenMP + ! + subroutine default_timer (dname, k) + + ! Times procedure number n between a call with k=0 (tstart) and with + ! k=1 (tstop). Accumulates sums of these times in array ut (user time). + ! Also traces all calls (for debugging purposes) if limtrace.gt.0 + ! + ! If this is used with OpenMP than the /timer_private/ common + ! block must be copyed into each thread of a thread team by using + ! the copyin() clause on the !$omp parallel directive that creates + ! the team. + + implicit none + + character(len=8), intent(in) :: dname + integer, intent(in) :: k + + real :: ut1,eps=0.000001 + integer :: n,ndiv,ntrace=0 + !$ integer :: tid + character(len=8) :: tname + include 'timer_common.inc' + + !$omp critical(timer) + if(limtrace.lt.0) go to 999 + if(k.gt.1) go to 40 !Check for "all done" (k>1) + onlevel(0)=0 + + !$ tid=omp_get_thread_num() + do n=1,nmax !Check for existing name/parent[/thread] + if(name(n).eq.dname & + !$ .and.ntid(n).eq.tid & + ) then + if (on(n)) then + if (nparent(n).eq.onlevel(level-1)) goto 20 + else + if (nparent(n).eq.onlevel(level)) goto 20 + end if + end if + enddo + + nmax=nmax+1 !This is a new one + n=nmax + !$ ntid(n)=tid + ncall(n)=0 + on(n)=.false. + ut(n)=eps + name(n)=dname + +20 if(k.eq.0) then !Get start times (k=0) + if(on(n)) then + print*,'Error in timer: ',dname,' already on.' + end if + level=level+1 !Increment the level + on(n)=.true. + ! call system_clock(icount,irate) + ! ut0(n)=float(icount)/irate + ! call cpu_time(ut0(n)) + ut0(n)=secnds(0.0) + + ncall(n)=ncall(n)+1 + if(ncall(n).gt.1.and.nlevel(n).ne.level) then + !recursion is happening + ! + !TODO: somehow need to account for this deeper call at the + !shallowest instance in the call chain and this needs to be + !done without incrementing anything here other than counters + !and timers + ! + nlevel(n)=-1 + else + nlevel(n)=level + endif + nparent(n)=onlevel(level-1) + onlevel(level)=n + + else if(k.eq.1) then !Get stop times and accumulate sums. (k=1) + if(on(n)) then + on(n)=.false. + ! call system_clock(icount,irate) + ! ut1=float(icount)/irate + ! call cpu_time(ut1) + ut1=secnds(0.0) + + ut(n)=ut(n)+ut1-ut0(n) + endif + level=level-1 + endif + + ntrace=ntrace+1 + tname='TopLevel' + if(nparent(n).ge.1 .and. nparent(n).le.MAXCALL) tname=name(nparent(n)) + if(ntrace.lt.limtrace) write(lu,1020) ntrace,dname,k,level,nparent(n),tname +1020 format(i8,': ',a8,3i5,2x,a8) + flush(lu) + go to 998 + + ! Write out the timer statistics + +40 write(lu,1040) +1040 format(/' Name Time Frac dTime', & + ' dFrac Calls'/58('-')) + + !$ !walk backwards through the database rolling up thread data by call chain + !$ do i=nmax,1,-1 + !$ do j=1,i-1 + !$ l=j + !$ m=i + !$ do while (name(l).eq.name(m)) + !$ l=nparent(l) + !$ m=nparent(m) + !$ if (l.eq.0.or.m.eq.0) exit + !$ end do + !$ if (l.eq.0.and.m.eq.0) then + !$ !same call chain so roll up data + !$ ncall(j)=ncall(j)+ncall(i) + !$ ut(j)=ut(j)+ut(i) + !$ do n=1,nmax + !$ if (nparent(n).eq.i) nparent(n)=j + !$ end do + !$ name(i)=space + !$ exit + !$ end if + !$ end do + !$ end do + + if(k.gt.100) then + ndiv=k-100 + do i=1,nmax + ncall(i)=ncall(i)/ndiv + ut(i)=ut(i)/ndiv + enddo + endif + + total=ut(1) + sum=0. + sumf=0. + call print_root(1) + write(lu,1070) sum,sumf +1070 format(58('-')/32x,f10.3,f6.2) + nmax=0 + eps=0.000001 + ntrace=0 + level=0 + onlevel(0)=0 + +998 flush(lu) + +999 continue + + !$omp end critical(timer) + return + end subroutine default_timer + + recursive subroutine print_root(i) + implicit none + integer, intent(in) :: i + character(len=16) :: sname + real :: dutf, utf + integer :: j, kk + + if (i.le.nmax) then + if (name(i).ne.space) then + dut=ut(i) + do j=i,nmax + if (name(j).ne.space.and.nparent(j).eq.i) dut=dut-ut(j) + enddo + if(dut.lt.0.0) dut=0.0 + utf=ut(i)/total + dutf=dut/total + sum=sum+dut + sumf=sumf+dutf + kk=nlevel(i) + sname=space(1:kk)//name(i)//space(1:8-kk) + write(lu,2000) sname,ut(i),utf,dut,dutf,ncall(i) +2000 format(a16,2(f10.3,f6.2),i9) + do j=i,nmax + if(nparent(j).eq.i) call print_root(j) + enddo + end if + end if + return + end subroutine print_root + + subroutine init_timer (filename) + use, intrinsic :: iso_c_binding, only: c_char + use timer_module, only: timer + implicit none + character(len=*), optional, intent(in) :: filename + include 'timer_common.inc' + data level/0/, onlevel/11 * 0/ + if (present (filename)) then + open (newunit=lu, file=filename, status='unknown') + else + open (newunit=lu, file='timer.out', status='unknown') + end if + timer => default_timer + end subroutine init_timer + + subroutine fini_timer () + use timer_module, only: timer, null_timer + implicit none + timer => null_timer + close (lu) + end subroutine fini_timer + +end module timer_impl diff --git a/wsjtx_lib/lib/timer_module.f90 b/wsjtx_lib/lib/timer_module.f90 new file mode 100644 index 0000000..59675c1 --- /dev/null +++ b/wsjtx_lib/lib/timer_module.f90 @@ -0,0 +1,24 @@ +module timer_module + implicit none + + abstract interface + subroutine timer_callback (dname, k) + character(len=8), intent(in) :: dname + integer, intent(in) :: k + end subroutine timer_callback + end interface + + public :: null_timer + procedure(timer_callback), pointer :: timer => null_timer + +contains + ! + ! default Fortran implementation which does nothing + ! + subroutine null_timer (dname, k) + implicit none + character(len=8), intent(in) :: dname + integer, intent(in) :: k + if(dname.eq.'99999999' .and. k.eq.9999) stop !Silence compiler warnings + end subroutine null_timer +end module timer_module diff --git a/wsjtx_lib/lib/timf2.f90 b/wsjtx_lib/lib/timf2.f90 new file mode 100644 index 0000000..bec391e --- /dev/null +++ b/wsjtx_lib/lib/timf2.f90 @@ -0,0 +1,142 @@ +subroutine timf2(x0,k,nfft,nwindow,nb,peaklimit,x1, & + slimit,lstrong,px,nzap) + +! Sequential processing of time-domain I/Q data, using Linrad-like +! "first FFT" and "first backward FFT", treating frequencies with +! strong signals differently. Noise blanking is applied to weak +! signals only. + +! x0 - real input data +! nfft - length of FFTs +! nwindow - 0 for no window, 2 for sin^2 window +! x1 - real output data + +! Non-windowed processing means no overlap, so kstep=nfft. +! Sin^2 window has 50% overlap, kstep=nfft/2. + +! Frequencies with strong signals are identified and separated. Back +! transforms are done separately for weak and strong signals, so that +! noise blanking can be applied to the weak-signal portion. Strong and +! weak are finally re-combined, in the time domain. + + parameter (MAXFFT=1024,MAXNH=MAXFFT/2) + parameter (MAXSIGS=100) + real x0(0:nfft-1),x1(0:nfft-1) + real x(0:MAXFFT-1),xw(0:MAXFFT-1),xs(0:MAXFFT-1) + real xwov(0:MAXNH-1),xsov(0:MAXNH-1) + complex cx(0:MAXFFT-1),cxt(0:MAXFFT-1) + complex cxs(0:MAXFFT-1) !Strong signals + complex cxw(0:MAXFFT-1) !Weak signals + real*4 w(0:MAXFFT-1) + real*4 s(0:MAXNH) + logical*1 lstrong(0:MAXNH),lprev + integer ia(MAXSIGS),ib(MAXSIGS) + logical first + equivalence (x,cx),(xw,cxw),(xs,cxs) + data first/.true./ + data k0/99999999/ + save + + if(first) then + pi=4.0*atan(1.0) + do i=0,nfft-1 + w(i)=(sin(i*pi/nfft))**2 + enddo + s=0. + nh=nfft/2 + kstep=nfft + if(nwindow.eq.2) kstep=nh + fac=1.0/nfft + slimit=1.e30 + first=.false. + endif + + if(k.lt.k0) then + xsov=0. + xwov=0. + endif + k0=k + + x(0:nfft-1)=x0 + if(nwindow.eq.2) x(0:nfft-1)=w(0:nfft-1)*x(0:nfft-1) + call four2a(cx,nfft,1,-1,0) !First forward FFT, r2c + cxt(0:nh)=cx(0:nh) + +! Identify frequencies with strong signals. + do i=0,nh + p=real(cxt(i))**2 + aimag(cxt(i))**2 + s(i)=p + enddo + ave=sum(s(0:nh))/nh + lstrong(0:nh)=s(0:nh).gt.10.0*ave + + nsigs=0 + lprev=.false. + iwid=1 + ib=-99 + do i=0,nh + if(lstrong(i) .and. (.not.lprev)) then + if(nsigs.lt.MAXSIGS) nsigs=nsigs+1 + ia(nsigs)=i-iwid + if(ia(nsigs).lt.0) ia(nsigs)=0 + endif + if(.not.lstrong(i) .and. lprev) then + ib(nsigs)=i-1+iwid + if(ib(nsigs).gt.nh) ib(nsigs)=nh + endif + lprev=lstrong(i) + enddo + + if(nsigs.gt.0) then + do i=1,nsigs + ja=ia(i) + jb=ib(i) + if(ja.lt.0 .or. ja.gt.nh .or. jb.lt.0 .or. jb.gt.nh) then + cycle + endif + if(jb.eq.-99) jb=ja + min(2*iwid,nh) + lstrong(ja:jb)=.true. + enddo + endif + +! Copy frequency-domain data into array cs (strong) or cw (weak). + do i=0,nh + if(lstrong(i)) then + cxs(i)=fac*cxt(i) + cxw(i)=0. + else + cxw(i)=fac*cxt(i) + cxs(i)=0. + endif + enddo + + call four2a(cxw,nfft,1,1,-1) !Transform weak and strong back + call four2a(cxs,nfft,1,1,-1) !to time domain, separately (c2r) + + if(nwindow.eq.2) then + xw(0:nh-1)=xw(0:nh-1)+xwov(0:nh-1) !Add previous segment's 2nd half + xwov(0:nh-1)=xw(nh:nfft-1) !Save 2nd half + xs(0:nh-1)=xs(0:nh-1)+xsov(0:nh-1) !Ditto for strong signals + xsov(0:nh-1)=xs(nh:nfft-1) + endif + +! Apply noise blanking to weak data + if(nb.ne.0) then + do i=0,kstep-1 + peak=abs(xw(i)) + if(peak.gt.peaklimit) then + xw(i)=0. + nzap=nzap+1 + endif + enddo + endif + +! Compute power levels from weak data only + do i=0,kstep-1 + px=px + xw(i)**2 + enddo + + x1(0:kstep-1)=xw(0:kstep-1) + xs(0:kstep-1) !Recombine weak + strong + + return +end subroutine timf2 diff --git a/wsjtx_lib/lib/tmoonsub.c b/wsjtx_lib/lib/tmoonsub.c new file mode 100644 index 0000000..98e1e19 --- /dev/null +++ b/wsjtx_lib/lib/tmoonsub.c @@ -0,0 +1,518 @@ +#include +#include +#include + +#define RADS 0.0174532925199433 +#define DEGS 57.2957795130823 +#define TPI 6.28318530717959 +#define PI 3.1415927 + +/* ratio of earth radius to astronomical unit */ +#define ER_OVER_AU 0.0000426352325194252 + +/* all prototypes here */ + +double getcoord(int coord); +void getargs(int argc, char *argv[], int *y, int *m, double *tz, double *glong, double *glat); +double range(double y); +double rangerad(double y); +double days(int y, int m, int dn, double hour); +double days_(int *y, int *m, int *dn, double *hour); +void moonpos(double, double *, double *, double *); +void sunpos(double , double *, double *, double *); +double moontransit(int y, int m, int d, double timezone, double glat, double glong, int *nt); +double atan22(double y, double x); +double epsilon(double d); +void equatorial(double d, double *lon, double *lat, double *r); +void ecliptic(double d, double *lon, double *lat, double *r); +double gst(double d); +void topo(double lst, double glat, double *alp, double *dec, double *r); +double alt(double glat, double ha, double dec); +void libration(double day, double lambda, double beta, double alpha, double *l, double *b, double *p); +void illumination(double day, double lra, double ldec, double dr, double sra, double sdec, double *pabl, double *ill); +int daysinmonth(int y, int m); +int isleap(int y); +void tmoonsub_(double *day, double *glat, double *glong, double *moonalt, + double *mrv, double *l, double *b, double *paxis); + +static const char +usage[] = " Usage: tmoon date[yyyymm] timz[+/-h.hh] long[+/-dddmm] lat[+/-ddmm]\n" + "example: tmoon 200009 0 -00155 5230\n"; + +/* + getargs() gets the arguments from the command line, does some basic error + checking, and converts arguments into numerical form. Arguments are passed + back in pointers. Error messages print to stderr so re-direction of output + to file won't leave users blind. Error checking prints list of all errors + in a command line before quitting. +*/ +void getargs(int argc, char *argv[], int *y, int *m, double *tz, + double *glong, double *glat) { + + int date, latitude, longitude; + int mflag = 0, yflag = 0, longflag = 0, latflag = 0, tzflag = 0; + int longminflag = 0, latminflag = 0, dflag = 0; + + /* if not right number of arguments, then print example command line */ + + if (argc !=5) { + fprintf(stderr, usage); + exit(EXIT_FAILURE); + } + + date = atoi(argv[1]); + *y = date / 100; + *m = date - *y * 100; + *tz = (double) atof(argv[2]); + longitude = atoi(argv[3]); + latitude = atoi(argv[4]); + *glong = RADS * getcoord(longitude); + *glat = RADS * getcoord(latitude); + + /* set a flag for each error found */ + + if (*m > 12 || *m < 1) mflag = 1; + if (*y > 2500) yflag = 1; + if (date < 150001) dflag = 1; + if (fabs((float) *glong) > 180 * RADS) longflag = 1; + if (abs(longitude) % 100 > 59) longminflag = 1; + if (fabs((float) *glat) > 90 * RADS) latflag = 1; + if (abs(latitude) % 100 > 59) latminflag = 1; + if (fabs((float) *tz) > 12) tzflag = 1; + + /* print all the errors found */ + + if (dflag == 1) { + fprintf(stderr, "date: dates must be in form yyyymm, gregorian, and later than 1500 AD\n"); + } + if (yflag == 1) { + fprintf(stderr, "date: too far in future - accurate from 1500 to 2500\n"); + } + if (mflag == 1) { + fprintf(stderr, "date: month must be in range 0 to 12, eg - August 2000 is entered as 200008\n"); + } + if (tzflag == 1) { + fprintf(stderr, "timz: must be in range +/- 12 hours, eg -6 for Chicago\n"); + } + if (longflag == 1) { + fprintf(stderr, "long: must be in range +/- 180 degrees\n"); + } + if (longminflag == 1) { + fprintf(stderr, "long: last two digits are arcmin - max 59\n"); + } + if (latflag == 1) { + fprintf(stderr, " lat: must be in range +/- 90 degrees\n"); + } + if (latminflag == 1) { + fprintf(stderr, " lat: last two digits are arcmin - max 59\n"); + } + + /* quits if one or more flags set */ + + if (dflag + mflag + yflag + longflag + latflag + tzflag + longminflag + latminflag > 0) { + exit(EXIT_FAILURE); + } + +} + +/* + returns coordinates in decimal degrees given the + coord as a ddmm value stored in an integer. +*/ +double getcoord(int coord) { + int west = 1; + double glg, deg; + if (coord < 0) west = -1; + glg = fabs((double) coord/100); + deg = floor(glg); + glg = west* (deg + (glg - deg)*100 / 60); + return(glg); +} + +/* + days() takes the year, month, day in the month and decimal hours + in the day and returns the number of days since J2000.0. + Assumes Gregorian calendar. +*/ +double days(int y, int m, int d, double h) { + int a, b; + double day; + + /* + The lines below work from 1900 march to feb 2100 + a = 367 * y - 7 * (y + (m + 9) / 12) / 4 + 275 * m / 9 + d; + day = (double)a - 730531.5 + hour / 24; + */ + + /* These lines work for any Gregorian date since 0 AD */ + if (m ==1 || m==2) { + m +=12; + y -= 1; + } + a = y / 100; + b = 2 - a + a/4; + day = floor(365.25*(y + 4716)) + floor(30.6001*(m + 1)) + + d + b - 1524.5 - 2451545 + h/24; + return(day); +} +double days_(int *y0, int *m0, int *d0, double *h0) +{ + return days(*y0,*m0,*d0,*h0); +} + +/* +Returns 1 if y a leap year, and 0 otherwise, according +to the Gregorian calendar +*/ +int isleap(int y) { + int a = 0; + if(y % 4 == 0) a = 1; + if(y % 100 == 0) a = 0; + if(y % 400 == 0) a = 1; + return(a); +} + +/* +Given the year and the month, function returns the +number of days in the month. Valid for Gregorian +calendar. +*/ +int daysinmonth(int y, int m) { + int b = 31; + if(m == 2) { + if(isleap(y) == 1) b= 29; + else b = 28; + } + if(m == 4 || m == 6 || m == 9 || m == 11) b = 30; + return(b); +} + +/* +moonpos() takes days from J2000.0 and returns ecliptic coordinates +of moon in the pointers. Note call by reference. +This function is within a couple of arcminutes most of the time, +and is truncated from the Meeus Ch45 series, themselves truncations of +ELP-2000. Returns moon distance in earth radii. +Terms have been written out explicitly rather than using the +table based method as only a small number of terms is +retained. +*/ +void moonpos(double d, double *lambda, double *beta, double *rvec) { + double dl, dB, dR, L, D, M, M1, F, e, lm, bm, rm, t; + + t = d / 36525; + + L = range(218.3164591 + 481267.88134236 * t) * RADS; + D = range(297.8502042 + 445267.1115168 * t) * RADS; + M = range(357.5291092 + 35999.0502909 * t) * RADS; + M1 = range(134.9634114 + 477198.8676313 * t - .008997 * t * t) * RADS; + F = range(93.27209929999999 + 483202.0175273 * t - .0034029*t*t)*RADS; + e = 1 - .002516 * t; + + dl = 6288774 * sin(M1); + dl += 1274027 * sin(2 * D - M1); + dl += 658314 * sin(2 * D); + dl += 213618 * sin(2 * M1); + dl -= e * 185116 * sin(M); + dl -= 114332 * sin(2 * F) ; + dl += 58793 * sin(2 * D - 2 * M1); + dl += e * 57066 * sin(2 * D - M - M1) ; + dl += 53322 * sin(2 * D + M1); + dl += e * 45758 * sin(2 * D - M); + dl -= e * 40923 * sin(M - M1); + dl -= 34720 * sin(D) ; + dl -= e * 30383 * sin(M + M1) ; + dl += 15327 * sin(2 * D - 2 * F) ; + dl -= 12528 * sin(M1 + 2 * F); + dl += 10980 * sin(M1 - 2 * F); + lm = rangerad(L + dl / 1000000 * RADS); + + dB = 5128122 * sin(F); + dB += 280602 * sin(M1 + F); + dB += 277693 * sin(M1 - F); + dB += 173237 * sin(2 * D - F); + dB += 55413 * sin(2 * D - M1 + F); + dB += 46271 * sin(2 * D - M1 - F); + dB += 32573 * sin(2 * D + F); + dB += 17198 * sin(2 * M1 + F); + dB += 9266 * sin(2 * D + M1 - F); + dB += 8822 * sin(2 * M1 - F); + dB += e * 8216 * sin(2 * D - M - F); + dB += 4324 * sin(2 * D - 2 * M1 - F); + bm = dB / 1000000 * RADS; + + dR = -20905355 * cos(M1); + dR -= 3699111 * cos(2 * D - M1); + dR -= 2955968 * cos(2 * D); + dR -= 569925 * cos(2 * M1); + dR += e * 48888 * cos(M); + dR -= 3149 * cos(2 * F); + dR += 246158 * cos(2 * D - 2 * M1); + dR -= e * 152138 * cos(2 * D - M - M1) ; + dR -= 170733 * cos(2 * D + M1); + dR -= e * 204586 * cos(2 * D - M); + dR -= e * 129620 * cos(M - M1); + dR += 108743 * cos(D); + dR += e * 104755 * cos(M + M1); + dR += 79661 * cos(M1 - 2 * F); + rm = 385000.56 + dR / 1000; + + *lambda = lm; + *beta = bm; + /* distance to Moon must be in Earth radii */ + *rvec = rm / 6378.14; +} + +/* +topomoon() takes the local siderial time, the geographical +latitude of the observer, and pointers to the geocentric +equatorial coordinates. The function overwrites the geocentric +coordinates with topocentric coordinates on a simple spherical +earth model (no polar flattening). Expects Moon-Earth distance in +Earth radii. Formulas scavenged from Astronomical Almanac 'low +precision formulae for Moon position' page D46. +*/ + +void topo(double lst, double glat, double *alp, double *dec, double *r) { + double x, y, z, r1; + x = *r * cos(*dec) * cos(*alp) - cos(glat) * cos(lst); + y = *r * cos(*dec) * sin(*alp) - cos(glat) * sin(lst); + z = *r * sin(*dec) - sin(glat); + r1 = sqrt(x*x + y*y + z*z); + *alp = atan22(y, x); + *dec = asin(z / r1); + *r = r1; +} + +/* +moontransit() takes date, the time zone and geographic longitude +of observer and returns the time (decimal hours) of lunar transit +on that day if there is one, and sets the notransit flag if there +isn't. See Explanatory Supplement to Astronomical Almanac +section 9.32 and 9.31 for the method. +*/ + +double moontransit(int y, int m, int d, double tz, double glat, double glong, int *notransit) { + double hm, ht, ht1, lon, lat, rv, dnew, lst; + int itcount; + + ht1 = 180 * RADS; + ht = 0; + itcount = 0; + *notransit = 0; + do { + ht = ht1; + itcount++; + dnew = days(y, m, d, ht * DEGS/15) - tz/24; + lst = gst(dnew) + glong; + /* find the topocentric Moon ra (hence hour angle) and dec */ + moonpos(dnew, &lon, &lat, &rv); + equatorial(dnew, &lon, &lat, &rv); + topo(lst, glat, &lon, &lat, &rv); + hm = rangerad(lst - lon); + ht1 = rangerad(ht - hm); + /* if no convergence, then no transit on that day */ + if (itcount > 30) { + *notransit = 1; + break; + } + } + while (fabs(ht - ht1) > 0.04 * RADS); + return(ht1); +} + +/* + Calculates the selenographic coordinates of either the sub Earth point + (optical libration) or the sub-solar point (selen. coords of centre of + bright hemisphere). Based on Meeus chapter 51 but neglects physical + libration and nutation, with some simplification of the formulas. +*/ +void libration(double day, double lambda, double beta, double alpha, double *l, double *b, double *p) { + double i, f, omega, w, y, x, a, t, eps; + t = day / 36525; + i = 1.54242 * RADS; + eps = epsilon(day); + f = range(93.2720993 + 483202.0175273 * t - .0034029 * t * t) * RADS; + omega = range(125.044555 - 1934.1361849 * t + .0020762 * t * t) * RADS; + w = lambda - omega; + y = sin(w) * cos(beta) * cos(i) - sin(beta) * sin(i); + x = cos(w) * cos(beta); + a = atan22(y, x); + *l = a - f; + + /* kludge to catch cases of 'round the back' angles */ + if (*l < -90 * RADS) *l += TPI; + if (*l > 90 * RADS) *l -= TPI; + *b = asin(-sin(w) * cos(beta) * sin(i) - sin(beta) * cos(i)); + + /* pa pole axis - not used for Sun stuff */ + x = sin(i) * sin(omega); + y = sin(i) * cos(omega) * cos(eps) - cos(i) * sin(eps); + w = atan22(x, y); + *p = rangerad(asin(sqrt(x*x + y*y) * cos(alpha - w) / cos(*b))); +} + +/* + Takes: days since J2000.0, eq coords Moon, ratio of moon to sun distance, + eq coords Sun + Returns: position angle of bright limb wrt NCP, percentage illumination + of Sun +*/ +void illumination(double day , double lra, double ldec, double dr, double sra, double sdec, double *pabl, double *ill) { + double x, y, phi, i; + (void)day; + y = cos(sdec) * sin(sra - lra); + x = sin(sdec) * cos(ldec) - cos(sdec) * sin(ldec) * cos (sra - lra); + *pabl = atan22(y, x); + phi = acos(sin(sdec) * sin(ldec) + cos(sdec) * cos(ldec) * cos(sra-lra)); + i = atan22(sin(phi) , (dr - cos(phi))); + *ill = 0.5*(1 + cos(i)); +} + +/* +sunpos() takes days from J2000.0 and returns ecliptic longitude +of Sun in the pointers. Latitude is zero at this level of precision, +but pointer left in for consistency in number of arguments. +This function is within 0.01 degree (1 arcmin) almost all the time +for a century either side of J2000.0. This is from the 'low precision +fomulas for the Sun' from C24 of Astronomical Alamanac +*/ +void sunpos(double d, double *lambda, double *beta, double *rvec) { + double L, g, ls, bs, rs; + + L = range(280.461 + .9856474 * d) * RADS; + g = range(357.528 + .9856003 * d) * RADS; + ls = L + (1.915 * sin(g) + .02 * sin(2 * g)) * RADS; + bs = 0; + rs = 1.00014 - .01671 * cos(g) - .00014 * cos(2 * g); + *lambda = ls; + *beta = bs; + *rvec = rs; +} + +/* +this routine returns the altitude given the days since J2000.0 +the hour angle and declination of the object and the latitude +of the observer. Used to find the Sun's altitude to put a letter +code on the transit time, and to find the Moon's altitude at +transit just to make sure that the Moon is visible. +*/ +double alt(double glat, double ha, double dec) { + return(asin(sin(dec) * sin(glat) + cos(dec) * cos(glat) * cos(ha))); +} + +/* returns an angle in degrees in the range 0 to 360 */ +double range(double x) { + double a, b; + b = x / 360; + a = 360 * (b - floor(b)); + if (a < 0) + a = 360 + a; + return(a); +} + +/* returns an angle in rads in the range 0 to two pi */ +double rangerad(double x) { + double a, b; + b = x / TPI; + a = TPI * (b - floor(b)); + if (a < 0) + a = TPI + a; + return(a); +} + +/* +gets the atan2 function returning angles in the right +order and range +*/ +double atan22(double y, double x) { + double a; + + a = atan2(y, x); + if (a < 0) a += TPI; + return(a); +} + +/* +returns mean obliquity of ecliptic in radians given days since +J2000.0. +*/ +double epsilon(double d) { + double t = d/ 36525; + return((23.4392911111111 - (t* (46.8150 + 0.00059*t)/3600)) *RADS); +} + +/* +replaces ecliptic coordinates with equatorial coordinates +note: call by reference destroys original values +R is unchanged. +*/ +void equatorial(double d, double *lon, double *lat, double * r) { + double eps, ceps, seps, l, b; + (void)r; + + l = *lon; + b = * lat; + eps = epsilon(d); + ceps = cos(eps); + seps = sin(eps); + *lon = atan22(sin(l)*ceps - tan(b)*seps, cos(l)); + *lat = asin(sin(b)*ceps + cos(b)*seps*sin(l)); +} + +/* +replaces equatorial coordinates with ecliptic ones. Inverse +of above, but used to find topocentric ecliptic coords. +*/ +void ecliptic(double d, double *lon, double *lat, double * r) { + double eps, ceps, seps, alp, dec; + (void)r; + + alp = *lon; + dec = *lat; + eps = epsilon(d); + ceps = cos(eps); + seps = sin(eps); + *lon = atan22(sin(alp)*ceps + tan(dec)*seps, cos(alp)); + *lat = asin(sin(dec)*ceps - cos(dec)*seps*sin(alp)); +} + +/* +returns the siderial time at greenwich meridian as +an angle in radians given the days since J2000.0 +*/ +double gst( double d) { + double t = d / 36525; + double theta; + theta = range(280.46061837 + 360.98564736629 * d + 0.000387933 * t * t); + return(theta * RADS); +} + +void tmoonsub_(double *day, double *glat, double *glong, double *moonalt, + double *mrv, double *l, double *b, double *paxis) +{ + double mlambda, mbeta; + double malpha, mdelta; + double lst, mhr; + double tlambda, tbeta, trv; + + lst = gst(*day) + *glong; + + /* find Moon topocentric coordinates for libration calculations */ + + moonpos(*day, &mlambda, &mbeta, mrv); + malpha = mlambda; + mdelta = mbeta; + equatorial(*day, &malpha, &mdelta, mrv); + topo(lst, *glat, &malpha, &mdelta, mrv); + mhr = rangerad(lst - malpha); + *moonalt = alt(*glat, mhr, mdelta); + + /* Optical libration and Position angle of the Pole */ + + tlambda = malpha; + tbeta = mdelta; + trv = *mrv; + ecliptic(*day, &tlambda, &tbeta, &trv); + libration(*day, tlambda, tbeta, malpha, l, b, paxis); +} diff --git a/wsjtx_lib/lib/to_contest_msg.f90 b/wsjtx_lib/lib/to_contest_msg.f90 new file mode 100644 index 0000000..35248e9 --- /dev/null +++ b/wsjtx_lib/lib/to_contest_msg.f90 @@ -0,0 +1,27 @@ +subroutine to_contest_msg(msg0,msg) + +! If the message has "R grid4" istead of "grid4", remove the "R " +! and substitute the diametrically opposite grid. + + character*6 g1,g2 + character*22 msg0,msg + logical isgrid + isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & + g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & + g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' + + i0=index(msg0,' R ') + 3 !Check for ' R ' in message + g1=msg0(i0:i0+3)//' ' + if(isgrid(g1)) then !Check for ' R grid' + call grid2deg(g1,dlong,dlat) + dlong=dlong+180.0 + if(dlong.gt.180.0) dlong=dlong-360.0 + dlat=-dlat + call deg2grid(dlong,dlat,g2) !g2=antipodes grid + msg=msg0(1:i0-3)//g2(1:4) !Send message with g2 + else + msg=msg0 + endif + + return +end subroutine to_contest_msg diff --git a/wsjtx_lib/lib/tstrig.c b/wsjtx_lib/lib/tstrig.c new file mode 100644 index 0000000..2e77fea --- /dev/null +++ b/wsjtx_lib/lib/tstrig.c @@ -0,0 +1,26 @@ +#include "config.h" +#include +#include +#include +#include "tstrig.h" + +int set_conf(RIG *my_rig, char *conf_parms); + +int rig_control(rig_model_t my_model, int verbose); + +int main (int argc, char *argv[]) +{ + rig_model_t my_model = RIG_MODEL_DUMMY; + int verbose=0; + + my_model=214; + rig_control(my_model,verbose); + return 0; +} + +/* +gcc -c -Wall -I../include rig_control.c +gcc -c -Wall -I../include tstrig.c +gcc -o tstrig.exe -Wl,--enable-auto-import tstrig.o rig_control.o libhamlib.dll.a +strip tstrig.exe +*/ diff --git a/wsjtx_lib/lib/tstrig.h b/wsjtx_lib/lib/tstrig.h new file mode 100644 index 0000000..ce62d3d --- /dev/null +++ b/wsjtx_lib/lib/tstrig.h @@ -0,0 +1,50 @@ +/* + * rigctl_parse.h - (C) Stephane Fillod 2000-2010 + * + * This program test/control a radio using Hamlib. + * It takes commands in interactive mode as well as + * from command line options. + * + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + * + */ + +#ifndef RIGCTL_PARSE_H +#define RIGCTL_PARSE_H + +#include +#include + +/* + * external prototype + */ + +int dumpcaps (RIG *, FILE *); +int dumpconf (RIG *, FILE *); + +/* + * Prototypes + */ +void usage_rig(FILE *); +void version(); +void list_models(); +int dump_chan(FILE *, RIG*, channel_t*); +int print_conf_list(const struct confparams *cfp, rig_ptr_t data); +int set_conf(RIG *my_rig, char *conf_parms); + +int rigctl_parse(RIG *my_rig, FILE *fin, FILE *fout, char *argv[], int argc); + +#endif /* RIGCTL_PARSE_H */ diff --git a/wsjtx_lib/lib/tweak1.f90 b/wsjtx_lib/lib/tweak1.f90 new file mode 100644 index 0000000..c62c408 --- /dev/null +++ b/wsjtx_lib/lib/tweak1.f90 @@ -0,0 +1,23 @@ +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/wsjtx_lib/lib/twkfreq.f90 b/wsjtx_lib/lib/twkfreq.f90 new file mode 100644 index 0000000..7ffe396 --- /dev/null +++ b/wsjtx_lib/lib/twkfreq.f90 @@ -0,0 +1,30 @@ +subroutine twkfreq(c3,c4,npts,fsample,a) + + ! Adjust frequency of complex data + ! a(1) Hz + ! a(2) Hz/(0.5*TxT), where TxT = npts/fsample = file duration + + complex c3(npts) + complex c4(npts) + complex w,wstep + real a(3) + data twopi/6.283185307/ + +! Mix the complex signal + w=1.0 + wstep=1.0 + x0=0.5*(npts+1) + s=2.0/npts + do i=1,npts + x=s*(i-x0) + p2=1.5*x*x - 0.5 +! p3=2.5*(x**3) - 1.5*x +! p4=4.375*(x**4) - 3.75*(x**2) + 0.375 + dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/fsample) + wstep=cmplx(cos(dphi),sin(dphi)) + w=w*wstep + c4(i)=w*c3(i) + enddo + + return +end subroutine twkfreq diff --git a/wsjtx_lib/lib/twkfreq65.f90 b/wsjtx_lib/lib/twkfreq65.f90 new file mode 100644 index 0000000..698faa4 --- /dev/null +++ b/wsjtx_lib/lib/twkfreq65.f90 @@ -0,0 +1,25 @@ +subroutine twkfreq65(c4aa,n5,a) + + complex c4aa(n5) + real a(5) + complex w,wstep + data twopi/6.283185307/ + +! Apply AFC corrections to the c4aa data + w=1.0 + wstep=1.0 + x0=0.5*(n5+1) + s=2.0/n5 + do i=1,n5 + x=s*(i-x0) + if(mod(i,100).eq.1) then + p2=1.5*x*x - 0.5 + dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/1378.125) + wstep=cmplx(cos(dphi),sin(dphi)) + endif + w=w*wstep + c4aa(i)=w*c4aa(i) + enddo + + return +end subroutine twkfreq65 diff --git a/wsjtx_lib/lib/types.f90 b/wsjtx_lib/lib/types.f90 new file mode 100644 index 0000000..0fb8232 --- /dev/null +++ b/wsjtx_lib/lib/types.f90 @@ -0,0 +1,18 @@ +module types + use, intrinsic :: iso_fortran_env + implicit none + + ! use the Fortran 2008 intrinsic constants to define real kinds + integer, parameter :: sp = REAL32 + integer, parameter :: dp = REAL64 + integer, parameter :: qp = REAL128 + + type q3list + character*6 call + character*4 grid + integer nsec + integer nfreq + integer moonel + end type q3list + +end module types diff --git a/wsjtx_lib/lib/update_msk40_hasharray.f90 b/wsjtx_lib/lib/update_msk40_hasharray.f90 new file mode 100644 index 0000000..64886b4 --- /dev/null +++ b/wsjtx_lib/lib/update_msk40_hasharray.f90 @@ -0,0 +1,25 @@ +subroutine update_msk40_hasharray(nhasharray) + + use packjt77 + character*37 hashmsg + integer nhasharray(MAXRECENT,MAXRECENT) + + nhasharray=-1 + do i=1,MAXRECENT + do j=i+1,MAXRECENT + if( recent_calls(i)(1:1) .ne. ' ' .and. recent_calls(j)(1:1) .ne. ' ' ) then + hashmsg=trim(recent_calls(i))//' '//trim(recent_calls(j)) + call fmtmsg(hashmsg,iz) + call hash(hashmsg,37,ihash) + ihash=iand(ihash,4095) + nhasharray(i,j)=ihash + hashmsg=trim(recent_calls(j))//' '//trim(recent_calls(i)) + call fmtmsg(hashmsg,iz) + call hash(hashmsg,37,ihash) + ihash=iand(ihash,4095) + nhasharray(j,i)=ihash + endif + enddo + enddo + +end subroutine update_msk40_hasharray diff --git a/wsjtx_lib/lib/update_recent_calls.f90 b/wsjtx_lib/lib/update_recent_calls.f90 new file mode 100644 index 0000000..e67ff38 --- /dev/null +++ b/wsjtx_lib/lib/update_recent_calls.f90 @@ -0,0 +1,19 @@ +subroutine update_recent_calls(call,calls_hrd,nsize) +character*12 call,calls_hrd(nsize) + + new=1 + do ic=1,nsize + if( calls_hrd(ic).eq.call ) then + new=0 + endif + enddo + + if( new.eq.1 ) then + do ic=nsize-1,1,-1 + calls_hrd(ic+1)(1:12)=calls_hrd(ic)(1:12) + enddo + calls_hrd(1)(1:12)=call(1:12) + endif + + return + end subroutine update_recent_calls diff --git a/wsjtx_lib/lib/usleep.c b/wsjtx_lib/lib/usleep.c new file mode 100644 index 0000000..6fbc98c --- /dev/null +++ b/wsjtx_lib/lib/usleep.c @@ -0,0 +1,8 @@ +#include +#include "sleep.h" + +/* usleep(3) */ +void usleep_(unsigned long *microsec) +{ + usleep(*microsec); +} diff --git a/wsjtx_lib/lib/vit213.c b/wsjtx_lib/lib/vit213.c new file mode 100644 index 0000000..93f803a --- /dev/null +++ b/wsjtx_lib/lib/vit213.c @@ -0,0 +1,221 @@ +/* Viterbi decoder for arbitrary convolutional code + * viterbi27 and viterbi37 for the r=1/2 and r=1/3 K=7 codes are faster + * Copyright 1999 Phil Karn, KA9Q + * Modifications by Joe Taylor, K1JT + * May be used under the terms of the GNU Public License + */ + +#include + +/* Select code here */ + +#define V213 + +#ifdef V213 +#define K 13 /* Constraint length */ +#define N 2 /* Number of symbols per data bit */ +#define Polys Poly213 /* Select polynomials here */ +#endif + +/* Rate 1/2 codes */ +unsigned int Poly213[] = {012767,016461}; /* k = 13 */ + +#include + +#define LONGBITS 32 +#define LOGLONGBITS 5 + +#undef max +#define max(x,y) ((x) > (y) ? (x) : (y)) +#define D (1 << max(0,K-LOGLONGBITS-1)) +#define MAXNBITS 200 /* Maximum frame size (user bits) */ + +extern unsigned char Partab[]; /* Parity lookup table */ + +int Syms[1 << K]; + + +int parity(int x) +{ + x ^= (x >> 16); + x ^= (x >> 8); + return Partab[x & 0xff]; +} + +/* Convolutionally encode data into binary symbols */ +int enc213(unsigned char symbols[], unsigned char data[], + unsigned int nbytes, unsigned int startstate, + unsigned int endstate) +{ + unsigned int i,j,k; + int l,n=-1; + unsigned int encstate = startstate; + + for(k=0; k=0;l--){ + encstate = (encstate + encstate) + ((data[k] >> l) & 1); + for(j=0;j> i) & 1); + for(j=0;j> (N-j-1)) & 1][symbols[j]]; + } + } + symbols += N; + /* Run the add-compare-select operations */ + mask = 1; + for(i=0;i< 1 << (K-1);i+=2){ + int b1,b2; + + b1 = mets[Syms[i]]; + nmetric[i] = m0 = cmetric[i/2] + b1; + b2 = mets[Syms[i+1]]; + b1 -= b2; + m1 = cmetric[(i/2) + (1<<(K-2))] + b2; + + if(m1 > m0){ + nmetric[i] = m1; + *pp |= mask; + } + + m0 -= b1; + nmetric[i+1] = m0; + m1 += b1; + + if(m1 > m0){ + nmetric[i+1] = m1; + *pp |= mask << 1; + } + + mask <<= 2; + if(mask == 0){ + mask = 1; + pp++; + ipp++; + } + } + if(mask != 1){ + pp++; + ipp++; + } + if(++bitcnt == (int)nbits){ + *metric = nmetric[endstate]; + break; + } + memcpy(cmetric,nmetric,sizeof(cmetric)); + } + + /* Chain back from terminal state to produce decoded data */ + if(data == NULL) + return 0;/* Discard output */ + memset(data,0,(nbits+7)/8); /* round up in case nbits % 8 != 0 */ + + for(i=nbits-1;i >= 0;i--){ + // int a0,a1; + pp -= D; + ipp -= D; + m0=endstate >> LOGLONGBITS; + m1=1L << (endstate & (LONGBITS-1)); + if(pp[m0] & m1) { + // a0=nmetric[endstate]; + endstate |= (1 << (K-1)); + // a1=nmetric[endstate]; + data[i>>3] |= 0x80 >> (i&7); + // printf("B %d %d %d %d\n",*metric,i,a0,a1); + } + endstate >>= 1; + } + return 0; +} + +// Wrapper for calling "encode" from Fortran: +void enc213_( +unsigned char data[], // User data, 8 bits per byte +int *nbits, // Number of user bits +unsigned char symbols[], // Encoded one-bit symbols, 8 per byte +int *nsymbols, // Number of symbols +int *kk, // K +int *nn) // N +{ + int nbytes; + nbytes=(*nbits+7)/8; // Always encode multiple of 8 information bits + enc213(symbols,data,nbytes,0,0); // Do the encoding + *nsymbols=(*nbits+K-1)*N; // Return number of encoded symbols + *kk=K; + *nn=N; +} + +// Wrapper for calling "viterbi" from Fortran: +void vit213_( +unsigned char symbols[], /* Raw deinterleaved input symbols */ +unsigned int *Nbits, /* Number of decoded information bits */ +int mettab[2][256], /* Metric table, [sent sym][rx symbol] */ +unsigned char ddec[], /* Decoded output data */ +int *Metric /* Final path metric (bigger is better) */ +){ + int metric; + vit213(&metric,ddec,symbols,*Nbits,mettab,0,0); + *Metric=metric; +} + diff --git a/wsjtx_lib/lib/vit216.c b/wsjtx_lib/lib/vit216.c new file mode 100644 index 0000000..fc0c5a7 --- /dev/null +++ b/wsjtx_lib/lib/vit216.c @@ -0,0 +1,219 @@ +/* Viterbi decoder for arbitrary convolutional code + * viterbi27 and viterbi37 for the r=1/2 and r=1/3 K=7 codes are faster + * Copyright 1999 Phil Karn, KA9Q + * May be used under the terms of the GNU Public License + */ + +/* Select code here */ + +#define V216 + + +#ifdef V216 +#define K 16 /* Constraint length */ +#define N 2 /* Number of symbols per data bit */ +#define Polys Poly216 /* Select polynomials here */ +#endif + +/* Rate 1/2 codes */ +unsigned int Poly216[] = {0126723, 0152711}; /* k = 16 */ + +#include +#include + +#define LONGBITS 32 +#define LOGLONGBITS 5 + +#undef max +#define max(x,y) ((x) > (y) ? (x) : (y)) +#define D (1 << max(0,K-LOGLONGBITS-1)) +#define MAXNBITS 200 /* Maximum frame size (user bits) */ + +extern unsigned char Partab[]; /* Parity lookup table */ + +int Syms[1 << K]; +int VDInit = 0; + +int parity(int x) +{ + x ^= (x >> 16); + x ^= (x >> 8); + return Partab[x & 0xff]; +} + +// Wrapper for calling "encode" from Fortran: +//void __stdcall ENCODE( +void enc216_( +unsigned char data[], // User data, 8 bits per byte +int *nbits, // Number of user bits +unsigned char symbols[], // Encoded one-bit symbols, 8 per byte +int *nsymbols, // Number of symbols +int *kk, // K +int *nn) // N +{ + int nbytes; + nbytes=(*nbits+7)/8; // Always encode multiple of 8 information bits + enc216(symbols,data,nbytes,0,0); // Do the encoding + *nsymbols=(*nbits+K-1)*N; // Return number of encoded symbols + *kk=K; + *nn=N; +} + +/* Convolutionally encode data into binary symbols */ + enc216(unsigned char symbols[], unsigned char data[], + unsigned int nbytes, unsigned int startstate, + unsigned int endstate) +{ + int i,j,k,n=-1; + unsigned int encstate = startstate; + + for(k=0; k=0;i--){ + encstate = (encstate + encstate) + ((data[k] >> i) & 1); + for(j=0;j> i) & 1); + for(j=0;j> (N-j-1)) & 1][symbols[j]]; + } + } + symbols += N; + /* Run the add-compare-select operations */ + mask = 1; + for(i=0;i< 1 << (K-1);i+=2){ + int b1,b2; + + b1 = mets[Syms[i]]; + nmetric[i] = m0 = cmetric[i/2] + b1; + b2 = mets[Syms[i+1]]; + b1 -= b2; + m1 = cmetric[(i/2) + (1<<(K-2))] + b2; + + if(m1 > m0){ + nmetric[i] = m1; + *pp |= mask; + } + + m0 -= b1; + nmetric[i+1] = m0; + m1 += b1; + + if(m1 > m0){ + nmetric[i+1] = m1; + *pp |= mask << 1; + } + + mask <<= 2; + if(mask == 0){ + mask = 1; + pp++; + ipp++; + } + } + if(mask != 1){ + pp++; + ipp++; + } + if(++bitcnt == nbits){ + *metric = nmetric[endstate]; + break; + } + memcpy(cmetric,nmetric,sizeof(cmetric)); + } + + /* Chain back from terminal state to produce decoded data */ + if(data == NULL) + return 0;/* Discard output */ + memset(data,0,(nbits+7)/8); /* round up in case nbits % 8 != 0 */ + + for(i=nbits-1;i >= 0;i--){ + // int a0,a1; + pp -= D; + ipp -= D; + m0=endstate >> LOGLONGBITS; + m1=1L << (endstate & (LONGBITS-1)); + if(pp[m0] & m1) { + // a0=nmetric[endstate]; + endstate |= (1 << (K-1)); + // a1=nmetric[endstate]; + data[i>>3] |= 0x80 >> (i&7); + // printf("B %d %d %d %d\n",*metric,i,a0,a1); + } + endstate >>= 1; + } + return 0; +} diff --git a/wsjtx_lib/lib/wav11.f90 b/wsjtx_lib/lib/wav11.f90 new file mode 100644 index 0000000..1311d25 --- /dev/null +++ b/wsjtx_lib/lib/wav11.f90 @@ -0,0 +1,27 @@ +subroutine wav11(d2,npts,dd) + +! Convert i*2 data sampled at 12000 Hz to r*4 sampled at 11025 Hz. + + parameter (NZ11=60*11025,NZ12=60*12000) + parameter (NFFT1=64*12000,NFFT2=64*11025) + integer*2 d2(NZ12) + real*4 dd(NZ11) + real x(NFFT1) + complex cx(0:NFFT1/2) + equivalence (x,cx) + save x,cx + + jz=min(NZ12,npts) + x(1:jz)=d2(1:jz) + x(jz+1:)=0.0 + call four2a(cx,nfft1,1,-1,0) !Forward FFT, r2c + df=12000.0/NFFT1 + ia=5000.0/df + cx(ia:)=0.0 + call four2a(cx,nfft2,1,1,-1) !Inverse FFT, c2r + npts=jz*11025.0/12000.0 + fac=1.e-6 + dd(1:npts)=fac*x(1:npts) + + return +end subroutine wav11 diff --git a/wsjtx_lib/lib/wav12.f90 b/wsjtx_lib/lib/wav12.f90 new file mode 100644 index 0000000..ff65543 --- /dev/null +++ b/wsjtx_lib/lib/wav12.f90 @@ -0,0 +1,49 @@ +subroutine wav12(d2,d1,npts,nbitsam2) + +! Convert i*2 or i*1 data at 11025 Hz (from WSJT *.wav files) +! to i*2 data at 12000 Hz. + +! Input: i*2 d2(npts) or i*1 d1(npts) +! i*2 nbitsam2 = 8 or 16 (bits per sample) + +! Output: npts = (12000*npts)/11025 +! i*2 d2(npts) + + parameter (NZ11=60*11025,NZ12=60*12000) + parameter (NFFT1=64*11025,NFFT2=64*12000) + integer*1 d1(NZ11) + integer*1 d1a(NZ11) + integer*1 i1 + integer*2 i2 + integer*2 d2(NZ12) + real x(NFFT2) + complex cx(0:NFFT2/2) + integer*2 nbitsam2 + equivalence (x,cx),(i1,i2) + + jz=min(NZ11,npts) + if(nbitsam2.eq.8) then + jz=min(NZ11,npts) + d1a(1:jz)=d1(1:jz) !d1 and d2 may be same array in calling prog + do i=1,jz !Move data from d1a into d2 + i2=0 + i1=d1a(i) + d2(i)=10*(i2-128) + enddo + endif + + x(1:jz)=d2(1:jz) + x(jz+1:)=0.0 + call four2a(cx,nfft1,1,-1,0) !Forwarxd FFT, r2c + cx(nfft1/2:)=0.0 + call four2a(cx,nfft2,1,1,-1) !Inverse FFT, c2r + + npts=jz*12000.0/11025.0 + fac=1.e-6 +! if(nbitsam2.eq.16) fac=3.e-6 + x=fac*x + d2(1:npts)=nint(x(1:npts)) + if(npts.lt.NZ12) d2(npts+1:NZ12)=0 + + return +end subroutine wav12 diff --git a/wsjtx_lib/lib/wavhdr.f90 b/wsjtx_lib/lib/wavhdr.f90 new file mode 100644 index 0000000..6568c1f --- /dev/null +++ b/wsjtx_lib/lib/wavhdr.f90 @@ -0,0 +1,110 @@ +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=13) + character*8 mode,modes(NMODES) + integer*2 id2(4) + integer iperiod(8) + 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','FT8','FT2'/ + data iperiod/5,10,15,30,60,120,900,0/ + + 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,8 + 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=13) + character*8 mode,modes(NMODES) + character*6 band,bands(NBANDS) + integer*2 id2(4) + integer iperiod(8) + logical ok + data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', & + 'JT9+JT65','JTMS','JTMSK','WSPR','FT8','FT2'/ + data iperiod/5,10,15,30,60,120,900,0/ + 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.8) 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/wsjtx_lib/lib/wisdom.c b/wsjtx_lib/lib/wisdom.c new file mode 100644 index 0000000..ef008a7 --- /dev/null +++ b/wsjtx_lib/lib/wisdom.c @@ -0,0 +1,13 @@ +void export_wisdom_(char fname[], int len) +{ + int fftwf_export_wisdom_to_filename(const char *); + fname[len-1]=0; + fftwf_export_wisdom_to_filename(fname); +} + +void import_wisdom_(char fname[], int *success, int len) +{ + int fftwf_import_wisdom_from_filename(const char *); + fname[len-1]=0; + *success = fftwf_import_wisdom_from_filename(fname); +} diff --git a/wsjtx_lib/lib/wisdom1.bat b/wsjtx_lib/lib/wisdom1.bat new file mode 100644 index 0000000..615df82 --- /dev/null +++ b/wsjtx_lib/lib/wisdom1.bat @@ -0,0 +1,2 @@ +C:\JTSDK-QT\fftw3f\fftwf-wisdom -o fftwf_wisdom.dat -t 1 -m rif672000 cif77175 cib77175 rif16384 rif884736 cib2048 rif8192 rif512 rib512 cib512 + diff --git a/wsjtx_lib/lib/wqdecode.f90 b/wsjtx_lib/lib/wqdecode.f90 new file mode 100644 index 0000000..72c20f0 --- /dev/null +++ b/wsjtx_lib/lib/wqdecode.f90 @@ -0,0 +1,338 @@ +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: wqdecode.f90 +! Description: +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- +subroutine wqdecode(data0,message,ntype) + + parameter (N15=32768) + integer*1 data0(11) + character*22 message + character*12 callsign + character*3 cdbm + character grid4*4,grid6*6 + logical first + character*12 dcall(0:N15-1) + data first/.true./ + save first,dcall + +! May want to have a timeout (say, one hour?) on calls fetched +! from the hash table. + + if(first) then + dcall=' ' + first=.false. + endif + + message=' ' + call unpack50(data0,n1,n2) +! print*,data0,n1,n2 + call unpackcall(n1,callsign) + i1=index(callsign,' ') + call unpackgrid(n2/128,grid4) + ntype=iand(n2,127) -64 + +! Standard WSPR message (types 0 3 7 10 13 17 ... 60) + if(ntype.ge.0 .and. ntype.le.62) then + nu=mod(ntype,10) + if(nu.eq.0 .or. nu.eq.3 .or. nu.eq.7) then + write(cdbm,'(i3)') ntype + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + message=callsign(1:i1)//grid4//' '//cdbm + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1) + else + nadd=nu + if(nu.gt.3) nadd=nu-3 + if(nu.gt.7) nadd=nu-7 + ng=n2/128 + 32768*(nadd-1) + call unpackpfx(ng,callsign) + ndbm=ntype-nadd + write(cdbm,'(i3)') ndbm + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + i2=index(callsign,' ') + message=callsign(:i2)//cdbm + call hash(callsign,i2-1,ih) + dcall(ih)=callsign(:i2) + endif + else if(ntype.lt.0) then + ndbm=-(ntype+1) + grid6=callsign(6:6)//callsign(1:5) + ih=(n2-ntype-64)/128 + callsign=dcall(ih) + write(cdbm,'(i3)') ndbm + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + i2=index(callsign,' ') + if(dcall(ih)(1:1).ne.' ') then + message='<'//callsign(:i2-1)//'> '//grid6//' '//cdbm + else + message='<...> '//grid6//' '//cdbm + endif + endif + + return +end subroutine wqdecode + +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: unpack50.f90 +! Description: +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- +subroutine unpack50(dat,n1,n2) + + integer*1 dat(11) + + i=dat(1) + i4=iand(i,255) + n1=ishft(i4,20) + i=dat(2) + i4=iand(i,255) + n1=n1 + ishft(i4,12) + i=dat(3) + i4=iand(i,255) + n1=n1 + ishft(i4,4) + i=dat(4) + i4=iand(i,255) + n1=n1 + iand(ishft(i4,-4),15) + n2=ishft(iand(i4,15),18) + i=dat(5) + i4=iand(i,255) + n2=n2 + ishft(i4,10) + i=dat(6) + i4=iand(i,255) + n2=n2 + ishft(i4,2) + i=dat(7) + i4=iand(i,255) + n2=n2 + iand(ishft(i4,-6),3) + + return +end subroutine unpack50 + +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: unpackcall.f90 +! Description: +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- +subroutine unpackcall(ncall,word) + + character word*12,c*37 + + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/ + + n=ncall + word='......' + if(n.ge.262177560) go to 999 !Plain text message ... + i=mod(n,27)+11 + word(6:6)=c(i:i) + n=n/27 + i=mod(n,27)+11 + word(5:5)=c(i:i) + n=n/27 + i=mod(n,27)+11 + word(4:4)=c(i:i) + n=n/27 + i=mod(n,10)+1 + word(3:3)=c(i:i) + n=n/10 + i=mod(n,36)+1 + word(2:2)=c(i:i) + n=n/36 + i=n+1 + word(1:1)=c(i:i) + do i=1,4 + if(word(i:i).ne.' ') go to 10 + enddo + go to 999 +10 word=word(i:) + +999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:) + return +end subroutine unpackcall + +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: unpackgrid.f90 +! Description: +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- +subroutine unpackgrid(ng,grid) + + parameter (NGBASE=180*180) + character grid*4,grid6*6,digit*10 + data digit/'0123456789'/ + + grid=' ' + if(ng.ge.32400) go to 10 + dlat=mod(ng,180)-90 + dlong=(ng/180)*2 - 180 + 2 + call deg2grid(dlong,dlat,grid6) + grid=grid6(1:4) !XXX explicitly truncate this -db + go to 100 + +10 n=ng-NGBASE-1 + if(n.ge.1 .and.n.le.30) then + grid(1:1)='-' + grid(2:2)=char(48+n/10) + grid(3:3)=char(48+mod(n,10)) + else if(n.ge.31 .and.n.le.60) then + n=n-30 + grid(1:2)='R-' + grid(3:3)=char(48+n/10) + grid(4:4)=char(48+mod(n,10)) + else if(n.eq.61) then + grid='RO' + else if(n.eq.62) then + grid='RRR' + else if(n.eq.63) then + grid='73' + endif + +100 return +end subroutine unpackgrid + +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: unpackpfx.f90 +! Description: +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- +subroutine unpackpfx(ng,call1) + + character*12 call1 + character*3 pfx + + if(ng.lt.60000) then +! Add-on prefix of 1 to 3 characters + n=ng + do i=3,1,-1 + nc=mod(n,37) + if(nc.ge.0 .and. nc.le.9) then + pfx(i:i)=char(nc+48) + else if(nc.ge.10 .and. nc.le.35) then + pfx(i:i)=char(nc+55) + else + pfx(i:i)=' ' + endif + n=n/37 + enddo + call1=pfx//'/'//call1(1:8) + if(call1(1:1).eq.' ') call1=call1(2:) + if(call1(1:1).eq.' ') call1=call1(2:) + else +! Add-on suffix, one or teo characters + i1=index(call1,' ') + nc=ng-60000 + if(nc.ge.0 .and. nc.le.9) then + call1=call1(:i1-1)//'/'//char(nc+48) + else if(nc.ge.10 .and. nc.le.35) then + call1=call1(:i1-1)//'/'//char(nc+55) + else if(nc.ge.36 .and. nc.le.125) then + nc1=(nc-26)/10 + nc2=mod(nc-26,10) + call1=call1(:i1-1)//'/'//char(nc1+48)//char(nc2+48) + endif + endif + + return +end subroutine unpackpfx diff --git a/wsjtx_lib/lib/wqencode.f90 b/wsjtx_lib/lib/wqencode.f90 new file mode 100644 index 0000000..59b2470 --- /dev/null +++ b/wsjtx_lib/lib/wqencode.f90 @@ -0,0 +1,65 @@ +subroutine wqencode(msg,ntype,data0) + +! Parse and encode a WSPR message. + + use packjt + parameter (MASK15=32767) + character*22 msg + character*12 call1,call2 + character grid4*4 + logical lbad1,lbad2 + integer*1 data0(11) + integer nu(0:9) + data nu/0,-1,1,0,-1,2,1,0,-1,1/ + +! Standard WSPR message (types 0 3 7 10 13 17 ... 60) + i1=index(msg,' ') + i2=index(msg,'/') + i3=index(msg,'<') + call1=msg(:i1-1) + if(i1.lt.3 .or. i1.gt.7 .or. i2.gt.0 .or. i3.gt.0) go to 10 + grid4=msg(i1+1:i1+4) + call packcall(call1,n1,lbad1) + call packgrid(grid4,ng,lbad2) + if(lbad1 .or. lbad2) go to 10 + ndbm=0 + read(msg(i1+5:),*) ndbm + if(ndbm.lt.0) ndbm=0 + if(ndbm.gt.60) ndbm=60 + ndbm=ndbm+nu(mod(ndbm,10)) + n2=128*ng + (ndbm+64) + call pack50(n1,n2,data0) + ntype=ndbm + go to 900 + +10 if(i2.ge.2 .and. i3.lt.1) then + call packpfx(call1,n1,ng,nadd) + ndbm=0 + read(msg(i1+1:),*) ndbm + if(ndbm.lt.0) ndbm=0 + if(ndbm.gt.60) ndbm=60 + ndbm=ndbm+nu(mod(ndbm,10)) + ntype=ndbm + 1 + nadd + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + else if(i3.eq.1) then + i4=index(msg,'>') + call1=msg(2:i4-1) + call hash(call1,i4-2,ih) + i5=index(trim(msg(i1+1:)),' ') +! Convert grid to valid callsign format - first character moved to end + call2=msg(i1+2:i1+i5-1)//msg(i1+1:i1+1)//' ' + call packcall(call2,n1,lbad1) + ndbm=0 + read(msg(i1+i5+1:),*) ndbm + if(ndbm.lt.0) ndbm=0 + if(ndbm.gt.60) ndbm=60 + ndbm=ndbm+nu(mod(ndbm,10)) + ntype=-(ndbm+1) + n2=128*ih + ntype + 64 + call pack50(n1,n2,data0) + endif +900 continue + + return +end subroutine wqencode diff --git a/wsjtx_lib/lib/wrapkarn.c b/wsjtx_lib/lib/wrapkarn.c new file mode 100644 index 0000000..9e0a51c --- /dev/null +++ b/wsjtx_lib/lib/wrapkarn.c @@ -0,0 +1,70 @@ +#include +#include +#include +#include +#include +#include "rs.h" + +static void *rs; +static int first=1; + +void rs_encode_(int *dgen, int *sent) +// Encode JT65 data dgen[12], producing sent[63]. +{ + int dat1[12]; + int b[51]; + int i; + + if(first) { + // Initialize the JT65 codec + rs=init_rs_int(6,0x43,3,1,51,0); + first=0; + } + + // Reverse data order for the Karn codec. + for(i=0; i<12; i++) { + dat1[i]=dgen[11-i]; + } + // Compute the parity symbols + encode_rs_int(rs,dat1,b); + + // Move parity symbols and data into sent[] array, in reverse order. + for (i = 0; i < 51; i++) sent[50-i] = b[i]; + for (i = 0; i < 12; i++) sent[i+51] = dat1[11-i]; +} + +void rs_decode_(int *recd0, int *era0, int *numera0, int *decoded, int *nerr) +// Decode JT65 received data recd0[63], producing decoded[12]. +// Erasures are indicated in era0[numera]. The number of corrected +// errors is *nerr. If the data are uncorrectable, *nerr=-1 is returned. +{ + int numera; + int i; + int era_pos[50]; + int recd[63]; + + if(first) { + rs=init_rs_int(6,0x43,3,1,51,0); + first=0; + } + + numera=*numera0; + for(i=0; i<12; i++) recd[i]=recd0[62-i]; + for(i=0; i<51; i++) recd[12+i]=recd0[50-i]; + if(numera) + for(i=0; i + * License: public-domain + * You may use this code any way you wish, private, educational, or commercial. + * It's free. + * + *------------------------------------------------------------------------------- +*/ + +/* +These are functions for producing 32-bit hashes for hash table lookup. +hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() +are externally useful functions. Routines to test the hash are included +if SELF_TEST is defined. You can use this free for any purpose. It's in +the public domain. It has no warranty. + +You probably want to use hashlittle(). hashlittle() and hashbig() +hash byte arrays. hashlittle() is is faster than hashbig() on +little-endian machines. Intel and AMD are little-endian machines. +On second thought, you probably want hashlittle2(), which is identical to +hashlittle() except it returns two 32-bit hashes for the price of one. +You could implement hashbig2() if you wanted but I haven't bothered here. + +If you want to find a hash of, say, exactly 7 integers, do + a = i1; b = i2; c = i3; + mix(a,b,c); + a += i4; b += i5; c += i6; + mix(a,b,c); + a += i7; + final(a,b,c); +then use c as the hash value. If you have a variable length array of +4-byte integers to hash, use hashword(). If you have a byte array (like +a character string), use hashlittle(). If you have several byte arrays, or +a mix of things, see the comments above hashlittle(). + +Why is this so big? I read 12 bytes at a time into 3 4-byte integers, +then mix those integers. This is fast (you can do a lot more thorough +mixing with 12*3 instructions on 3 integers than you can with 3 instructions +on 1 byte), but shoehorning those bytes into integers efficiently is messy. +*/ + +#define SELF_TEST 1 + +#include /* defines printf for tests */ +#include /* defines time_t for timings in the test */ +#ifdef Win32 +#include "win_stdint.h" /* defines uint32_t etc */ +#else +#include /* defines uint32_t etc */ +#endif +//#include /* attempt to define endianness */ +//#ifdef linux +//# include /* attempt to define endianness */ +//#endif + +#define HASH_LITTLE_ENDIAN 1 + +#define hashsize(n) ((uint32_t)1<<(n)) +#define hashmask(n) (hashsize(n)-1) +#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k)))) + +/* +------------------------------------------------------------------------------- +mix -- mix 3 32-bit values reversibly. + +This is reversible, so any information in (a,b,c) before mix() is +still in (a,b,c) after mix(). + +If four pairs of (a,b,c) inputs are run through mix(), or through +mix() in reverse, there are at least 32 bits of the output that +are sometimes the same for one pair and different for another pair. +This was tested for: +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that +satisfy this are + 4 6 8 16 19 4 + 9 15 3 18 27 15 + 14 9 3 7 17 3 +Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing +for "differ" defined as + with a one-bit base and a two-bit delta. I +used http://burtleburtle.net/bob/hash/avalanche.html to choose +the operations, constants, and arrangements of the variables. + +This does not achieve avalanche. There are input bits of (a,b,c) +that fail to affect some output bits of (a,b,c), especially of a. The +most thoroughly mixed value is c, but it doesn't really even achieve +avalanche in c. + +This allows some parallelism. Read-after-writes are good at doubling +the number of bits affected, so the goal of mixing pulls in the opposite +direction as the goal of parallelism. I did what I could. Rotates +seem to cost as much as shifts on every machine I could lay my hands +on, and rotates are much kinder to the top and bottom bits, so I used +rotates. +------------------------------------------------------------------------------- +*/ +#define mix(a,b,c) \ +{ \ + a -= c; a ^= rot(c, 4); c += b; \ + b -= a; b ^= rot(a, 6); a += c; \ + c -= b; c ^= rot(b, 8); b += a; \ + a -= c; a ^= rot(c,16); c += b; \ + b -= a; b ^= rot(a,19); a += c; \ + c -= b; c ^= rot(b, 4); b += a; \ +} + +/* +------------------------------------------------------------------------------- +final -- final mixing of 3 32-bit values (a,b,c) into c + +Pairs of (a,b,c) values differing in only a few bits will usually +produce values of c that look totally different. This was tested for +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +These constants passed: + 14 11 25 16 4 14 24 + 12 14 25 16 4 14 24 +and these came close: + 4 8 15 26 3 22 24 + 10 8 15 26 3 22 24 + 11 8 15 26 3 22 24 +------------------------------------------------------------------------------- +*/ +#define final(a,b,c) \ +{ \ + c ^= b; c -= rot(b,14); \ + a ^= c; a -= rot(c,11); \ + b ^= a; b -= rot(a,25); \ + c ^= b; c -= rot(b,16); \ + a ^= c; a -= rot(c,4); \ + b ^= a; b -= rot(a,14); \ + c ^= b; c -= rot(b,24); \ +} + +/* +------------------------------------------------------------------------------- +hashlittle() -- hash a variable-length key into a 32-bit value + k : the key (the unaligned variable-length array of bytes) + length : the length of the key, counting by bytes + initval : can be any 4-byte value +Returns a 32-bit value. Every bit of the key affects every bit of +the return value. Two keys differing by one or two bits will have +totally different hash values. + +The best hash table sizes are powers of 2. There is no need to do +mod a prime (mod is sooo slow!). If you need less than 32 bits, +use a bitmask. For example, if you need only 10 bits, do + h = (h & hashmask(10)); +In which case, the hash table should have hashsize(10) elements. + +If you are hashing n strings (uint8_t **)k, do it like this: + for (i=0, h=0; i 12) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; + case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; + case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=k[1]&0xffffff; a+=k[0]; break; + case 6 : b+=k[1]&0xffff; a+=k[0]; break; + case 5 : b+=k[1]&0xff; a+=k[0]; break; + case 4 : a+=k[0]; break; + case 3 : a+=k[0]&0xffffff; break; + case 2 : a+=k[0]&0xffff; break; + case 1 : a+=k[0]&0xff; break; + case 0 : return c; /* zero length strings require no mixing */ + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]; break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ + case 1 : a+=k8[0]; break; + case 0 : return c; + } + +#endif /* !valgrind */ + + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; + + /*--------------- all but last block: aligned reads and different mixing */ + while (length > 12) + { + a += k[0] + (((uint32_t)k[1])<<16); + b += k[2] + (((uint32_t)k[3])<<16); + c += k[4] + (((uint32_t)k[5])<<16); + mix(a,b,c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) block */ + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[4]+(((uint32_t)k[5])<<16); + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=k[4]; + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=k[2]; + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=k[0]; + break; + case 1 : a+=k8[0]; + break; + case 0 : return c; /* zero length requires no mixing */ + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length > 12) + { + a += k[0]; + a += ((uint32_t)k[1])<<8; + a += ((uint32_t)k[2])<<16; + a += ((uint32_t)k[3])<<24; + b += k[4]; + b += ((uint32_t)k[5])<<8; + b += ((uint32_t)k[6])<<16; + b += ((uint32_t)k[7])<<24; + c += k[8]; + c += ((uint32_t)k[9])<<8; + c += ((uint32_t)k[10])<<16; + c += ((uint32_t)k[11])<<24; + mix(a,b,c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch(length) /* all the case statements fall through */ + { + case 12: c+=((uint32_t)k[11])<<24; /* fall through */ + case 11: c+=((uint32_t)k[10])<<16; /* fall through */ + case 10: c+=((uint32_t)k[9])<<8; /* fall through */ + case 9 : c+=k[8]; /* fall through */ + case 8 : b+=((uint32_t)k[7])<<24; /* fall through */ + case 7 : b+=((uint32_t)k[6])<<16; /* fall through */ + case 6 : b+=((uint32_t)k[5])<<8; /* fall through */ + case 5 : b+=k[4]; /* fall through */ + case 4 : a+=((uint32_t)k[3])<<24; /* fall through */ + case 3 : a+=((uint32_t)k[2])<<16; /* fall through */ + case 2 : a+=((uint32_t)k[1])<<8; /* fall through */ + case 1 : a+=k[0]; + break; + case 0 : return c; + } + } + + final(a,b,c); + return c; +} + +//uint32_t __stdcall NHASH(const void *key, size_t length, uint32_t initval) diff --git a/wsjtx_lib/lib/wsprcode/wspr_old_subs.f90 b/wsjtx_lib/lib/wsprcode/wspr_old_subs.f90 new file mode 100644 index 0000000..a8b5c50 --- /dev/null +++ b/wsjtx_lib/lib/wsprcode/wspr_old_subs.f90 @@ -0,0 +1,937 @@ +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: wspr_old_subs.f90 +! Description: Utility subroutines from WSPR 2.0 +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- + +subroutine deg2grid(dlong0,dlat,grid) + + real dlong !West longitude (deg) + real dlat !Latitude (deg) + character grid*6 + + dlong=dlong0 + if(dlong.lt.-180.0) dlong=dlong+360.0 + if(dlong.gt.180.0) dlong=dlong-360.0 + +! Convert to units of 5 min of longitude, working east from 180 deg. + nlong=60.0*(180.0-dlong)/5.0 + n1=nlong/240 !20-degree field + n2=(nlong-240*n1)/24 !2 degree square + n3=nlong-240*n1-24*n2 !5 minute subsquare + grid(1:1)=char(ichar('A')+n1) + grid(3:3)=char(ichar('0')+n2) + grid(5:5)=char(ichar('a')+n3) + +! Convert to units of 2.5 min of latitude, working north from -90 deg. + nlat=60.0*(dlat+90)/2.5 + n1=nlat/240 !10-degree field + n2=(nlat-240*n1)/24 !1 degree square + n3=nlat-240*n1-24*n2 !2.5 minuts subsquare + grid(2:2)=char(ichar('A')+n1) + grid(4:4)=char(ichar('0')+n2) + grid(6:6)=char(ichar('a')+n3) + + return +end subroutine deg2grid + +subroutine encode232(dat,nbytes,symbol,maxsym) + +! Convolutional encoder for a K=32, r=1/2 code. + + integer*1 dat(nbytes) !User data, packed 8 bits per byte + integer*1 symbol(maxsym) !Channel symbols, one bit per byte + integer*1 i1 + +! Layland-Lushbaugh polynomials for a K=32, r=1/2 convolutional code, +! and 8-bit parity lookup table. + + data npoly1/-221228207/,npoly2/-463389625/ + integer*1 partab(0:255) + data partab/ & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0/ + + nstate=0 + k=0 + do j=1,nbytes + do i=7,0,-1 + i1=dat(j) + i4=i1 + if (i4.lt.0) i4=i4+256 + nstate=ior(ishft(nstate,1),iand(ishft(i4,-i),1)) + n=iand(nstate,npoly1) + n=ieor(n,ishft(n,-16)) + k=k+1 + symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255)) + n=iand(nstate,npoly2) + n=ieor(n,ishft(n,-16)) + k=k+1 + symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255)) + enddo + enddo + + return +end subroutine encode232 + +subroutine fano232(symbol,nbits,mettab,ndelta,maxcycles,dat,ncycles,metric,ierr) + +! Sequential decoder for K=32, r=1/2 convolutional code using +! the Fano algorithm. Translated from C routine for same purpose +! written by Phil Karn, KA9Q. + + parameter (MAXBITS=103) + parameter (MAXDAT=13) !(MAXBITS+7)/8 + integer*1 symbol(0:2*MAXBITS-1) + integer*1 dat(MAXDAT) !Decoded user data, 8 bits per byte + integer mettab(0:255,0:1) !Metric table + +! These were the "node" structure in Karn's C code: + integer nstate(0:MAXBITS-1) !Encoder state of next node + integer gamma(0:MAXBITS-1) !Cumulative metric to this node + integer metrics(0:3,0:MAXBITS-1) !Metrics indexed by all possible Tx syms + integer tm(0:1,0:MAXBITS-1) !Sorted metrics for current hypotheses + integer ii(0:MAXBITS-1) !Current branch being tested + + logical noback + +! Layland-Lushbaugh polynomials for a K=32, r=1/2 convolutional code, +! and 8-bit parity lookup table. + + data npoly1/-221228207/,npoly2/-463389625/ + integer*1 partab(0:255) + data partab/ & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 0, 1, 1, 0, 1, 0, 0, 1, & + 1, 0, 0, 1, 0, 1, 1, 0/ + + ntail=nbits-31 + +! Compute all possible branch metrics for each symbol pair. +! This is the only place we actually look at the raw input symbols + i4a=0 + i4b=0 + do np=0,nbits-1 + j=2*np + i4a=symbol(j) + i4b=symbol(j+1) + if (i4a.lt.0) i4a=i4a+256 + if (i4b.lt.0) i4b=i4b+256 + metrics(0,np) = mettab(i4a,0) + mettab(i4b,0) + metrics(1,np) = mettab(i4a,0) + mettab(i4b,1) + metrics(2,np) = mettab(i4a,1) + mettab(i4b,0) + metrics(3,np) = mettab(i4a,1) + mettab(i4b,1) + enddo + + np=0 + nstate(np)=0 + +! Compute and sort branch metrics from the root node + n=iand(nstate(np),npoly1) + n=ieor(n,ishft(n,-16)) + lsym=partab(iand(ieor(n,ishft(n,-8)),255)) + n=iand(nstate(np),npoly2) + n=ieor(n,ishft(n,-16)) + lsym=lsym+lsym+partab(iand(ieor(n,ishft(n,-8)),255)) + m0=metrics(lsym,np) + m1=metrics(ieor(3,lsym),np) + if(m0.gt.m1) then + tm(0,np)=m0 !0-branch has better metric + tm(1,np)=m1 + else + tm(0,np)=m1 !1-branch is better + tm(1,np)=m0 + nstate(np)=nstate(np) + 1 !Set low bit + endif + +! Start with best branch + ii(np)=0 + gamma(np)=0 + nt=0 + +! Start the Fano decoder + do i=1,nbits*maxcycles +! Look forward + ngamma=gamma(np) + tm(ii(np),np) + if(ngamma.ge.nt) then + +! Node is acceptable. If first time visiting this node, tighten threshold: + if(gamma(np).lt.(nt+ndelta)) nt=nt + & + ndelta * ((ngamma-nt)/ndelta) + +! Move forward + gamma(np+1)=ngamma + nstate(np+1)=ishft(nstate(np),1) + np=np+1 + if(np.eq.nbits-1) go to 100 !We're done! + + n=iand(nstate(np),npoly1) + n=ieor(n,ishft(n,-16)) + lsym=partab(iand(ieor(n,ishft(n,-8)),255)) + n=iand(nstate(np),npoly2) + n=ieor(n,ishft(n,-16)) + lsym=lsym+lsym+partab(iand(ieor(n,ishft(n,-8)),255)) + + if(np.ge.ntail) then + tm(0,np)=metrics(lsym,np) !We're in the tail, all zeros + else + m0=metrics(lsym,np) + m1=metrics(ieor(3,lsym),np) + if(m0.gt.m1) then + tm(0,np)=m0 !0-branch has better metric + tm(1,np)=m1 + else + tm(0,np)=m1 !1-branch is better + tm(1,np)=m0 + nstate(np)=nstate(np) + 1 !Set low bit + endif + endif + + ii(np)=0 !Start with best branch + go to 99 + endif + +! Threshold violated, can't go forward +10 noback=.false. + if(np.eq.0) noback=.true. + if(np.gt.0) then + if(gamma(np-1).lt.nt) noback=.true. + endif + + if(noback) then +! Can't back up, either. Relax threshold and look forward again +! to a better branch. + nt=nt-ndelta + if(ii(np).ne.0) then + ii(np)=0 + nstate(np)=ieor(nstate(np),1) + endif + go to 99 + endif + +! Back up + np=np-1 + if(np.lt.ntail .and. ii(np).ne.1) then +! Search the next best branch + ii(np)=ii(np)+1 + nstate(np)=ieor(nstate(np),1) + go to 99 + endif + go to 10 +99 continue + enddo + i=nbits*maxcycles + +100 metric=gamma(np) !Final path metric + +! Copy decoded data to user's buffer + nbytes=(nbits+7)/8 + np=7 + do j=1,nbytes-1 + i4a=nstate(np) + dat(j)=i4a + np=np+8 + enddo + dat(nbytes)=0 + + ncycles=i+1 + ierr=0 + if(i.ge.maxcycles*nbits) ierr=-1 + + return +end subroutine fano232 + +subroutine grid2deg(grid0,dlong,dlat) + +! Converts Maidenhead grid locator to degrees of West longitude +! and North latitude. + + character*6 grid0,grid + character*1 g1,g2,g3,g4,g5,g6 + + grid=grid0 + i=ichar(grid(5:5)) + if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm' + + if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)= & + char(ichar(grid(1:1))+ichar('A')-ichar('a')) + if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)= & + char(ichar(grid(2:2))+ichar('A')-ichar('a')) + if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)= & + char(ichar(grid(5:5))-ichar('A')+ichar('a')) + if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)= & + char(ichar(grid(6:6))-ichar('A')+ichar('a')) + + g1=grid(1:1) + g2=grid(2:2) + g3=grid(3:3) + g4=grid(4:4) + g5=grid(5:5) + g6=grid(6:6) + + nlong = 180 - 20*(ichar(g1)-ichar('A')) + n20d = 2*(ichar(g3)-ichar('0')) + xminlong = 5*(ichar(g5)-ichar('a')+0.5) + dlong = nlong - n20d - xminlong/60.0 + nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0') + xminlat = 2.5*(ichar(g6)-ichar('a')+0.5) + dlat = nlat + xminlat/60.0 + + return +end subroutine grid2deg + +subroutine hash(string,len,ihash) + + parameter (MASK15=32767) + character*(*) string + integer*1 ic(12) + + do i=1,len + ic(i)=ichar(string(i:i)) + enddo + i=nhash(ic,len,146) + ihash=iand(i,MASK15) + +! print*,'C',ihash,len,string + return +end subroutine hash + +subroutine inter_mept(id,ndir) + +! Interleave (ndir=1) or de-interleave (ndir=-1) the array id. + + integer*1 id(0:161),itmp(0:161) + integer j0(0:161) + logical first + data first/.true./ + save + + if(first) then +! Compute the interleave table using bit reversal. + k=-1 + do i=0,255 + n=0 + ii=i + do j=0,7 + n=n+n + if(iand(ii,1).ne.0) n=n+1 + ii=ii/2 + enddo + if(n.le.161) then + k=k+1 + j0(k)=n + endif + enddo + first=.false. + endif + + if(ndir.eq.1) then + do i=0,161 + itmp(j0(i))=id(i) + enddo + else + do i=0,161 + itmp(i)=id(j0(i)) + enddo + endif + + do i=0,161 + id(i)=itmp(i) + enddo + + return +end subroutine inter_mept + +function nchar(c) + +! Convert ASCII number, letter, or space to 0-36 for callsign packing. + + character c*1 + data n/0/ !Silence compiler warning + + if(c.ge.'0' .and. c.le.'9') then + n=ichar(c)-ichar('0') + else if(c.ge.'A' .and. c.le.'Z') then + n=ichar(c)-ichar('A') + 10 + else if(c.ge.'a' .and. c.le.'z') then + n=ichar(c)-ichar('a') + 10 + else if(c.ge.' ') then + n=36 + else + Print*,'Invalid character in callsign ',c,' ',ichar(c) + stop + endif + nchar=n + + return +end function nchar + +subroutine pack50(n1,n2,dat) + + integer*1 dat(11),i1 + + i1=iand(ishft(n1,-20),255) !8 bits + dat(1)=i1 + i1=iand(ishft(n1,-12),255) !8 bits + dat(2)=i1 + i1=iand(ishft(n1, -4),255) !8 bits + dat(3)=i1 + i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits + dat(4)=i1 + i1=iand(ishft(n2,-10),255) !8 bits + dat(5)=i1 + i1=iand(ishft(n2, -2),255) !8 bits + dat(6)=i1 + i1=64*iand(n2,3) !2 bits + dat(7)=i1 + dat(8)=0 + dat(9)=0 + dat(10)=0 + dat(11)=0 + + return +end subroutine pack50 + +subroutine packcall(callsign,ncall,text) + +! Pack a valid callsign into a 28-bit integer. + + parameter (NBASE=37*36*10*27*27*27) + character callsign*6,c*1,tmp*6,digit*10 + logical text + data digit/'0123456789'/ + + text=.false. + +! Work-around for Swaziland prefix: + if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6) + + if(callsign(1:3).eq.'CQ ') then + ncall=NBASE + 1 + if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. & + callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. & + callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then + nfreq=100*(ichar(callsign(4:4))-48) + & + 10*(ichar(callsign(5:5))-48) + & + ichar(callsign(6:6))-48 + ncall=NBASE + 3 + nfreq + endif + return + else if(callsign(1:4).eq.'QRZ ') then + ncall=NBASE + 2 + return + endif + + tmp=' ' + if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then + tmp=callsign + else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then + if(callsign(6:6).ne.' ') then + text=.true. + return + endif + tmp=' '//callsign(1:5) + else + text=.true. + return + endif + + do i=1,6 + c=tmp(i:i) + if(c.ge.'a' .and. c.le.'z') & + tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A')) + enddo + + n1=0 + if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1 + if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1 + n2=0 + if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1 + if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1 + n3=0 + if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1 + n4=0 + if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1 + n5=0 + if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1 + n6=0 + if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1 + + if(n1+n2+n3+n4+n5+n6 .ne. 6) then + text=.true. + return + endif + + ncall=nchar(tmp(1:1)) + ncall=36*ncall+nchar(tmp(2:2)) + ncall=10*ncall+nchar(tmp(3:3)) + ncall=27*ncall+nchar(tmp(4:4))-10 + ncall=27*ncall+nchar(tmp(5:5))-10 + ncall=27*ncall+nchar(tmp(6:6))-10 + + return +end subroutine packcall + +subroutine packgrid(grid,ng,text) + + parameter (NGBASE=180*180) + character*4 grid + logical text + + text=.false. + if(grid.eq.' ') go to 90 !Blank grid is OK + +! Test for numerical signal report, etc. + if(grid(1:1).eq.'-') then + n=10*(ichar(grid(2:2))-48) + ichar(grid(3:3)) - 48 + ng=NGBASE+1+n + go to 100 + else if(grid(1:2).eq.'R-') then + n=10*(ichar(grid(3:3))-48) + ichar(grid(4:4)) - 48 + if(n.eq.0) go to 90 + ng=NGBASE+31+n + go to 100 + else if(grid(1:2).eq.'RO') then + ng=NGBASE+62 + go to 100 + else if(grid(1:3).eq.'RRR') then + ng=NGBASE+63 + go to 100 + else if(grid(1:2).eq.'73') then + ng=NGBASE+64 + go to 100 + endif + + if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true. + if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true. + if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true. + if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true. + if(text) go to 100 + + call grid2deg(grid//'mm',dlong,dlat) + long=dlong + lat=dlat+ 90.0 + ng=((long+180)/2)*180 + lat + go to 100 + +90 ng=NGBASE + 1 + +100 return +end subroutine packgrid + +subroutine packpfx(call1,n1,ng,nadd) + + character*12 call1,call0 + character*3 pfx + logical text + + i1=index(call1,'/') + if(call1(i1+2:i1+2).eq.' ') then +! Single-character add-on suffix (maybe also fourth suffix letter?) + call0=call1(:i1-1) + call packcall(call0,n1,text) + nadd=1 + nc=ichar(call1(i1+1:i1+1)) + if(nc.ge.48 .and. nc.le.57) then + n=nc-48 + else if(nc.ge.65 .and. nc.le.90) then + n=nc-65+10 + else + n=38 + endif + nadd=1 + ng=60000-32768+n + else if(call1(i1+3:i1+3).eq.' ') then +! Two-character numerical suffix, /10 to /99 + call0=call1(:i1-1) + call packcall(call0,n1,text) + nadd=1 + n=10*(ichar(call1(i1+1:i1+1))-48) + ichar(call1(i1+2:i1+2)) - 48 + nadd=1 + ng=60000 + 26 + n + else +! Prefix of 1 to 3 characters + pfx=call1(:i1-1) + if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2) + if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2) + call0=call1(i1+1:) + call packcall(call0,n1,text) + + ng=0 + do i=1,3 + nc=ichar(pfx(i:i)) + if(nc.ge.48 .and. nc.le.57) then + n=nc-48 + else if(nc.ge.65 .and. nc.le.90) then + n=nc-65+10 + else + n=36 + endif + ng=37*ng + n + enddo + nadd=0 + if(ng.ge.32768) then + ng=ng-32768 + nadd=1 + endif + endif + + return +end subroutine packpfx + +subroutine unpack50(dat,n1,n2) + + integer*1 dat(11) + + i=dat(1) + i4=iand(i,255) + n1=ishft(i4,20) + i=dat(2) + i4=iand(i,255) + n1=n1 + ishft(i4,12) + i=dat(3) + i4=iand(i,255) + n1=n1 + ishft(i4,4) + i=dat(4) + i4=iand(i,255) + n1=n1 + iand(ishft(i4,-4),15) + n2=ishft(iand(i4,15),18) + i=dat(5) + i4=iand(i,255) + n2=n2 + ishft(i4,10) + i=dat(6) + i4=iand(i,255) + n2=n2 + ishft(i4,2) + i=dat(7) + i4=iand(i,255) + n2=n2 + iand(ishft(i4,-6),3) + + return +end subroutine unpack50 + +subroutine unpackcall(ncall,word) + + character word*12,c*37 + + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/ + + n=ncall + word='......' + if(n.ge.262177560) go to 999 !Plain text message ... + i=mod(n,27)+11 + word(6:6)=c(i:i) + n=n/27 + i=mod(n,27)+11 + word(5:5)=c(i:i) + n=n/27 + i=mod(n,27)+11 + word(4:4)=c(i:i) + n=n/27 + i=mod(n,10)+1 + word(3:3)=c(i:i) + n=n/10 + i=mod(n,36)+1 + word(2:2)=c(i:i) + n=n/36 + i=n+1 + word(1:1)=c(i:i) + do i=1,4 + if(word(i:i).ne.' ') go to 10 + enddo + go to 999 +10 word=word(i:) + +999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:) + return +end subroutine unpackcall + +subroutine unpackgrid(ng,grid) + + parameter (NGBASE=180*180) + character grid*4,grid6*6,digit*10 + data digit/'0123456789'/ + + grid=' ' + if(ng.ge.32400) go to 10 + dlat=mod(ng,180)-90 + dlong=(ng/180)*2 - 180 + 2 + call deg2grid(dlong,dlat,grid6) + grid=grid6(1:4) !XXX explicitly truncate this -db + go to 100 + +10 n=ng-NGBASE-1 + if(n.ge.1 .and.n.le.30) then + grid(1:1)='-' + grid(2:2)=char(48+n/10) + grid(3:3)=char(48+mod(n,10)) + else if(n.ge.31 .and.n.le.60) then + n=n-30 + grid(1:2)='R-' + grid(3:3)=char(48+n/10) + grid(4:4)=char(48+mod(n,10)) + else if(n.eq.61) then + grid='RO' + else if(n.eq.62) then + grid='RRR' + else if(n.eq.63) then + grid='73' + endif + +100 return +end subroutine unpackgrid + +subroutine unpackpfx(ng,call1) + + character*12 call1 + character*3 pfx + + if(ng.lt.60000) then +! Add-on prefix of 1 to 3 characters + n=ng + do i=3,1,-1 + nc=mod(n,37) + if(nc.ge.0 .and. nc.le.9) then + pfx(i:i)=char(nc+48) + else if(nc.ge.10 .and. nc.le.35) then + pfx(i:i)=char(nc+55) + else + pfx(i:i)=' ' + endif + n=n/37 + enddo + call1=pfx//'/'//call1(1:8) + if(call1(1:1).eq.' ') call1=call1(2:) + if(call1(1:1).eq.' ') call1=call1(2:) + else +! Add-on suffix, one or teo characters + i1=index(call1,' ') + nc=ng-60000 + if(nc.ge.0 .and. nc.le.9) then + call1=call1(:i1-1)//'/'//char(nc+48) + else if(nc.ge.10 .and. nc.le.35) then + call1=call1(:i1-1)//'/'//char(nc+55) + else if(nc.ge.36 .and. nc.le.125) then + nc1=(nc-26)/10 + nc2=mod(nc-26,10) + call1=call1(:i1-1)//'/'//char(nc1+48)//char(nc2+48) + endif + endif + + return +end subroutine unpackpfx + +subroutine wqdecode(data0,message,ntype) + + parameter (N15=32768) + integer*1 data0(11) + character*22 message + character*12 callsign + character*3 cdbm + character grid4*4,grid6*6 + logical first + character*12 dcall(0:N15-1) + data first/.true./ + save first,dcall + +! May want to have a timeout (say, one hour?) on calls fetched +! from the hash table. + + if(first) then + dcall=' ' + first=.false. + endif + + message=' ' + call unpack50(data0,n1,n2) + call unpackcall(n1,callsign) + i1=index(callsign,' ') + call unpackgrid(n2/128,grid4) + ntype=iand(n2,127) -64 + +! Standard WSPR message (types 0 3 7 10 13 17 ... 60) + if(ntype.ge.0 .and. ntype.le.62) then + nu=mod(ntype,10) + if(nu.eq.0 .or. nu.eq.3 .or. nu.eq.7) then + write(cdbm,'(i3)') ntype + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + message=callsign(1:i1)//grid4//' '//cdbm + call hash(callsign,i1-1,ih) + dcall(ih)=callsign(:i1) + else + nadd=nu + if(nu.gt.3) nadd=nu-3 + if(nu.gt.7) nadd=nu-7 + ng=n2/128 + 32768*(nadd-1) + call unpackpfx(ng,callsign) + ndbm=ntype-nadd + write(cdbm,'(i3)') ndbm + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + i2=index(callsign,' ') + message=callsign(:i2)//cdbm + call hash(callsign,i2-1,ih) + dcall(ih)=callsign(:i2) + endif + else if(ntype.lt.0) then + ndbm=-(ntype+1) + grid6=callsign(6:6)//callsign(1:5) + ih=(n2-ntype-64)/128 + callsign=dcall(ih) + write(cdbm,'(i3)') ndbm + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + if(cdbm(1:1).eq.' ') cdbm=cdbm(2:) + i2=index(callsign,' ') + if(dcall(ih)(1:1).ne.' ') then + message='<'//callsign(:i2-1)//'> '//grid6//' '//cdbm + else + message='<...> '//grid6//' '//cdbm + endif + endif + + return +end subroutine wqdecode + +subroutine wqencode(msg,ntype,data0) + +! Parse and encode a WSPR message. + + parameter (MASK15=32767) + character*22 msg + character*12 call1,call2 + character grid4*4,grid6*6 + logical lbad1,lbad2 + integer*1 data0(11) + integer nu(0:9) + data nu/0,-1,1,0,-1,2,1,0,-1,1/ + +! Standard WSPR message (types 0 3 7 10 13 17 ... 60) + i1=index(msg,' ') + i2=index(msg,'/') + i3=index(msg,'<') + call1=msg(:i1-1) + if(i1.lt.3 .or. i1.gt.7 .or. i2.gt.0 .or. i3.gt.0) go to 10 + grid4=msg(i1+1:i1+4) + call packcall(call1,n1,lbad1) + call packgrid(grid4,ng,lbad2) + if(lbad1 .or. lbad2) go to 10 + ndbm=0 + read(msg(i1+5:),*) ndbm + if(ndbm.lt.0) ndbm=0 + if(ndbm.gt.60) ndbm=60 + ndbm=ndbm+nu(mod(ndbm,10)) + n2=128*ng + (ndbm+64) + call pack50(n1,n2,data0) + ntype=ndbm + go to 900 + +10 if(i2.ge.2 .and. i3.lt.1) then + call packpfx(call1,n1,ng,nadd) + ndbm=0 + read(msg(i1+1:),*) ndbm + if(ndbm.lt.0) ndbm=0 + if(ndbm.gt.60) ndbm=60 + ndbm=ndbm+nu(mod(ndbm,10)) + ntype=ndbm + 1 + nadd + n2=128*ng + ntype + 64 + call pack50(n1,n2,data0) + else if(i3.eq.1) then + i4=index(msg,'>') + call1=msg(2:i4-1) + call hash(call1,i4-2,ih) + grid6=msg(i1+1:i1+6) + call2=grid6(2:6)//grid6(1:1)//' ' + call packcall(call2,n1,lbad1) + ndbm=0 + read(msg(i1+8:),*) ndbm + if(ndbm.lt.0) ndbm=0 + if(ndbm.gt.60) ndbm=60 + ndbm=ndbm+nu(mod(ndbm,10)) + ntype=-(ndbm+1) + n2=128*ih + ntype + 64 + call pack50(n1,n2,data0) + endif + go to 900 + +900 continue + return +end subroutine wqencode diff --git a/wsjtx_lib/lib/wsprcode/wsprcode.f90 b/wsjtx_lib/lib/wsprcode/wsprcode.f90 new file mode 100644 index 0000000..88b5590 --- /dev/null +++ b/wsjtx_lib/lib/wsprcode/wsprcode.f90 @@ -0,0 +1,158 @@ +!------------------------------------------------------------------------------- +! +! This file is part of the WSPR application, Weak Signal Propagation Reporter +! +! File Name: wsprcode.f90 +! Description: This program provides examples of the source encoding, +! convulsional error-control coding, bit and symbol ordering, +! and synchronizing information contained in WSPR messages. +! +! Copyright (C) 2001-2014 Joseph Taylor, K1JT +! License: GPL-3 +! +! This program is free software; you can redistribute it and/or modify it under +! the terms of the GNU General Public License as published by the Free Software +! Foundation; either version 3 of the License, or (at your option) any later +! version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT +! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License along with +! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin +! Street, Fifth Floor, Boston, MA 02110-1301, USA. +! +!------------------------------------------------------------------------------- + +program wsprcode + + parameter (NSYM=162) + parameter (MAXSYM=176) + character*22 msg,msg2 + integer*1 data0(13) + integer*1 data1(13) + integer*1 dat(206) + integer*1 softsym(206) + +! Define the sync vector: + integer*1 sync(NSYM) + 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/ + +! Metric table for decoding from soft symbols + integer mettab(0:255,0:1) + data mettab/ & + 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, 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, 4, 4, 4, 4, 4, 4, 4, & + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, & + 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, & + 2, 2, 2, 2, 1, 1, 1, 1, 0, 0, & + -1, -1, -1, -2, -2, -3, -4, -4, -5, -6, & + -7, -7, -8, -9, -10, -11, -12, -12, -13, -14, & + -15, -16, -17, -17, -18, -19, -20, -21, -22, -22, & + -23, -24, -25, -26, -26, -27, -28, -29, -30, -30, & + -31, -32, -33, -33, -34, -35, -36, -36, -37, -38, & + -38, -39, -40, -41, -41, -42, -43, -43, -44, -45, & + -45, -46, -47, -47, -48, -49, -49, -50, -51, -51, & + -52, -53, -53, -54, -54, -55, -56, -56, -57, -57, & + -58, -59, -59, -60, -60, -61, -62, -62, -62, -63, & + -64, -64, -65, -65, -66, -67, -67, -67, -68, -69, & + -69, -70, -70, -71, -72, -72, -72, -72, -73, -74, & + -75, -75, -75, -77, -76, -76, -78, -78, -80, -81, & + -80, -79, -83, -82, -81, -82, -82, -83, -84, -84, & + -84, -87, -86, -87, -88, -89, -89, -89, -88, -87, & + -86, -87, -84, -84, -84, -83, -82, -82, -81, -82, & + -83, -79, -80, -81, -80, -78, -78, -76, -76, -77, & + -75, -75, -75, -74, -73, -72, -72, -72, -72, -71, & + -70, -70, -69, -69, -68, -67, -67, -67, -66, -65, & + -65, -64, -64, -63, -62, -62, -62, -61, -60, -60, & + -59, -59, -58, -57, -57, -56, -56, -55, -54, -54, & + -53, -53, -52, -51, -51, -50, -49, -49, -48, -47, & + -47, -46, -45, -45, -44, -43, -43, -42, -41, -41, & + -40, -39, -38, -38, -37, -36, -36, -35, -34, -33, & + -33, -32, -31, -30, -30, -29, -28, -27, -26, -26, & + -25, -24, -23, -22, -22, -21, -20, -19, -18, -17, & + -17, -16, -15, -14, -13, -12, -12, -11, -10, -9, & + -8, -7, -7, -6, -5, -4, -4, -3, -2, -2, & + -1, -1, -1, 0, 0, 1, 1, 1, 1, 2, & + 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, & + 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, & + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, & + 4, 4, 4, 4, 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, 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/ + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: WSPRcode "message"' + go to 999 + endif + call getarg(1,msg) !Get message from command line + write(*,1000) msg +1000 format('Message: ',a22) + + nbits=50+31 !User bits=50, constraint length=32 + nbytes=(nbits+7)/8 + ndelta=50 + limit=20000 + + data0=0 + call wqencode(msg,ntype0,data0) !Source encoding + write(*,1002) data0(1:7),data0(1:6),data0(7)/64 +1002 format(/'Source-encoded message, 50 bits:'/'Hex: ',7z3.2/ & + 'Binary: ',6b9.8,b3.2) + + call encode232(data0,nbytes,dat,MAXSYM) !Convolutional encoding + call inter_mept(dat,1) !Interleaving + + write(*,1004) +1004 format(/'Data symbols:') + write(*,1006) (dat(i),i=1,NSYM) +1006 format(5x,30i2) + + write(*,1008) +1008 format(/'Sync symbols:') + write(*,1006) (sync(i),i=1,NSYM) + + write(*,1010) +1010 format(/'Channel symbols:') + write(*,1006) (2*dat(i)+sync(i),i=1,NSYM) + + call inter_mept(dat,-1) !Remove interleaving + softsym=-dat !Simulate soft symbols + +! Call the sequential (Fano algorithm) decoder + call fano232(softsym,nbits,mettab,ndelta,limit,data1,ncycles,metric,nerr) + call wqdecode(data1,msg2,ntype1) + + write(*,1020) msg2,ntype1 +1020 format(/'Decoded message: ',a22,' ntype:',i3) + +999 end program wsprcode + +include 'wspr_old_subs.f90' + diff --git a/wsjtx_lib/lib/wsprd/Makefile b/wsjtx_lib/lib/wsprd/Makefile new file mode 100644 index 0000000..c8e1572 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/Makefile @@ -0,0 +1,39 @@ +CC = gcc +FC = gfortran + +CFLAGS= -I/usr/include -Wall -Wno-missing-braces -Wno-unused-result -O3 -ffast-math +LDFLAGS = -L/usr/lib +FFLAGS = -O2 -Wall -Wno-conversion +LIBS = -lfftw3f -lm -lgfortran + +# Default rules +%.o: %.c $(DEPS) + ${CC} ${CFLAGS} -c $< +%.o: %.f + ${FC} ${FFLAGS} -c $< +%.o: %.F + ${FC} ${FFLAGS} -c $< +%.o: %.f90 + ${FC} ${FFLAGS} -c $< +%.o: %.F90 + ${FC} ${FFLAGS} -c $< + +all: wsprd wsprsim + +DEPS = wsprsim_utils.h wsprd_utils.h fano.h jelinek.h nhash.h + +indexx.o: ../indexx.f90 + ${FC} -o indexx.o ${FFLAGS} -c ../indexx.f90 + +OBJS1 = wsprd.o wsprsim_utils.o wsprd_utils.o tab.o fano.o jelinek.o nhash.o indexx.o osdwspr.o + +wsprd: $(OBJS1) + $(CC) -o $@ $^ $(CFLAGS) $(LDFLAGS) $(LIBS) + +OBJS2 = wsprsim.o wsprsim_utils.o wsprd_utils.o tab.o fano.o nhash.o + +wsprsim: $(OBJS2) + $(CC) -o $@ $^ $(CFLAGS) $(LDFLAGS) $(LIBS) + +clean: + $(RM) *.o wsprd wsprsim diff --git a/wsjtx_lib/lib/wsprd/Makefile.MinGW b/wsjtx_lib/lib/wsprd/Makefile.MinGW new file mode 100644 index 0000000..d9fd6b8 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/Makefile.MinGW @@ -0,0 +1,30 @@ +CC = gcc +#CC = clang +FC = gfortran + +FFLAGS = -O2 -Wall -Wno-conversion +CFLAGS= -Wall -Wno-missing-braces -O2 +#LDFLAGS = -L/JTSDK/fftw3f +LIBS = c:/JTSDK/fftw3f/libfftw3-3.dll -lm + +# Default rules +%.o: %.c $(DEPS) + ${CC} ${CFLAGS} -c $< +%.o: %.f + ${FC} ${FFLAGS} -c $< +%.o: %.F + ${FC} ${FFLAGS} -c $< +%.o: %.f90 + ${FC} ${FFLAGS} -c $< +%.o: %.F90 + ${FC} ${FFLAGS} -c $< + +all: wsprd + +DEPS = fano.h +OBJS1 = wsprd.o wsprd_utils.o fano.o tab.o nhash.o +wsprd: $(OBJS1) + $(CC) -o $@ $^ $(CFLAGS) $(LDFLAGS) $(LIBS) + +clean: + rm *.o wsprd diff --git a/wsjtx_lib/lib/wsprd/Makefile.win32 b/wsjtx_lib/lib/wsprd/Makefile.win32 new file mode 100644 index 0000000..8d600d7 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/Makefile.win32 @@ -0,0 +1,40 @@ +CC = gcc +FC = gfortran + +FFLAGS = -O2 -Wall -Wno-conversion +CFLAGS= -I/JTSDK/fftw3f -Wall -Wno-missing-braces -O2 +#LDFLAGS = -L/JTSDK/fftw3f -Wl,--stack,4000000 +LDFLAGS = -L/JTSDK/fftw3f +LIBS = c:/JTSDK/fftw3f/libfftw3-3.dll -lm + +# Default rules +%.o: %.c $(DEPS) + ${CC} ${CFLAGS} -c $< +%.o: %.f + ${FC} ${FFLAGS} -c $< +%.o: %.F + ${FC} ${FFLAGS} -c $< +%.o: %.f90 + ${FC} ${FFLAGS} -c $< +%.o: %.F90 + ${FC} ${FFLAGS} -c $< + +all: wsprd.exe wsprsim.exe wsprd_exp.exe + +DEPS = wsprsim_utils.h wsprd_utils.h fano.h jelinek.h nhash.h + +OBJS1 = wsprd.o wsprsim_utils.o wsprd_utils.o tab.o fano.o jelinek.o nhash.o +wsprd.exe: $(OBJS1) + $(CC) -o $@ $^ $(CFLAGS) $(LDFLAGS) $(LIBS) + +OBJS2 = wsprsim.o wsprsim_utils.o wsprd_utils.o tab.o fano.o nhash.o +wsprsim.exe: $(OBJS2) + $(CC) -o $@ $^ $(CFLAGS) $(LDFLAGS) $(LIBS) + +OBJS3 = wsprd_exp.o wsprsim_utils.o wsprd_utils.o tab.o fano.o jelinek.o \ + nhash.o +wsprd_exp.exe: $(OBJS3) + $(CC) -o $@ $^ $(CFLAGS) $(LDFLAGS) $(LIBS) + +clean: + rm *.o wsprd.exe wsprsim.exe wsprd_exp.exe diff --git a/wsjtx_lib/lib/wsprd/README b/wsjtx_lib/lib/wsprd/README new file mode 100644 index 0000000..141c2fb --- /dev/null +++ b/wsjtx_lib/lib/wsprd/README @@ -0,0 +1,70 @@ +wsprd is a decoder for K1JT's Weak Signal Propagation Reporter (WSPR) mode. + +The program is written in C and is a command-line program that reads from a +.c2 file or .wav file and writes output to the console. It is used by WSJT-X +for wspr-mode decoding. + +USAGE: + wsprd [options...] infile + +OPTIONS: + -a path to writeable data files, default="." + -B disable block demodulation - use single-symbol noncoherent demod + -c write .c2 file at the end of the first pass + -C maximum number of decoder cycles per bit, default 10000 + -d deeper search. Slower, a few more decodes + -e x (x is transceiver dial frequency error in Hz) + -f x (x is transceiver dial frequency in MHz) + -H do not use (or update) the hash table + -J use the stack decoder instead of Fano decoder + -m decode wspr-15 .wav file + -o n (0<=n<=5), decoding depth for OSD, default is disabled + -q quick mode - doesn't dig deep for weak signals + -s single pass mode, no subtraction (same as original wsprd) + -v verbose mode (shows dupes) + -w wideband mode - decode signals within +/- 150 Hz of center + -z x (x is fano metric table bias, default is 0.45) + +infile can be either .wav or .c2 + +e.g. +./wsprd -wf 14.0956 140709_2258.wav + +Note that for .c2 files, the frequency within the file overrides the command +line value. + +FEATURES: +By default, wsprd reports signals that are within +/- 110 Hz of the +subband center frequency. The wideband option (-w) extends this to +/- 150 Hz. + +wsprd maintains a hashtable and will decode all three types of wspr +messages. An option (-H) is available to turn off use of the hashtable. + +Decoding is attempted using soft symbols derived using single-symbol +noncoherent detection. If decoding fails, then soft symbols derived using +block demodulation over 2- and 3-symbol blocks are used in subsequent +decoding attempts. For slower computers, block demodulation can be +disabled with the -B command line option. + +The symbols are decoded using Phil Karn's sequential decoder routine, +fano.c. The -J option replaces the Fano algorithm with the Jelinek +"stack-bucket" algorithm. If the -o command line option is enabled, then +an ordered-statistics decoder (OSD) is invoked if the Fano (or Jelinek) algorithm +fails. The OSD is a complete decoder, meaning that it always returns a codeword. +A returned codeword is considered valid only if the unpacked decode contains +a callsign that is already in the hashtable. + +NOTES: +This program attempts to maximize the number of successful decodes per transmit +interval by trying to decode virtually every peak in the averaged spectrum. +The program also implements two-pass decoding, whereby signals that are successfully +decoded are subtracted one-by-one during the first decoding pass. Then, the +decoder is run again. In many cases the subtraction process will uncover signals +that can then be successfully decoded on the second pass. + +There will be occasional duplicate decodes when two closely spaced +peaks come from the same signal. The program removes dupes based on callsign +and frequency. Two decodes that have the same callsign and estimated frequencies +that are within 1 Hz will be treated as decodes of the same signal. This +dupechecking is turned off with the -v flag. + diff --git a/wsjtx_lib/lib/wsprd/WSPRcode.f90 b/wsjtx_lib/lib/wsprd/WSPRcode.f90 new file mode 100644 index 0000000..a34345d --- /dev/null +++ b/wsjtx_lib/lib/wsprd/WSPRcode.f90 @@ -0,0 +1,132 @@ +program wsprcode + +! This program provides examples of the source encoding, convolutional +! error-control coding, bit and symbol ordering, and synchronizing +! information contained in WSPR messages. + + parameter (NSYM=162) + parameter (MAXSYM=176) + character*22 msg,msg2 + integer*1 data0(7) + integer*1 data1(7) + integer*1 dat(NSYM) + integer*1 softsym(NSYM) + +! Define the sync vector: + integer*1 sync(NSYM) + 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/ + +! Metric table for decoding from soft symbols + integer mettab(0:255,0:1) + data mettab/ & + 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, 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, 4, 4, 4, 4, 4, 4, 4, & + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, & + 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, & + 2, 2, 2, 2, 1, 1, 1, 1, 0, 0, & + -1, -1, -1, -2, -2, -3, -4, -4, -5, -6, & + -7, -7, -8, -9, -10, -11, -12, -12, -13, -14, & + -15, -16, -17, -17, -18, -19, -20, -21, -22, -22, & + -23, -24, -25, -26, -26, -27, -28, -29, -30, -30, & + -31, -32, -33, -33, -34, -35, -36, -36, -37, -38, & + -38, -39, -40, -41, -41, -42, -43, -43, -44, -45, & + -45, -46, -47, -47, -48, -49, -49, -50, -51, -51, & + -52, -53, -53, -54, -54, -55, -56, -56, -57, -57, & + -58, -59, -59, -60, -60, -61, -62, -62, -62, -63, & + -64, -64, -65, -65, -66, -67, -67, -67, -68, -69, & + -69, -70, -70, -71, -72, -72, -72, -72, -73, -74, & + -75, -75, -75, -77, -76, -76, -78, -78, -80, -81, & + -80, -79, -83, -82, -81, -82, -82, -83, -84, -84, & + -84, -87, -86, -87, -88, -89, -89, -89, -88, -87, & + -86, -87, -84, -84, -84, -83, -82, -82, -81, -82, & + -83, -79, -80, -81, -80, -78, -78, -76, -76, -77, & + -75, -75, -75, -74, -73, -72, -72, -72, -72, -71, & + -70, -70, -69, -69, -68, -67, -67, -67, -66, -65, & + -65, -64, -64, -63, -62, -62, -62, -61, -60, -60, & + -59, -59, -58, -57, -57, -56, -56, -55, -54, -54, & + -53, -53, -52, -51, -51, -50, -49, -49, -48, -47, & + -47, -46, -45, -45, -44, -43, -43, -42, -41, -41, & + -40, -39, -38, -38, -37, -36, -36, -35, -34, -33, & + -33, -32, -31, -30, -30, -29, -28, -27, -26, -26, & + -25, -24, -23, -22, -22, -21, -20, -19, -18, -17, & + -17, -16, -15, -14, -13, -12, -12, -11, -10, -9, & + -8, -7, -7, -6, -5, -4, -4, -3, -2, -2, & + -1, -1, -1, 0, 0, 1, 1, 1, 1, 2, & + 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, & + 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, & + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, & + 4, 4, 4, 4, 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, 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/ + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: WSPRcode "message"' + go to 999 + endif + call getarg(1,msg) !Get message from command line + write(*,1000) msg +1000 format('Message: ',a22) + + nbits=50+31 !User bits=50, constraint length=32 + nbytes=(nbits+7)/8 + ndelta=50 + limit=20000 + + data0=0 + call wqencode(msg,ntype0,data0) !Source encoding + write(*,1002) data0 +1002 format(/'Source-encoded message (50 bits, hex):',7z3.2) + + call encode232(data0,nbytes,dat,MAXSYM) !Convolutional encoding + call inter_mept(dat,1) !Interleaving + + write(*,1004) +1004 format(/'Data symbols:') + write(*,1006) (dat(i),i=1,NSYM) +1006 format(5x,30i2) + + write(*,1008) +1008 format(/'Sync symbols:') + write(*,1006) (sync(i),i=1,NSYM) + + write(*,1010) +1010 format(/'Channel symbols:') + write(*,1006) (2*dat(i)+sync(i),i=1,NSYM) + + call inter_mept(dat,-1) !Remove interleaving + softsym=-dat !Simulate soft symbols + +! Call the sequential (Fano algorithm) decoder + call fano232(softsym,nbits,mettab,ndelta,limit,data1,ncycles,metric,nerr) + call wqdecode(data1,msg2,ntype1) + + write(*,1020) ntype1 +1020 format(/'Message type: ',i7) + write(*,1030) msg2 +1030 format('Decoded message: ',a22) + +999 end program wsprcode diff --git a/wsjtx_lib/lib/wsprd/fano.c b/wsjtx_lib/lib/wsprd/fano.c new file mode 100644 index 0000000..8fe1a64 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/fano.c @@ -0,0 +1,239 @@ +/* + This file is part of wsprd. + + File name: fano.c + + Description: Soft decision Fano sequential decoder for K=32 r=1/2 + convolutional code. + + Copyright 1994, Phil Karn, KA9Q + Minor modifications by Joe Taylor, K1JT +*/ + +#define LL 1 // Select Layland-Lushbaugh code +#include +#include +#include +#include "fano.h" + +struct node { + unsigned long encstate; // Encoder state of next node + long gamma; // Cumulative metric to this node + int metrics[4]; // Metrics indexed by all possible tx syms + int tm[2]; // Sorted metrics for current hypotheses + int i; // Current branch being tested +}; + +// Convolutional coding polynomials. All are rate 1/2, K=32 +#ifdef NASA_STANDARD +/* "NASA standard" code by Massey & Costello + * Nonsystematic, quick look-in, dmin=11, dfree=23 + * used on Pioneer 10-12, Helios A,B + */ +#define POLY1 0xbbef6bb7 +#define POLY2 0xbbef6bb5 +#endif + +#ifdef MJ +/* Massey-Johannesson code + * Nonsystematic, quick look-in, dmin=13, dfree>=23 + * Purported to be more computationally efficient than Massey-Costello + */ +#define POLY1 0xb840a20f +#define POLY2 0xb840a20d +#endif + +#ifdef LL +/* Layland-Lushbaugh code + * Nonsystematic, non-quick look-in, dmin=?, dfree=? + */ +#define POLY1 0xf2d05351 +#define POLY2 0xe4613c47 +#endif + +/* Convolutionally encode a packet. The input data bytes are read + * high bit first and the encoded packet is written into 'symbols', + * one symbol per byte. The first symbol is generated from POLY1, + * the second from POLY2. + * + * Storing only one symbol per byte uses more space, but it is faster + * and easier than trying to pack them more compactly. + */ +int encode( + unsigned char *symbols, // Output buffer, 2*nbytes*8 + unsigned char *data, // Input buffer, nbytes + unsigned int nbytes) // Number of bytes in data +{ + unsigned long encstate; + int sym; + int i; + + encstate = 0; + while(nbytes-- != 0) { + for(i=7;i>=0;i--) { + encstate = (encstate << 1) | ((*data >> i) & 1); + ENCODE(sym,encstate); + *symbols++ = sym >> 1; + *symbols++ = sym & 1; + } + data++; + } + return 0; +} + +/* Decode packet with the Fano algorithm. + * Return 0 on success, -1 on timeout + */ +int fano( + unsigned int *metric, // Final path metric (returned value) + unsigned int *cycles, // Cycle count (returned value) + unsigned int *maxnp, // Progress before timeout (returned value) + unsigned char *data, // Decoded output data + unsigned char *symbols, // Raw deinterleaved input symbols + unsigned int nbits, // Number of output bits + int mettab[2][256], // Metric table, [sent sym][rx symbol] + int delta, // Threshold adjust parameter + unsigned int maxcycles) // Decoding timeout in cycles per bit +{ + struct node *nodes; // First node + struct node *np; // Current node + struct node *lastnode; // Last node + struct node *tail; // First node of tail + int t; // Threshold + int m0,m1; + int ngamma; + unsigned int lsym; + unsigned int i; + + if((nodes = (struct node *)malloc((nbits+1)*sizeof(struct node))) == NULL) { + printf("malloc failed\n"); + return 0; + } + lastnode = &nodes[nbits-1]; + tail = &nodes[nbits-31]; + *maxnp = 0; + +/* Compute all possible branch metrics for each symbol pair + * This is the only place we actually look at the raw input symbols + */ + for(np=nodes;np <= lastnode;np++) { + np->metrics[0] = mettab[0][symbols[0]] + mettab[0][symbols[1]]; + np->metrics[1] = mettab[0][symbols[0]] + mettab[1][symbols[1]]; + np->metrics[2] = mettab[1][symbols[0]] + mettab[0][symbols[1]]; + np->metrics[3] = mettab[1][symbols[0]] + mettab[1][symbols[1]]; + symbols += 2; + } + np = nodes; + np->encstate = 0; + +// Compute and sort branch metrics from root node */ + ENCODE(lsym,np->encstate); // 0-branch (LSB is 0) + m0 = np->metrics[lsym]; + +/* Now do the 1-branch. To save another ENCODE call here and + * inside the loop, we assume that both polynomials are odd, + * providing complementary pairs of branch symbols. + + * This code should be modified if a systematic code were used. + */ + + m1 = np->metrics[3^lsym]; + if(m0 > m1) { + np->tm[0] = m0; // 0-branch has better metric + np->tm[1] = m1; + } else { + np->tm[0] = m1; // 1-branch is better + np->tm[1] = m0; + np->encstate++; // Set low bit + } + np->i = 0; // Start with best branch + maxcycles *= nbits; + np->gamma = t = 0; + + // Start the Fano decoder + for(i=1;i <= maxcycles;i++) { + if((int)(np-nodes) > (int)*maxnp) *maxnp=(int)(np-nodes); +#ifdef debug + printf("k=%ld, g=%ld, t=%d, m[%d]=%d, maxnp=%d, encstate=%lx\n", + np-nodes,np->gamma,t,np->i,np->tm[np->i],*maxnp,np->encstate); +#endif +// Look forward */ + ngamma = np->gamma + np->tm[np->i]; + if(ngamma >= t) { + if(np->gamma < t + delta) { // Node is acceptable + /* First time we've visited this node; + * Tighten threshold. + * + * This loop could be replaced with + * t += delta * ((ngamma - t)/delta); + * but the multiply and divide are slower. + */ + while(ngamma >= t + delta) t += delta; + } + np[1].gamma = ngamma; // Move forward + np[1].encstate = np->encstate << 1; + if( ++np == (lastnode+1) ) { + break; // Done! + } + + /* Compute and sort metrics, starting with the + * zero branch + */ + ENCODE(lsym,np->encstate); + if(np >= tail) { + /* The tail must be all zeroes, so don't + * bother computing the 1-branches here. + */ + np->tm[0] = np->metrics[lsym]; + } else { + m0 = np->metrics[lsym]; + m1 = np->metrics[3^lsym]; + if(m0 > m1) { + np->tm[0] = m0; // 0-branch is better + np->tm[1] = m1; + } else { + np->tm[0] = m1; // 1-branch is better + np->tm[1] = m0; + np->encstate++; // Set low bit + } + } + np->i = 0; // Start with best branch + continue; + } + // Threshold violated, can't go forward + for(;;) { // Look backward + if(np == nodes || np[-1].gamma < t) { + /* Can't back up either. + * Relax threshold and and look + * forward again to better branch. + */ + t -= delta; + if(np->i != 0) { + np->i = 0; + np->encstate ^= 1; + } + break; + } + // Back up + if(--np < tail && np->i != 1) { + np->i++; // Search next best branch + np->encstate ^= 1; + break; + } // else keep looking back + } + } + *metric = np->gamma; // Return the final path metric + + // Copy decoded data to user's buffer + nbits >>= 3; + np = &nodes[7]; + while(nbits-- != 0) { + *data++ = np->encstate; + np += 8; + } + *cycles = i+1; + + free(nodes); + if(i >= maxcycles) return -1; // Decoder timed out + return 0; // Successful completion +} diff --git a/wsjtx_lib/lib/wsprd/fano.h b/wsjtx_lib/lib/wsprd/fano.h new file mode 100644 index 0000000..3290a09 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/fano.h @@ -0,0 +1,39 @@ +/* + This file is part of wsprd. + + File name: fano.h + + Description: Header file for sequential Fano decoder. + + Copyright 1994, Phil Karn, KA9Q + Minor modifications by Joe Taylor, K1JT +*/ + +#ifndef FANO_H +#define FANO_H + +int fano(unsigned int *metric, unsigned int *cycles, unsigned int *maxnp, + unsigned char *data,unsigned char *symbols, unsigned int nbits, + int mettab[2][256],int delta,unsigned int maxcycles); + +int encode(unsigned char *symbols,unsigned char *data,unsigned int nbytes); + +extern unsigned char Partab[]; + +/* Convolutional encoder macro. Takes the encoder state, generates + * a rate 1/2 symbol pair and stores it in 'sym'. The symbol generated from + * POLY1 goes into the 2-bit of sym, and the symbol generated from POLY2 + * goes into the 1-bit. + */ +#define ENCODE(sym,encstate){\ +unsigned long _tmp;\ +\ +_tmp = (encstate) & POLY1;\ +_tmp ^= _tmp >> 16;\ +(sym) = Partab[(_tmp ^ (_tmp >> 8)) & 0xff] << 1;\ +_tmp = (encstate) & POLY2;\ +_tmp ^= _tmp >> 16;\ +(sym) |= Partab[(_tmp ^ (_tmp >> 8)) & 0xff];\ +} + +#endif diff --git a/wsjtx_lib/lib/wsprd/fftw3.h b/wsjtx_lib/lib/wsprd/fftw3.h new file mode 100644 index 0000000..58a2c73 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/fftw3.h @@ -0,0 +1,410 @@ +/* + * Copyright (c) 2003, 2007-11 Matteo Frigo + * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology + * + * The following statement of license applies *only* to this header file, + * and *not* to the other files distributed with FFTW or derived therefrom: + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS + * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY + * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE + * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/***************************** NOTE TO USERS ********************************* + * + * THIS IS A HEADER FILE, NOT A MANUAL + * + * If you want to know how to use FFTW, please read the manual, + * online at http://www.fftw.org/doc/ and also included with FFTW. + * For a quick start, see the manual's tutorial section. + * + * (Reading header files to learn how to use a library is a habit + * stemming from code lacking a proper manual. Arguably, it's a + * *bad* habit in most cases, because header files can contain + * interfaces that are not part of the public, stable API.) + * + ****************************************************************************/ + +#ifndef FFTW3_H +#define FFTW3_H + +#include + +#ifdef __cplusplus +extern "C" +{ +#endif /* __cplusplus */ + +/* If is included, use the C99 complex type. Otherwise + define a type bit-compatible with C99 complex */ +#if !defined(FFTW_NO_Complex) && defined(_Complex_I) && defined(complex) && defined(I) +# define FFTW_DEFINE_COMPLEX(R, C) typedef R _Complex C +#else +# define FFTW_DEFINE_COMPLEX(R, C) typedef R C[2] +#endif + +#define FFTW_CONCAT(prefix, name) prefix ## name +#define FFTW_MANGLE_DOUBLE(name) FFTW_CONCAT(fftw_, name) +#define FFTW_MANGLE_FLOAT(name) FFTW_CONCAT(fftwf_, name) +#define FFTW_MANGLE_LONG_DOUBLE(name) FFTW_CONCAT(fftwl_, name) +#define FFTW_MANGLE_QUAD(name) FFTW_CONCAT(fftwq_, name) + +/* IMPORTANT: for Windows compilers, you should add a line + #define FFTW_DLL + here and in kernel/ifftw.h if you are compiling/using FFTW as a + DLL, in order to do the proper importing/exporting, or + alternatively compile with -DFFTW_DLL or the equivalent + command-line flag. This is not necessary under MinGW/Cygwin, where + libtool does the imports/exports automatically. */ +#if defined(FFTW_DLL) && (defined(_WIN32) || defined(__WIN32__)) + /* annoying Windows syntax for shared-library declarations */ +# if defined(COMPILING_FFTW) /* defined in api.h when compiling FFTW */ +# define FFTW_EXTERN extern __declspec(dllexport) +# else /* user is calling FFTW; import symbol */ +# define FFTW_EXTERN extern __declspec(dllimport) +# endif +#else +# define FFTW_EXTERN extern +#endif + +enum fftw_r2r_kind_do_not_use_me { + FFTW_R2HC=0, FFTW_HC2R=1, FFTW_DHT=2, + FFTW_REDFT00=3, FFTW_REDFT01=4, FFTW_REDFT10=5, FFTW_REDFT11=6, + FFTW_RODFT00=7, FFTW_RODFT01=8, FFTW_RODFT10=9, FFTW_RODFT11=10 +}; + +struct fftw_iodim_do_not_use_me { + int n; /* dimension size */ + int is; /* input stride */ + int os; /* output stride */ +}; + +#include /* for ptrdiff_t */ +struct fftw_iodim64_do_not_use_me { + ptrdiff_t n; /* dimension size */ + ptrdiff_t is; /* input stride */ + ptrdiff_t os; /* output stride */ +}; + +typedef void (*fftw_write_char_func_do_not_use_me)(char c, void *); +typedef int (*fftw_read_char_func_do_not_use_me)(void *); + +/* + huge second-order macro that defines prototypes for all API + functions. We expand this macro for each supported precision + + X: name-mangling macro + R: real data type + C: complex data type +*/ + +#define FFTW_DEFINE_API(X, R, C) \ + \ +FFTW_DEFINE_COMPLEX(R, C); \ + \ +typedef struct X(plan_s) *X(plan); \ + \ +typedef struct fftw_iodim_do_not_use_me X(iodim); \ +typedef struct fftw_iodim64_do_not_use_me X(iodim64); \ + \ +typedef enum fftw_r2r_kind_do_not_use_me X(r2r_kind); \ + \ +typedef fftw_write_char_func_do_not_use_me X(write_char_func); \ +typedef fftw_read_char_func_do_not_use_me X(read_char_func); \ + \ +FFTW_EXTERN void X(execute)(const X(plan) p); \ + \ +FFTW_EXTERN X(plan) X(plan_dft)(int rank, const int *n, \ + C *in, C *out, int sign, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_dft_1d)(int n, C *in, C *out, int sign, \ + unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_dft_2d)(int n0, int n1, \ + C *in, C *out, int sign, unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_dft_3d)(int n0, int n1, int n2, \ + C *in, C *out, int sign, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_many_dft)(int rank, const int *n, \ + int howmany, \ + C *in, const int *inembed, \ + int istride, int idist, \ + C *out, const int *onembed, \ + int ostride, int odist, \ + int sign, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru_dft)(int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + C *in, C *out, \ + int sign, unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_guru_split_dft)(int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + R *ri, R *ii, R *ro, R *io, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru64_dft)(int rank, \ + const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + C *in, C *out, \ + int sign, unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_guru64_split_dft)(int rank, \ + const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + R *ri, R *ii, R *ro, R *io, \ + unsigned flags); \ + \ +FFTW_EXTERN void X(execute_dft)(const X(plan) p, C *in, C *out); \ +FFTW_EXTERN void X(execute_split_dft)(const X(plan) p, R *ri, R *ii, \ + R *ro, R *io); \ + \ +FFTW_EXTERN X(plan) X(plan_many_dft_r2c)(int rank, const int *n, \ + int howmany, \ + R *in, const int *inembed, \ + int istride, int idist, \ + C *out, const int *onembed, \ + int ostride, int odist, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_dft_r2c)(int rank, const int *n, \ + R *in, C *out, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_dft_r2c_1d)(int n,R *in,C *out,unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_dft_r2c_2d)(int n0, int n1, \ + R *in, C *out, unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_dft_r2c_3d)(int n0, int n1, \ + int n2, \ + R *in, C *out, unsigned flags); \ + \ + \ +FFTW_EXTERN X(plan) X(plan_many_dft_c2r)(int rank, const int *n, \ + int howmany, \ + C *in, const int *inembed, \ + int istride, int idist, \ + R *out, const int *onembed, \ + int ostride, int odist, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_dft_c2r)(int rank, const int *n, \ + C *in, R *out, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_dft_c2r_1d)(int n,C *in,R *out,unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_dft_c2r_2d)(int n0, int n1, \ + C *in, R *out, unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_dft_c2r_3d)(int n0, int n1, \ + int n2, \ + C *in, R *out, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru_dft_r2c)(int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + R *in, C *out, \ + unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_guru_dft_c2r)(int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + C *in, R *out, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru_split_dft_r2c)( \ + int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + R *in, R *ro, R *io, \ + unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_guru_split_dft_c2r)( \ + int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + R *ri, R *ii, R *out, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru64_dft_r2c)(int rank, \ + const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + R *in, C *out, \ + unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_guru64_dft_c2r)(int rank, \ + const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + C *in, R *out, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru64_split_dft_r2c)( \ + int rank, const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + R *in, R *ro, R *io, \ + unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_guru64_split_dft_c2r)( \ + int rank, const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + R *ri, R *ii, R *out, \ + unsigned flags); \ + \ +FFTW_EXTERN void X(execute_dft_r2c)(const X(plan) p, R *in, C *out); \ +FFTW_EXTERN void X(execute_dft_c2r)(const X(plan) p, C *in, R *out); \ + \ +FFTW_EXTERN void X(execute_split_dft_r2c)(const X(plan) p, \ + R *in, R *ro, R *io); \ +FFTW_EXTERN void X(execute_split_dft_c2r)(const X(plan) p, \ + R *ri, R *ii, R *out); \ + \ +FFTW_EXTERN X(plan) X(plan_many_r2r)(int rank, const int *n, \ + int howmany, \ + R *in, const int *inembed, \ + int istride, int idist, \ + R *out, const int *onembed, \ + int ostride, int odist, \ + const X(r2r_kind) *kind, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_r2r)(int rank, const int *n, R *in, R *out, \ + const X(r2r_kind) *kind, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_r2r_1d)(int n, R *in, R *out, \ + X(r2r_kind) kind, unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_r2r_2d)(int n0, int n1, R *in, R *out, \ + X(r2r_kind) kind0, X(r2r_kind) kind1, \ + unsigned flags); \ +FFTW_EXTERN X(plan) X(plan_r2r_3d)(int n0, int n1, int n2, \ + R *in, R *out, X(r2r_kind) kind0, \ + X(r2r_kind) kind1, X(r2r_kind) kind2, \ + unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru_r2r)(int rank, const X(iodim) *dims, \ + int howmany_rank, \ + const X(iodim) *howmany_dims, \ + R *in, R *out, \ + const X(r2r_kind) *kind, unsigned flags); \ + \ +FFTW_EXTERN X(plan) X(plan_guru64_r2r)(int rank, const X(iodim64) *dims, \ + int howmany_rank, \ + const X(iodim64) *howmany_dims, \ + R *in, R *out, \ + const X(r2r_kind) *kind, unsigned flags); \ + \ +FFTW_EXTERN void X(execute_r2r)(const X(plan) p, R *in, R *out); \ + \ +FFTW_EXTERN void X(destroy_plan)(X(plan) p); \ +FFTW_EXTERN void X(forget_wisdom)(void); \ +FFTW_EXTERN void X(cleanup)(void); \ + \ +FFTW_EXTERN void X(set_timelimit)(double t); \ + \ +FFTW_EXTERN void X(plan_with_nthreads)(int nthreads); \ +FFTW_EXTERN int X(init_threads)(void); \ +FFTW_EXTERN void X(cleanup_threads)(void); \ + \ +FFTW_EXTERN int X(export_wisdom_to_filename)(const char *filename); \ +FFTW_EXTERN void X(export_wisdom_to_file)(FILE *output_file); \ +FFTW_EXTERN char *X(export_wisdom_to_string)(void); \ +FFTW_EXTERN void X(export_wisdom)(X(write_char_func) write_char, \ + void *data); \ +FFTW_EXTERN int X(import_system_wisdom)(void); \ +FFTW_EXTERN int X(import_wisdom_from_filename)(const char *filename); \ +FFTW_EXTERN int X(import_wisdom_from_file)(FILE *input_file); \ +FFTW_EXTERN int X(import_wisdom_from_string)(const char *input_string); \ +FFTW_EXTERN int X(import_wisdom)(X(read_char_func) read_char, void *data); \ + \ +FFTW_EXTERN void X(fprint_plan)(const X(plan) p, FILE *output_file); \ +FFTW_EXTERN void X(print_plan)(const X(plan) p); \ + \ +FFTW_EXTERN void *X(malloc)(size_t n); \ +FFTW_EXTERN R *X(alloc_real)(size_t n); \ +FFTW_EXTERN C *X(alloc_complex)(size_t n); \ +FFTW_EXTERN void X(free)(void *p); \ + \ +FFTW_EXTERN void X(flops)(const X(plan) p, \ + double *add, double *mul, double *fmas); \ +FFTW_EXTERN double X(estimate_cost)(const X(plan) p); \ +FFTW_EXTERN double X(cost)(const X(plan) p); \ + \ +FFTW_EXTERN const char X(version)[]; \ +FFTW_EXTERN const char X(cc)[]; \ +FFTW_EXTERN const char X(codelet_optim)[]; + + +/* end of FFTW_DEFINE_API macro */ + +FFTW_DEFINE_API(FFTW_MANGLE_DOUBLE, double, fftw_complex) +FFTW_DEFINE_API(FFTW_MANGLE_FLOAT, float, fftwf_complex) +FFTW_DEFINE_API(FFTW_MANGLE_LONG_DOUBLE, long double, fftwl_complex) + +/* __float128 (quad precision) is a gcc extension on i386, x86_64, and ia64 + for gcc >= 4.6 (compiled in FFTW with --enable-quad-precision) */ +#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 6)) \ + && !(defined(__ICC) || defined(__INTEL_COMPILER)) \ + && (defined(__i386__) || defined(__x86_64__) || defined(__ia64__)) +# if !defined(FFTW_NO_Complex) && defined(_Complex_I) && defined(complex) && defined(I) +/* note: __float128 is a typedef, which is not supported with the _Complex + keyword in gcc, so instead we use this ugly __attribute__ version. + However, we can't simply pass the __attribute__ version to + FFTW_DEFINE_API because the __attribute__ confuses gcc in pointer + types. Hence redefining FFTW_DEFINE_COMPLEX. Ugh. */ +# undef FFTW_DEFINE_COMPLEX +# define FFTW_DEFINE_COMPLEX(R, C) typedef _Complex float __attribute__((mode(TC))) C +# endif +FFTW_DEFINE_API(FFTW_MANGLE_QUAD, __float128, fftwq_complex) +#endif + +#define FFTW_FORWARD (-1) +#define FFTW_BACKWARD (+1) + +#define FFTW_NO_TIMELIMIT (-1.0) + +/* documented flags */ +#define FFTW_MEASURE (0U) +#define FFTW_DESTROY_INPUT (1U << 0) +#define FFTW_UNALIGNED (1U << 1) +#define FFTW_CONSERVE_MEMORY (1U << 2) +#define FFTW_EXHAUSTIVE (1U << 3) /* NO_EXHAUSTIVE is default */ +#define FFTW_PRESERVE_INPUT (1U << 4) /* cancels FFTW_DESTROY_INPUT */ +#define FFTW_PATIENT (1U << 5) /* IMPATIENT is default */ +#define FFTW_ESTIMATE (1U << 6) +#define FFTW_WISDOM_ONLY (1U << 21) + +/* undocumented beyond-guru flags */ +#define FFTW_ESTIMATE_PATIENT (1U << 7) +#define FFTW_BELIEVE_PCOST (1U << 8) +#define FFTW_NO_DFT_R2HC (1U << 9) +#define FFTW_NO_NONTHREADED (1U << 10) +#define FFTW_NO_BUFFERING (1U << 11) +#define FFTW_NO_INDIRECT_OP (1U << 12) +#define FFTW_ALLOW_LARGE_GENERIC (1U << 13) /* NO_LARGE_GENERIC is default */ +#define FFTW_NO_RANK_SPLITS (1U << 14) +#define FFTW_NO_VRANK_SPLITS (1U << 15) +#define FFTW_NO_VRECURSE (1U << 16) +#define FFTW_NO_SIMD (1U << 17) +#define FFTW_NO_SLOW (1U << 18) +#define FFTW_NO_FIXED_RADIX_LARGE_N (1U << 19) +#define FFTW_ALLOW_PRUNING (1U << 20) + +#ifdef __cplusplus +} /* extern "C" */ +#endif /* __cplusplus */ + +#endif /* FFTW3_H */ diff --git a/wsjtx_lib/lib/wsprd/genmet.f90 b/wsjtx_lib/lib/wsprd/genmet.f90 new file mode 100644 index 0000000..e5dcdab --- /dev/null +++ b/wsjtx_lib/lib/wsprd/genmet.f90 @@ -0,0 +1,50 @@ +program genmet + + character*12 arg + integer hist(-128:128) + lim(x)=min(127,max(-128,nint(scale*x))) + + nargs=iargc() + if(nargs.ne.4) then + print*,'Usage: genmet bw scale snr iters' + print*,'Example: genmet 1.46 20 -24 1000000' + go to 999 + endif + call getarg(1,arg) + read(arg,*) bw + call getarg(2,arg) + read(arg,*) scale + call getarg(3,arg) + read(arg,*) snr + call getarg(4,arg) + read(arg,*) iters + + hist=0 + s=sqrt(2500.0/bw) * 10.0**(0.05*snr) + fac=1.0/sqrt(2.0) + do iter=1,iters + x1=fac*gran() + y1=fac*gran() + x0=fac*gran() + y0=fac*gran() + r=(x1+s)**2 + y1*y1 - x0*x0 - y0*y0 + hist(lim(r))=hist(lim(r))+1 + enddo + + xln2=log(2.0) + do i=-128,127 + p1=hist(i)/dfloat(iters) + j=-i + if(j.gt.127) j=127 + p0=hist(j)/dfloat(iters) + xlhd0=log(max(0.001,2.0*p0/(p0+p1)))/xln2 + xlhd1=log(max(0.001,2.0*p1/(p0+p1)))/xln2 + write(13,1010) i/scale,hist(i)/dfloat(iters) +1010 format(f8.3,f12.9) + write(14,1012) i+128,xlhd0,xlhd1 +1012 format(i4,2f8.3) + enddo + +999 end program genmet + + diff --git a/wsjtx_lib/lib/wsprd/gran.c b/wsjtx_lib/lib/wsprd/gran.c new file mode 100644 index 0000000..24b9865 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/gran.c @@ -0,0 +1,28 @@ +#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/wsjtx_lib/lib/wsprd/jelinek.c b/wsjtx_lib/lib/wsprd/jelinek.c new file mode 100644 index 0000000..8fe0d2f --- /dev/null +++ b/wsjtx_lib/lib/wsprd/jelinek.c @@ -0,0 +1,163 @@ +/* + Soft-decision stack-based sequential decoder for K=32 r=1/2 + convolutional code. This code implements the "stack-bucket" algorithm + described in: + "Fast Sequential Decoding Algorithm Using a Stack", F. Jelinek + + The ENCODE macro from Phil Karn's (KA9Q) Fano decoder is used. + + Written by Steve Franke, K9AN for WSJT-X (July 2015) + */ + +#include "jelinek.h" + +#include +#include +#include +#include /* memset */ + +#include "fano.h" + +/* WSPR uses the Layland-Lushbaugh code + * Nonsystematic, non-quick look-in, dmin=?, dfree=? + */ +#define POLY1 0xf2d05351 +#define POLY2 0xe4613c47 + +//Decoder - returns 0 on success, -1 on timeout +int jelinek( + unsigned int *metric, /* Final path metric (returned value) */ + unsigned int *cycles, /* Cycle count (returned value) */ + unsigned char *data, /* Decoded output data */ + unsigned char *symbols, /* Raw deinterleaved input symbols */ + unsigned int nbits, /* Number of output bits */ + unsigned int stacksize, + struct snode *stack, + int mettab[2][256], /* Metric table, [sent sym][rx symbol] */ + unsigned int maxcycles)/* Decoding timeout in cycles per bit */ +{ + + // Compute branch metrics for each symbol pair + // The sequential decoding algorithm only uses the metrics, not the + // symbol values. + unsigned int i; + long int metrics[81][4]; + for(i=0; i>5)+200; //fast, but not particularly safe - totmet can be negative + if( bucket > high_bucket ) high_bucket=bucket; + if( bucket < low_bucket ) low_bucket=bucket; + + // place the 0 node on the stack, overwriting the parent (current) node + stack[ptr].encstate=encstate; + stack[ptr].gamma=totmet0; + stack[ptr].depth=depth; + stack[ptr].jpointer=buckets[bucket]; + buckets[bucket]=ptr; + + // if in the tail, only need to evaluate the "0" branch. + // Otherwise, enter this "if" and place the 1 node on the stack, + if( depth <= nbits_minus_ntail ) { + if( stackptr < stacksize_minus_1 ) { + stackptr++; + ptr=stackptr; + } else { // stack full + while( buckets[low_bucket] == 0 ) { //write latest to where the top of the lowest bucket points + low_bucket++; + } + ptr=buckets[low_bucket]; + buckets[low_bucket]=stack[ptr].jpointer; //make bucket point to next older entry + } + + bucket=(totmet1>>5)+200; //this may not be safe on all compilers + if( bucket > high_bucket ) high_bucket=bucket; + if( bucket < low_bucket ) low_bucket=bucket; + + stack[ptr].encstate=encstate+1; + stack[ptr].gamma=totmet1; + stack[ptr].depth=depth; + stack[ptr].jpointer=buckets[bucket]; + buckets[bucket]=ptr; + } + + // pick off the latest entry from the high bucket + while( buckets[high_bucket] == 0 ) { + high_bucket--; + } + ptr=buckets[high_bucket]; + buckets[high_bucket]=stack[ptr].jpointer; + depth=stack[ptr].depth; + gamma=stack[ptr].gamma; + encstate=stack[ptr].encstate; + + // we are done if the top entry on the stack is at depth nbits + if (depth == nbits) { + break; + } + } + + *cycles = i+1; + *metric = gamma; /* Return final path metric */ + + // printf("cycles %d stackptr=%d, depth=%d, gamma=%d, encstate=%lx\n", + // *cycles, stackptr, depth, *metric, encstate); + + for (i=0; i<7; i++) { + data[i]=(encstate>>(48-i*8))&(0x00000000000000ff); + } + for (i=7; i<11; i++) { + data[i]=0; + } + + if(*cycles/nbits >= maxcycles) //timed out + { + return -1; + } + return 0; //success +} diff --git a/wsjtx_lib/lib/wsprd/jelinek.h b/wsjtx_lib/lib/wsprd/jelinek.h new file mode 100644 index 0000000..82ce1de --- /dev/null +++ b/wsjtx_lib/lib/wsprd/jelinek.h @@ -0,0 +1,24 @@ +#ifndef JELINEK_H +#define JELINEK_H + +#include + +struct snode { + uint64_t encstate; // Encoder state + int gamma; // Cumulative metric to this node + unsigned int depth; // depth of this node + unsigned int jpointer; +}; + +int jelinek(unsigned int *metric, + unsigned int *cycles, + unsigned char *data, + unsigned char *symbols, + unsigned int nbits, + unsigned int stacksize, + struct snode *stack, + int mettab[2][256], + unsigned int maxcycles); + +#endif + diff --git a/wsjtx_lib/lib/wsprd/metric_tables.c b/wsjtx_lib/lib/wsprd/metric_tables.c new file mode 100644 index 0000000..973651d --- /dev/null +++ b/wsjtx_lib/lib/wsprd/metric_tables.c @@ -0,0 +1,138 @@ +/******************************************************************************* +* 4 metric tables calculated via simulation for 2-FSK with Es/No=0,3,6,9 dB +* tables were calculated for constant rms noise level of 50. The symbol vector +* should be normalized to have rms amplitude equal to "symbol_scale". +********************************************************************************/ +//float symbol_scale[5]={42.6, 53.3, 72.7, 100.2, 125.4}; +float metric_tables[5][256]={ + {0.9782, 0.9695, 0.9689, 0.9669, 0.9666, 0.9653, 0.9638, 0.9618, 0.9599, 0.9601, + 0.9592, 0.9570, 0.9556, 0.9540, 0.9525, 0.9527, 0.9486, 0.9477, 0.9450, 0.9436, + 0.9424, 0.9400, 0.9381, 0.9360, 0.9340, 0.9316, 0.9301, 0.9272, 0.9254, 0.9224, + 0.9196, 0.9171, 0.9154, 0.9123, 0.9076, 0.9061, 0.9030, 0.9000, 0.8965, 0.8934, + 0.8903, 0.8874, 0.8834, 0.8792, 0.8760, 0.8726, 0.8685, 0.8639, 0.8599, 0.8550, + 0.8504, 0.8459, 0.8422, 0.8364, 0.8320, 0.8262, 0.8215, 0.8159, 0.8111, 0.8052, + 0.7996, 0.7932, 0.7878, 0.7812, 0.7745, 0.7685, 0.7616, 0.7550, 0.7479, 0.7405, + 0.7336, 0.7255, 0.7184, 0.7102, 0.7016, 0.6946, 0.6860, 0.6769, 0.6687, 0.6598, + 0.6503, 0.6416, 0.6325, 0.6219, 0.6122, 0.6016, 0.5920, 0.5818, 0.5711, 0.5606, + 0.5487, 0.5374, 0.5266, 0.5142, 0.5020, 0.4908, 0.4784, 0.4663, 0.4532, 0.4405, + 0.4271, 0.4144, 0.4006, 0.3865, 0.3731, 0.3594, 0.3455, 0.3304, 0.3158, 0.3009, + 0.2858, 0.2708, 0.2560, 0.2399, 0.2233, 0.2074, 0.1919, 0.1756, 0.1590, 0.1427, + 0.1251, 0.1074, 0.0905, 0.0722, 0.0550, 0.0381, 0.0183, 0.0000, -0.0185, -0.0391, + -0.0571, -0.0760, -0.0966, -0.1160, -0.1370, -0.1584, -0.1787, -0.1999, -0.2214, -0.2423, + -0.2643, -0.2879, -0.3114, -0.3336, -0.3568, -0.3806, -0.4050, -0.4293, -0.4552, -0.4798, + -0.5046, -0.5296, -0.5564, -0.5836, -0.6093, -0.6372, -0.6645, -0.6933, -0.7208, -0.7495, + -0.7763, -0.8065, -0.8378, -0.8660, -0.8964, -0.9293, -0.9592, -0.9907, -1.0214, -1.0509, + -1.0850, -1.1168, -1.1528, -1.1847, -1.2157, -1.2511, -1.2850, -1.3174, -1.3540, -1.3900, + -1.4201, -1.4580, -1.4956, -1.5292, -1.5683, -1.6030, -1.6411, -1.6789, -1.7147, -1.7539, + -1.7887, -1.8289, -1.8699, -1.9043, -1.9469, -1.9849, -2.0267, -2.0610, -2.1028, -2.1391, + -2.1855, -2.2215, -2.2712, -2.3033, -2.3440, -2.3870, -2.4342, -2.4738, -2.5209, -2.5646, + -2.6016, -2.6385, -2.6868, -2.7356, -2.7723, -2.8111, -2.8524, -2.9009, -2.9428, -2.9879, + -3.0103, -3.0832, -3.1340, -3.1628, -3.2049, -3.2557, -3.3101, -3.3453, -3.4025, -3.4317, + -3.4828, -3.5270, -3.5745, -3.6181, -3.6765, -3.7044, -3.7410, -3.8118, -3.8368, -3.9549, + -3.9488, -3.9941, -4.0428, -4.0892, -4.1648, -4.1965, -4.1892, -4.2565, -4.3356, -4.3948, + -4.4481, -4.4607, -4.5533, -4.5809, -4.5927, -5.1047}, + {0.9978, 0.9962, 0.9961, 0.9959, 0.9958, 0.9954, 0.9949, 0.9950, 0.9947, 0.9942, + 0.9940, 0.9939, 0.9933, 0.9931, 0.9928, 0.9924, 0.9921, 0.9916, 0.9911, 0.9909, + 0.9903, 0.9900, 0.9892, 0.9887, 0.9883, 0.9877, 0.9869, 0.9863, 0.9857, 0.9848, + 0.9842, 0.9835, 0.9825, 0.9817, 0.9808, 0.9799, 0.9791, 0.9777, 0.9767, 0.9757, + 0.9744, 0.9729, 0.9716, 0.9704, 0.9690, 0.9674, 0.9656, 0.9641, 0.9625, 0.9609, + 0.9587, 0.9567, 0.9548, 0.9524, 0.9501, 0.9478, 0.9453, 0.9426, 0.9398, 0.9371, + 0.9339, 0.9311, 0.9277, 0.9242, 0.9206, 0.9168, 0.9131, 0.9087, 0.9043, 0.8999, + 0.8953, 0.8907, 0.8857, 0.8803, 0.8747, 0.8690, 0.8632, 0.8572, 0.8507, 0.8439, + 0.8368, 0.8295, 0.8217, 0.8138, 0.8058, 0.7972, 0.7883, 0.7784, 0.7694, 0.7597, + 0.7489, 0.7378, 0.7269, 0.7152, 0.7030, 0.6911, 0.6782, 0.6643, 0.6506, 0.6371, + 0.6211, 0.6054, 0.5897, 0.5740, 0.5565, 0.5393, 0.5214, 0.5027, 0.4838, 0.4643, + 0.4436, 0.4225, 0.4004, 0.3787, 0.3562, 0.3324, 0.3089, 0.2839, 0.2584, 0.2321, + 0.2047, 0.1784, 0.1499, 0.1213, 0.0915, 0.0628, 0.0314, 0.0000, -0.0321, -0.0657, + -0.0977, -0.1324, -0.1673, -0.2036, -0.2387, -0.2768, -0.3150, -0.3538, -0.3936, -0.4327, + -0.4739, -0.5148, -0.5561, -0.6000, -0.6438, -0.6889, -0.7331, -0.7781, -0.8247, -0.8712, + -0.9177, -0.9677, -1.0142, -1.0631, -1.1143, -1.1686, -1.2169, -1.2680, -1.3223, -1.3752, + -1.4261, -1.4806, -1.5356, -1.5890, -1.6462, -1.7041, -1.7591, -1.8124, -1.8735, -1.9311, + -1.9891, -2.0459, -2.1048, -2.1653, -2.2248, -2.2855, -2.3466, -2.4079, -2.4668, -2.5263, + -2.5876, -2.6507, -2.7142, -2.7761, -2.8366, -2.8995, -2.9620, -3.0279, -3.0973, -3.1576, + -3.2238, -3.2890, -3.3554, -3.4215, -3.4805, -3.5518, -3.6133, -3.6812, -3.7473, -3.8140, + -3.8781, -3.9450, -4.0184, -4.0794, -4.1478, -4.2241, -4.2853, -4.3473, -4.4062, -4.4839, + -4.5539, -4.6202, -4.6794, -4.7478, -4.8309, -4.9048, -4.9669, -5.0294, -5.1194, -5.1732, + -5.2378, -5.3094, -5.3742, -5.4573, -5.5190, -5.5728, -5.6637, -5.7259, -5.7843, -5.8854, + -5.9553, -6.0054, -6.0656, -6.1707, -6.2241, -6.3139, -6.3393, -6.4356, -6.5153, -6.5758, + -6.6506, -6.7193, -6.7542, -6.8942, -6.9219, -6.9605, -7.1013, -7.1895, -7.1549, -7.2799, + -7.4119, -7.4608, -7.5256, -7.5879, -7.7598, -8.4120}, + {0.9999, 0.9998, 0.9998, 0.9998, 0.9998, 0.9998, 0.9997, 0.9997, 0.9997, 0.9997, + 0.9997, 0.9996, 0.9996, 0.9996, 0.9995, 0.9995, 0.9994, 0.9994, 0.9994, 0.9993, + 0.9993, 0.9992, 0.9991, 0.9991, 0.9990, 0.9989, 0.9988, 0.9988, 0.9988, 0.9986, + 0.9985, 0.9984, 0.9983, 0.9982, 0.9980, 0.9979, 0.9977, 0.9976, 0.9974, 0.9971, + 0.9969, 0.9968, 0.9965, 0.9962, 0.9960, 0.9957, 0.9953, 0.9950, 0.9947, 0.9941, + 0.9937, 0.9933, 0.9928, 0.9922, 0.9917, 0.9911, 0.9904, 0.9897, 0.9890, 0.9882, + 0.9874, 0.9863, 0.9855, 0.9843, 0.9832, 0.9819, 0.9806, 0.9792, 0.9777, 0.9760, + 0.9743, 0.9724, 0.9704, 0.9683, 0.9659, 0.9634, 0.9609, 0.9581, 0.9550, 0.9516, + 0.9481, 0.9446, 0.9406, 0.9363, 0.9317, 0.9270, 0.9218, 0.9160, 0.9103, 0.9038, + 0.8972, 0.8898, 0.8822, 0.8739, 0.8647, 0.8554, 0.8457, 0.8357, 0.8231, 0.8115, + 0.7984, 0.7854, 0.7704, 0.7556, 0.7391, 0.7210, 0.7038, 0.6840, 0.6633, 0.6408, + 0.6174, 0.5939, 0.5678, 0.5410, 0.5137, 0.4836, 0.4524, 0.4193, 0.3850, 0.3482, + 0.3132, 0.2733, 0.2315, 0.1891, 0.1435, 0.0980, 0.0493, 0.0000, -0.0510, -0.1052, + -0.1593, -0.2177, -0.2759, -0.3374, -0.4005, -0.4599, -0.5266, -0.5935, -0.6626, -0.7328, + -0.8051, -0.8757, -0.9498, -1.0271, -1.1019, -1.1816, -1.2642, -1.3459, -1.4295, -1.5077, + -1.5958, -1.6818, -1.7647, -1.8548, -1.9387, -2.0295, -2.1152, -2.2154, -2.3011, -2.3904, + -2.4820, -2.5786, -2.6730, -2.7652, -2.8616, -2.9546, -3.0526, -3.1445, -3.2445, -3.3416, + -3.4357, -3.5325, -3.6324, -3.7313, -3.8225, -3.9209, -4.0248, -4.1278, -4.2261, -4.3193, + -4.4220, -4.5262, -4.6214, -4.7242, -4.8234, -4.9245, -5.0298, -5.1250, -5.2232, -5.3267, + -5.4332, -5.5342, -5.6431, -5.7270, -5.8401, -5.9350, -6.0407, -6.1418, -6.2363, -6.3384, + -6.4536, -6.5429, -6.6582, -6.7433, -6.8438, -6.9478, -7.0789, -7.1894, -7.2714, -7.3815, + -7.4810, -7.5575, -7.6852, -7.8071, -7.8580, -7.9724, -8.1000, -8.2207, -8.2867, -8.4017, + -8.5287, -8.6347, -8.7082, -8.8319, -8.9448, -9.0355, -9.1885, -9.2095, -9.2863, -9.4186, + -9.5064, -9.6386, -9.7207, -9.8286, -9.9453, -10.0701, -10.1735, -10.3001, -10.2858, -10.5427, + -10.5982, -10.7361, -10.7042, -10.9212, -11.0097, -11.0469, -11.1155, -11.2812, -11.3472, -11.4988, + -11.5327, -11.6692, -11.9376, -11.8606, -12.1372, -13.2539}, + {1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, + 0.9999, 0.9998, 0.9998, 0.9998, 0.9998, 0.9997, 0.9997, 0.9997, 0.9997, 0.9996, + 0.9996, 0.9995, 0.9995, 0.9994, 0.9994, 0.9993, 0.9992, 0.9991, 0.9991, 0.9989, + 0.9988, 0.9986, 0.9985, 0.9983, 0.9981, 0.9980, 0.9977, 0.9974, 0.9971, 0.9968, + 0.9965, 0.9962, 0.9956, 0.9950, 0.9948, 0.9941, 0.9933, 0.9926, 0.9919, 0.9910, + 0.9899, 0.9889, 0.9877, 0.9863, 0.9845, 0.9829, 0.9811, 0.9791, 0.9769, 0.9741, + 0.9716, 0.9684, 0.9645, 0.9611, 0.9563, 0.9519, 0.9463, 0.9406, 0.9344, 0.9272, + 0.9197, 0.9107, 0.9016, 0.8903, 0.8791, 0.8653, 0.8523, 0.8357, 0.8179, 0.7988, + 0.7779, 0.7562, 0.7318, 0.7024, 0.6753, 0.6435, 0.6089, 0.5700, 0.5296, 0.4860, + 0.4366, 0.3855, 0.3301, 0.2735, 0.2114, 0.1443, 0.0682, 0.0000, -0.0715, -0.1604, + -0.2478, -0.3377, -0.4287, -0.5277, -0.6291, -0.7384, -0.8457, -0.9559, -1.0742, -1.1913, + -1.3110, -1.4238, -1.5594, -1.6854, -1.8093, -1.9414, -2.0763, -2.2160, -2.3611, -2.4876, + -2.6374, -2.7710, -2.9225, -3.0591, -3.2077, -3.3452, -3.4916, -3.6316, -3.7735, -3.9296, + -4.0682, -4.2334, -4.3607, -4.5270, -4.6807, -4.8108, -4.9753, -5.1212, -5.2631, -5.4042, + -5.5510, -5.7227, -5.8794, -6.0244, -6.1677, -6.3271, -6.4862, -6.6130, -6.7449, -6.9250, + -7.1232, -7.1736, -7.3628, -7.5596, -7.6906, -7.8129, -7.9817, -8.1440, -8.3016, -8.4797, + -8.5734, -8.7692, -8.9198, -9.0610, -9.1746, -9.3536, -9.5939, -9.6957, -9.8475, -9.9639, + -10.1730, -10.2427, -10.4573, -10.5413, -10.7303, -10.9339, -11.0215, -11.2047, -11.2894, -11.4572, + -11.6256, -11.7794, -11.8801, -12.1717, -12.2354, -12.3686, -12.6195, -12.6527, -12.8247, -12.9560, + -13.3265, -13.1667, -13.4274, -13.6064, -13.5515, -13.9501, -13.9926, -14.4049, -14.1653, -14.4348, + -14.7983, -14.7807, -15.2349, -15.3536, -15.3026, -15.2739, -15.7170, -16.2161, -15.9185, -15.9490, + -16.6258, -16.5568, -16.4318, -16.7999, -16.4101, -17.6393, -17.7643, -17.2644, -17.5973, -17.0403, + -17.7039, -18.0073, -18.1840, -18.3848, -18.6286, -20.7063}, + {1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, + 0.9999, 0.9998, 0.9998, 0.9998, 0.9998, 0.9997, 0.9997, 0.9997, 0.9997, 0.9996, + 0.9996, 0.9995, 0.9995, 0.9994, 0.9994, 0.9993, 0.9992, 0.9991, 0.9991, 0.9989, + 0.9988, 0.9986, 0.9985, 0.9983, 0.9981, 0.9980, 0.9977, 0.9974, 0.9971, 0.9968, + 0.9965, 0.9962, 0.9956, 0.9950, 0.9948, 0.9941, 0.9933, 0.9926, 0.9919, 0.9910, + 0.9899, 0.9889, 0.9877, 0.9863, 0.9845, 0.9829, 0.9811, 0.9791, 0.9769, 0.9741, + 0.9716, 0.9684, 0.9645, 0.9611, 0.9563, 0.9519, 0.9463, 0.9406, 0.9344, 0.9272, + 0.9197, 0.9107, 0.9016, 0.8903, 0.8791, 0.8653, 0.8523, 0.8357, 0.8179, 0.7988, + 0.7779, 0.7562, 0.7318, 0.7024, 0.6753, 0.6435, 0.6089, 0.5700, 0.5296, 0.4860, + 0.4366, 0.3855, 0.3301, 0.2735, 0.2114, 0.1443, 0.0682, 0.0000, -0.0715, -0.1604, + -0.2478, -0.3377, -0.4287, -0.5277, -0.6291, -0.7384, -0.8457, -0.9559, -1.0742, -1.1913, + -1.3110, -1.4238, -1.5594, -1.6854, -1.8093, -1.9414, -2.0763, -2.2160, -2.3611, -2.4876, + -2.6374, -2.7710, -2.9225, -3.0591, -3.2077, -3.3452, -3.4916, -3.6316, -3.7735, -3.9296, + -4.0682, -4.2334, -4.3607, -4.5270, -4.6807, -4.8108, -4.9753, -5.1212, -5.2631, -5.4042, + -5.5510, -5.7227, -5.8794, -6.0244, -6.1677, -6.3271, -6.4862, -6.6130, -6.7449, -6.9250, + -7.1232, -7.1736, -7.3628, -7.5596, -7.6906, -7.8129, -7.9817, -8.1440, -8.3016, -8.4797, + -8.5734, -8.7692, -8.9198, -9.0610, -9.1746, -9.3536, -9.5939, -9.6957, -9.8475, -9.9639, + -10.1730, -10.2427, -10.4573, -11.7794, -11.8801, -12.1717, -12.2354, -12.3686, -12.6195, -12.6527, + -12.8247, -12.9560, -13.3265, -13.1667, -13.4274, -13.6064, -13.5515, -13.9501, -13.9926, -14.4049, + -14.1653, -14.4348, -14.7983, -14.7807, -15.2349, -15.3536, -15.3026, -15.2739, -15.7170, -16.2161, + -15.9185, -15.9490, -16.6258, -16.5568, -16.4318, -16.7999, -16.4101, -17.6393, -17.7643, -17.2644, + -17.5973, -17.0403, -17.7039, -18.0073, -18.1840, -18.3848, -18.6286, -20.7063, 1.43370769e-019, + 2.64031087e-006, 6.6908396e+031, 1.77537994e+028, 2.79322819e+020, 1.94326e-019, + 0.00019371575, 2.80722121e-041}}; diff --git a/wsjtx_lib/lib/wsprd/mettab.c b/wsjtx_lib/lib/wsprd/mettab.c new file mode 100644 index 0000000..f188c0c --- /dev/null +++ b/wsjtx_lib/lib/wsprd/mettab.c @@ -0,0 +1,76 @@ +/* + This file is part of wsprd. + + File name: mettab.c + Description: Metric table for sequential Fano decoder. + + Copyright 2008-2015, Joseph Taylor, K1JT + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*/ + +int mettab[2][256]={ + 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, 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, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, + 2, 2, 2, 2, 1, 1, 1, 1, 0, 0, + -1, -1, -1, -2, -2, -3, -4, -4, -5, -6, + -7, -7, -8, -9, -10, -11, -12, -12, -13, -14, + -15, -16, -17, -17, -18, -19, -20, -21, -22, -22, + -23, -24, -25, -26, -26, -27, -28, -29, -30, -30, + -31, -32, -33, -33, -34, -35, -36, -36, -37, -38, + -38, -39, -40, -41, -41, -42, -43, -43, -44, -45, + -45, -46, -47, -47, -48, -49, -49, -50, -51, -51, + -52, -53, -53, -54, -54, -55, -56, -56, -57, -57, + -58, -59, -59, -60, -60, -61, -62, -62, -62, -63, + -64, -64, -65, -65, -66, -67, -67, -67, -68, -69, + -69, -70, -70, -71, -72, -72, -72, -72, -73, -74, + -75, -75, -75, -77, -76, -76, -78, -78, -80, -81, + -80, -79, -83, -82, -81, -82, -82, -83, -84, -84, + -84, -87, -86, -87, -88,-105, -94,-105, -88, -87, + -86, -87, -84, -84, -84, -83, -82, -82, -81, -82, + -83, -79, -80, -81, -80, -78, -78, -76, -76, -77, + -75, -75, -75, -74, -73, -72, -72, -72, -72, -71, + -70, -70, -69, -69, -68, -67, -67, -67, -66, -65, + -65, -64, -64, -63, -62, -62, -62, -61, -60, -60, + -59, -59, -58, -57, -57, -56, -56, -55, -54, -54, + -53, -53, -52, -51, -51, -50, -49, -49, -48, -47, + -47, -46, -45, -45, -44, -43, -43, -42, -41, -41, + -40, -39, -38, -38, -37, -36, -36, -35, -34, -33, + -33, -32, -31, -30, -30, -29, -28, -27, -26, -26, + -25, -24, -23, -22, -22, -21, -20, -19, -18, -17, + -17, -16, -15, -14, -13, -12, -12, -11, -10, -9, + -8, -7, -7, -6, -5, -4, -4, -3, -2, -2, + -1, -1, -1, 0, 0, 1, 1, 1, 1, 2, + 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 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, 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 }; diff --git a/wsjtx_lib/lib/wsprd/nhash.c b/wsjtx_lib/lib/wsprd/nhash.c new file mode 100644 index 0000000..5bf6ce0 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/nhash.c @@ -0,0 +1,383 @@ +/* + This file is part of wsprd. + + File name: nhash.c + + *------------------------------------------------------------------------------ + * + * This file is part of the WSPR application, Weak Signal Propogation Reporter + * + * File Name: nhash.c + * Description: Functions to produce 32-bit hashes for hash table lookup + * + * Copyright (C) 2008-2014 Joseph Taylor, K1JT + * License: GNU GPL v3+ + * + * This program is free software; you can redistribute it and/or modify it under + * the terms of the GNU General Public License as published by the Free Software + * Foundation; either version 3 of the License, or (at your option) any later + * version. + * + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + * details. + * + * You should have received a copy of the GNU General Public License along with + * this program; if not, write to the Free Software Foundation, Inc., 51 Franklin + * Street, Fifth Floor, Boston, MA 02110-1301, USA. + * + * Files: lookup3.c + * Copyright: Copyright (C) 2006 Bob Jenkins + * License: public-domain + * You may use this code any way you wish, private, educational, or commercial. + * It's free. + * + *------------------------------------------------------------------------------- +*/ + +/* +These are functions for producing 32-bit hashes for hash table lookup. +hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() +are externally useful functions. Routines to test the hash are included +if SELF_TEST is defined. You can use this free for any purpose. It's in +the public domain. It has no warranty. + +You probably want to use hashlittle(). hashlittle() and hashbig() +hash byte arrays. hashlittle() is is faster than hashbig() on +little-endian machines. Intel and AMD are little-endian machines. +On second thought, you probably want hashlittle2(), which is identical to +hashlittle() except it returns two 32-bit hashes for the price of one. +You could implement hashbig2() if you wanted but I haven't bothered here. + +If you want to find a hash of, say, exactly 7 integers, do + a = i1; b = i2; c = i3; + mix(a,b,c); + a += i4; b += i5; c += i6; + mix(a,b,c); + a += i7; + final(a,b,c); +then use c as the hash value. If you have a variable length array of +4-byte integers to hash, use hashword(). If you have a byte array (like +a character string), use hashlittle(). If you have several byte arrays, or +a mix of things, see the comments above hashlittle(). + +Why is this so big? I read 12 bytes at a time into 3 4-byte integers, +then mix those integers. This is fast (you can do a lot more thorough +mixing with 12*3 instructions on 3 integers than you can with 3 instructions +on 1 byte), but shoehorning those bytes into integers efficiently is messy. +*/ + +#define SELF_TEST 1 + +#include /* defines printf for tests */ +#include /* defines time_t for timings in the test */ +#include "nhash.h" +//#include /* attempt to define endianness */ +//#ifdef linux +//# include /* attempt to define endianness */ +//#endif + +#define HASH_LITTLE_ENDIAN 1 + +#define hashsize(n) ((uint32_t)1<<(n)) +#define hashmask(n) (hashsize(n)-1) +#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k)))) + +/* +------------------------------------------------------------------------------- +mix -- mix 3 32-bit values reversibly. + +This is reversible, so any information in (a,b,c) before mix() is +still in (a,b,c) after mix(). + +If four pairs of (a,b,c) inputs are run through mix(), or through +mix() in reverse, there are at least 32 bits of the output that +are sometimes the same for one pair and different for another pair. +This was tested for: +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that +satisfy this are + 4 6 8 16 19 4 + 9 15 3 18 27 15 + 14 9 3 7 17 3 +Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing +for "differ" defined as + with a one-bit base and a two-bit delta. I +used http://burtleburtle.net/bob/hash/avalanche.html to choose +the operations, constants, and arrangements of the variables. + +This does not achieve avalanche. There are input bits of (a,b,c) +that fail to affect some output bits of (a,b,c), especially of a. The +most thoroughly mixed value is c, but it doesn't really even achieve +avalanche in c. + +This allows some parallelism. Read-after-writes are good at doubling +the number of bits affected, so the goal of mixing pulls in the opposite +direction as the goal of parallelism. I did what I could. Rotates +seem to cost as much as shifts on every machine I could lay my hands +on, and rotates are much kinder to the top and bottom bits, so I used +rotates. +------------------------------------------------------------------------------- +*/ +#define mix(a,b,c) \ +{ \ + a -= c; a ^= rot(c, 4); c += b; \ + b -= a; b ^= rot(a, 6); a += c; \ + c -= b; c ^= rot(b, 8); b += a; \ + a -= c; a ^= rot(c,16); c += b; \ + b -= a; b ^= rot(a,19); a += c; \ + c -= b; c ^= rot(b, 4); b += a; \ +} + +/* +------------------------------------------------------------------------------- +final -- final mixing of 3 32-bit values (a,b,c) into c + +Pairs of (a,b,c) values differing in only a few bits will usually +produce values of c that look totally different. This was tested for +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +These constants passed: + 14 11 25 16 4 14 24 + 12 14 25 16 4 14 24 +and these came close: + 4 8 15 26 3 22 24 + 10 8 15 26 3 22 24 + 11 8 15 26 3 22 24 +------------------------------------------------------------------------------- +*/ +#define final(a,b,c) \ +{ \ + c ^= b; c -= rot(b,14); \ + a ^= c; a -= rot(c,11); \ + b ^= a; b -= rot(a,25); \ + c ^= b; c -= rot(b,16); \ + a ^= c; a -= rot(c,4); \ + b ^= a; b -= rot(a,14); \ + c ^= b; c -= rot(b,24); \ +} + +/* +------------------------------------------------------------------------------- +hashlittle() -- hash a variable-length key into a 32-bit value + k : the key (the unaligned variable-length array of bytes) + length : the length of the key, counting by bytes + initval : can be any 4-byte value +Returns a 32-bit value. Every bit of the key affects every bit of +the return value. Two keys differing by one or two bits will have +totally different hash values. + +The best hash table sizes are powers of 2. There is no need to do +mod a prime (mod is sooo slow!). If you need less than 32 bits, +use a bitmask. For example, if you need only 10 bits, do + h = (h & hashmask(10)); +In which case, the hash table should have hashsize(10) elements. + +If you are hashing n strings (uint8_t **)k, do it like this: + for (i=0, h=0; i 12) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; + case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; + case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=k[1]&0xffffff; a+=k[0]; break; + case 6 : b+=k[1]&0xffff; a+=k[0]; break; + case 5 : b+=k[1]&0xff; a+=k[0]; break; + case 4 : a+=k[0]; break; + case 3 : a+=k[0]&0xffffff; break; + case 2 : a+=k[0]&0xffff; break; + case 1 : a+=k[0]&0xff; break; + case 0 : return c; /* zero length strings require no mixing */ + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]; break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ + case 1 : a+=k8[0]; break; + case 0 : return c; + } + +#endif /* !valgrind */ + + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; + + /*--------------- all but last block: aligned reads and different mixing */ + while (length > 12) + { + a += k[0] + (((uint32_t)k[1])<<16); + b += k[2] + (((uint32_t)k[3])<<16); + c += k[4] + (((uint32_t)k[5])<<16); + mix(a,b,c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) block */ + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[4]+(((uint32_t)k[5])<<16); + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=k[4]; + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=k[2]; + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=k[0]; + break; + case 1 : a+=k8[0]; + break; + case 0 : return c; /* zero length requires no mixing */ + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length > 12) + { + a += k[0]; + a += ((uint32_t)k[1])<<8; + a += ((uint32_t)k[2])<<16; + a += ((uint32_t)k[3])<<24; + b += k[4]; + b += ((uint32_t)k[5])<<8; + b += ((uint32_t)k[6])<<16; + b += ((uint32_t)k[7])<<24; + c += k[8]; + c += ((uint32_t)k[9])<<8; + c += ((uint32_t)k[10])<<16; + c += ((uint32_t)k[11])<<24; + mix(a,b,c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch(length) /* all the case statements fall through */ + { + case 12: c+=((uint32_t)k[11])<<24; + /* fall through */ + case 11: c+=((uint32_t)k[10])<<16; + /* fall through */ + case 10: c+=((uint32_t)k[9])<<8; + /* fall through */ + case 9 : c+=k[8]; + /* fall through */ + case 8 : b+=((uint32_t)k[7])<<24; + /* fall through */ + case 7 : b+=((uint32_t)k[6])<<16; + /* fall through */ + case 6 : b+=((uint32_t)k[5])<<8; + /* fall through */ + case 5 : b+=k[4]; + /* fall through */ + case 4 : a+=((uint32_t)k[3])<<24; + /* fall through */ + case 3 : a+=((uint32_t)k[2])<<16; + /* fall through */ + case 2 : a+=((uint32_t)k[1])<<8; + /* fall through */ + case 1 : a+=k[0]; + break; + case 0 : return c; + } + } + + final(a,b,c); + c=(32767&c); + + return c; +} diff --git a/wsjtx_lib/lib/wsprd/nhash.h b/wsjtx_lib/lib/wsprd/nhash.h new file mode 100644 index 0000000..a111916 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/nhash.h @@ -0,0 +1,21 @@ +#ifndef NHASH_H_ +#define NHASH_H_ + +#ifdef Win32 +#include "win_stdint.h" /* defines uint32_t etc */ +#else +#include +#include /* defines uint32_t etc */ +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +uint32_t nhash( const void * key, size_t length, uint32_t initval); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/wsjtx_lib/lib/wsprd/osdwspr.f90 b/wsjtx_lib/lib/wsprd/osdwspr.f90 new file mode 100644 index 0000000..2a2d712 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/osdwspr.f90 @@ -0,0 +1,361 @@ +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 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 + 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 + +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.le.0) goto 998 ! norder=0 +if(ndeep.gt.5) ndeep=5 +if( ndeep.eq. 1) then + nord=1 + npre1=0 + npre2=0 + nt=66 + ntheta=16 +elseif(ndeep.eq.2) then + nord=1 + npre1=1 + npre2=0 + nt=66 + ntheta=22 + ntau = 16 +elseif(ndeep.eq.3) then + nord=1 + npre1=1 + npre2=1 + nt=66 + ntheta=22 + ntau=16 +elseif(ndeep.eq.4) then + nord=2 + npre1=1 + npre2=1 + nt=66 + ntheta=22 + ntau=16 +elseif(ndeep.eq.5) then + nord=3 + npre1=1 + npre2=1 + nt=66 + 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 + 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 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/wsjtx_lib/lib/wsprd/t2.f90 b/wsjtx_lib/lib/wsprd/t2.f90 new file mode 100644 index 0000000..0f214db --- /dev/null +++ b/wsjtx_lib/lib/wsprd/t2.f90 @@ -0,0 +1,11 @@ +program t2 + + df=375.0/65536.0 + do i=1,65536 + w=1.0/(1.0 + ((i-32768)/26214.0)**20) + f=(i-32768)*df + write(13,1010) f,w +1010 format(2f15.6) + enddo + +end program t2 diff --git a/wsjtx_lib/lib/wsprd/tab.c b/wsjtx_lib/lib/wsprd/tab.c new file mode 100644 index 0000000..e330c75 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/tab.c @@ -0,0 +1,41 @@ +/* + This file is part of wsprd. + + File name: tab.c + Description: 8-bit parity lookup table. +*/ +unsigned char Partab[] = { + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, +}; + diff --git a/wsjtx_lib/lib/wsprd/test_wspr.f90 b/wsjtx_lib/lib/wsprd/test_wspr.f90 new file mode 100644 index 0000000..52bd327 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/test_wspr.f90 @@ -0,0 +1,61 @@ +program test_wspr + +! This program provides examples of the source encoding, convolutional +! error-control coding, bit and symbol ordering, and synchronizing +! information contained in WSPR messages. + + character*22 msg,msg2 + character*23 msg3 + character*1 err2,err3 + integer*1 data0(11) + logical lfile + +! Get command-line argument(s) + nargs=iargc() + if(nargs.ne.1) then + print*,'Usage: test_wspr "message"' + go to 999 + endif + call getarg(1,msg) !Get message from command line + call unpk(data0,1,msg3) !Read the C hashtable + lfile=msg(1:2).eq."-t" + if(lfile) open(10,file="messages.txt",status="old") + + do imsg=1,999 + if(lfile) read(10,1001,end=900) msg +1001 format(a22) + + data0=0 + call wqencode(msg,ntype0,data0) !Source encoding +! write(*,1002) data0(1:7) +!1002 format('Source-encoded message (50 bits, hex):',7z3.2) +! data0(8:11)=0 + + call wqdecode(data0,msg2,ntype1) + +! write(*,1020) ntype1 +!1020 format('Message type: ',i7) +! write(*,1030) msg2 +!1030 format('Decoded message: ',a22) + + call unpk(data0,0,msg3) + do i=1,23 + if(ichar(msg3(i:i)).eq.0) then + msg3(i:)=" " + exit + endif + enddo + + err2=' ' + err3=' ' + if(msg2.ne.msg) err2='*' + if(msg3.ne.msg) err3='*' + + write(*,1040) msg,err2,msg2,err3,msg3 +1040 format(a22,1x,a1,1x,a22,1x,a1,1x,a22) + if(.not.lfile) exit + enddo +900 call unpk(data0,2,msg3) + + +999 end program test_wspr diff --git a/wsjtx_lib/lib/wsprd/unpk.c.obsolete b/wsjtx_lib/lib/wsprd/unpk.c.obsolete new file mode 100644 index 0000000..fae2bcf --- /dev/null +++ b/wsjtx_lib/lib/wsprd/unpk.c.obsolete @@ -0,0 +1,124 @@ +/* the routine unpk() is not in wsprd_utils.c */ +#include +#include +#include +#include +#include +#include +#include + +#include "wsprd_utils.h" + +unsigned int nhash_( const void *key, size_t length, uint32_t initval); + +void unpk_(signed char message[], int *nhashtab, char call_loc_pow[]) +{ + int i,n1,n2,n3,ndbm,ihash,nadd,noprint,nh; + char callsign[13],grid[5],grid6[7],cdbm[3]; + static char hashtab[32768][13]; + FILE *fhash; + + if(*nhashtab==1) { + char line[80], hcall[12]; + if( (fhash=fopen("hashtable.txt","r+")) ) { + while (fgets(line, sizeof(line), fhash) != NULL) { + sscanf(line,"%d %s",&nh,hcall); + strcpy(*hashtab+nh*13,hcall); + } + } else { + fhash=fopen("hashtable.txt","w+"); + } + fclose(fhash); + return; + } + + if(*nhashtab==2) { + fhash=fopen("hashtable.txt","w"); + for (i=0; i<32768; i++) { + if( strncmp(hashtab[i],"\0",1) != 0 ) { + fprintf(fhash,"%5d %s\n",i,*hashtab+i*13); + } + } + fclose(fhash); + return; + } + + unpack50(message,&n1,&n2); + unpackcall(n1,callsign); + unpackgrid(n2, grid); + int ntype = (n2&127) - 64; + callsign[12]=0; + grid[4]=0; + +/* + Based on the value of ntype, decide whether this is a Type 1, 2, or + 3 message. + + * Type 1: 6 digit call, grid, power - ntype is positive and is a member + of the set {0,3,7,10,13,17,20...60} + + * Type 2: extended callsign, power - ntype is positive but not + a member of the set of allowed powers + + * Type 3: hash, 6 digit grid, power - ntype is negative. +*/ + + if( (ntype >= 0) && (ntype <= 62) ) { + int nu=ntype%10; + if( nu == 0 || nu == 3 || nu == 7 ) { + ndbm=ntype; + memset(call_loc_pow,0,sizeof(char)*23); + sprintf(cdbm,"%2d",ndbm); + strncat(call_loc_pow,callsign,strlen(callsign)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,grid,4); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,cdbm,2); + strncat(call_loc_pow,"\0",1); + ihash=nhash_(callsign,strlen(callsign),(uint32_t)146); + strcpy(*hashtab+ihash*13,callsign); + } else { + nadd=nu; + if( nu > 3 ) nadd=nu-3; + if( nu > 7 ) nadd=nu-7; + n3=n2/128+32768*(nadd-1); + unpackpfx(n3,callsign); + ndbm=ntype-nadd; + memset(call_loc_pow,0,sizeof(char)*23); + sprintf(cdbm,"%2d",ndbm); + strncat(call_loc_pow,callsign,strlen(callsign)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,cdbm,2); + strncat(call_loc_pow,"\0",1); + ihash=nhash_(callsign,strlen(callsign),(uint32_t)146); + strcpy(*hashtab+ihash*13,callsign); + noprint=0; + } + } else if ( ntype < 0 ) { + ndbm=-(ntype+1); + memset(grid6,0,sizeof(char)*7); + strncat(grid6,callsign+5,1); + strncat(grid6,callsign,5); + ihash=(n2-ntype-64)/128; + if( strncmp(hashtab[ihash],"\0",1) != 0 ) { + sprintf(callsign,"<%s>",hashtab[ihash]); + } else { + sprintf(callsign,"%5s","<...>"); + } + + memset(call_loc_pow,0,sizeof(char)*23); + sprintf(cdbm,"%2d",ndbm); + strncat(call_loc_pow,callsign,strlen(callsign)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,grid6,strlen(grid6)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,cdbm,2); + strncat(call_loc_pow,"\0",1); + + noprint=0; + +// I don't know what to do with these... They show up as "A000AA" grids. + if( ntype == -64 ) noprint=1; + } + // printf("\nUnpacked in C: %s\n",call_loc_pow); +} diff --git a/wsjtx_lib/lib/wsprd/wspr_params.f90 b/wsjtx_lib/lib/wsprd/wspr_params.f90 new file mode 100644 index 0000000..ebfc4cf --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wspr_params.f90 @@ -0,0 +1,20 @@ +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/wsjtx_lib/lib/wsprd/wspr_wav.f90 b/wsjtx_lib/lib/wsprd/wspr_wav.f90 new file mode 100644 index 0000000..900ebda --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wspr_wav.f90 @@ -0,0 +1,49 @@ +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.0/datpk + dat=fac*dat + endif + iwave=nint(dat) + + return +end subroutine wspr_wav diff --git a/wsjtx_lib/lib/wsprd/wsprd.c b/wsjtx_lib/lib/wsprd/wsprd.c new file mode 100644 index 0000000..3fde45d --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprd.c @@ -0,0 +1,1580 @@ +/* + This file is part of program wsprd, a detector/demodulator/decoder + for the Weak Signal Propagation Reporter (WSPR) mode. + + File name: wsprd.c + + Copyright 2001-2018, Joe Taylor, K1JT + + Much of the present code is based on work by Steven Franke, K9AN, + which in turn was based on earlier work by K1JT. + + Copyright 2014-2018, Steven Franke, K9AN + + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + */ + +#include +#include +#include +#include +#include +#include +#include +#include + +#include "fano.h" +#include "jelinek.h" +#include "nhash.h" +#include "wsprd_utils.h" +#include "wsprsim_utils.h" + +#define max(x,y) ((x) > (y) ? (x) : (y)) + +extern void osdwspr_ (float [], unsigned char [], int *, unsigned char [], int *, float *); + +// Possible PATIENCE options: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, +// FFTW_MEASURE, FFTW_PATIENT, FFTW_EXHAUSTIVE +#define PATIENCE FFTW_ESTIMATE +fftwf_plan PLAN1,PLAN2,PLAN3; + +unsigned char pr3[162]= +{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}; + +int printdata=0; + +//*************************************************************************** +unsigned long readc2file(char *ptr_to_infile, float *idat, float *qdat, + double *freq, int *wspr_type) +{ + float *buffer; + double dfreq; + int i,ntrmin; + char c2file[15]; + size_t nr; + FILE* fp; + + fp = fopen(ptr_to_infile,"rb"); + if (fp == NULL) { + fprintf(stderr, "Cannot open data file '%s'\n", ptr_to_infile); + return 1; + } + nr=fread(c2file,sizeof(char),14,fp); + nr=fread(&ntrmin,sizeof(int),1,fp); + nr=fread(&dfreq,sizeof(double),1,fp); + *freq=dfreq; + + buffer=calloc(2*65536,sizeof(float)); + nr=fread(buffer,sizeof(float),2*45000,fp); + fclose(fp); + + *wspr_type=ntrmin; + + for(i=0; i<45000; i++) { + idat[i]=buffer[2*i]; + qdat[i]=-buffer[2*i+1]; + } + free(buffer); + + if( nr == 2*45000 ) { + return (unsigned long) nr/2; + } else { + return 1; + } +} + +//*************************************************************************** +unsigned long readwavfile(char *ptr_to_infile, int ntrmin, float *idat, float *qdat ) +{ + size_t i, j, npoints, nr; + int nfft1, nfft2, nh2, i0; + double df; + + nfft2=46080; //this is the number of downsampled points that will be returned + nh2=nfft2/2; + + if( ntrmin == 2 ) { + nfft1=nfft2*32; //need to downsample by a factor of 32 + df=12000.0/nfft1; + i0=1500.0/df+0.5; + npoints=114*12000; + } else if ( ntrmin == 15 ) { + nfft1=nfft2*8*32; + df=12000.0/nfft1; + i0=(1500.0+112.5)/df+0.5; + npoints=8*114*12000; + } else { + fprintf(stderr,"This should not happen\n"); + return 1; + } + + float *realin; + fftwf_complex *fftin, *fftout; + + FILE *fp; + short int *buf2; + + fp = fopen(ptr_to_infile,"rb"); + if (fp == NULL) { + fprintf(stderr, "Cannot open data file '%s'\n", ptr_to_infile); + return 1; + } + + buf2 = calloc(npoints,sizeof(short int)); + nr=fread(buf2,2,22,fp); //Read and ignore header + nr=fread(buf2,2,npoints,fp); //Read raw data + fclose(fp); + if( nr == 0 ) { + fprintf(stderr, "No data in file '%s'\n", ptr_to_infile); + return 1; + } + + realin=(float*) fftwf_malloc(sizeof(float)*nfft1); + fftout=(fftwf_complex*) fftwf_malloc(sizeof(fftwf_complex)*(nfft1/2+1)); + PLAN1 = fftwf_plan_dft_r2c_1d(nfft1, realin, fftout, PATIENCE); + + for (i=0; i(size_t)nh2 ) j=j-nfft2; + fftin[i][0]=fftout[j][0]; + fftin[i][1]=fftout[j][1]; + } + + fftwf_free(fftout); + fftout=(fftwf_complex*) fftwf_malloc(sizeof(fftwf_complex)*nfft2); + PLAN2 = fftwf_plan_dft_1d(nfft2, fftin, fftout, FFTW_BACKWARD, PATIENCE); + fftwf_execute(PLAN2); + + for (i=0; i<(size_t)nfft2; i++) { + idat[i]=fftout[i][0]/1000.0; + qdat[i]=fftout[i][1]/1000.0; + } + + fftwf_free(fftin); + fftwf_free(fftout); + return nfft2; +} + +//*************************************************************************** +void sync_and_demodulate(float *id, float *qd, long np, + unsigned char *symbols, float *f1, int ifmin, int ifmax, float fstep, + int *shift1, int lagmin, int lagmax, int lagstep, + float *drift1, int symfac, float *sync, int mode) +{ + /*********************************************************************** + * mode = 0: no frequency or drift search. find best time lag. * + * 1: no time lag or drift search. find best frequency. * + * 2: no frequency or time lag search. calculate soft-decision * + * symbols using passed frequency and shift. * + ************************************************************************/ + + static float fplast=-10000.0; + static float dt=1.0/375.0, df=375.0/256.0; + static float pi=3.14159265358979323846; + float twopidt, df15=df*1.5, df05=df*0.5; + + int i, j, k, lag; + float i0[162],q0[162],i1[162],q1[162],i2[162],q2[162],i3[162],q3[162]; + float p0,p1,p2,p3,cmet,totp,syncmax,fac; + float c0[256],s0[256],c1[256],s1[256],c2[256],s2[256],c3[256],s3[256]; + float dphi0, cdphi0, sdphi0, dphi1, cdphi1, sdphi1, dphi2, cdphi2, sdphi2, + dphi3, cdphi3, sdphi3; + float f0=0.0, fp, ss, fbest=0.0, fsum=0.0, f2sum=0.0, fsymb[162]; + int best_shift = 0, ifreq; + + syncmax=-1e30; + if( mode == 0 ) {ifmin=0; ifmax=0; fstep=0.0; f0=*f1;} + if( mode == 1 ) {lagmin=*shift1;lagmax=*shift1;f0=*f1;} + if( mode == 2 ) {lagmin=*shift1;lagmax=*shift1;ifmin=0;ifmax=0;f0=*f1;} + + twopidt=2*pi*dt; + for(ifreq=ifmin; ifreq<=ifmax; ifreq++) { + f0=*f1+ifreq*fstep; + for(lag=lagmin; lag<=lagmax; lag=lag+lagstep) { + ss=0.0; + totp=0.0; + for (i=0; i<162; i++) { + fp = f0 + (*drift1/2.0)*((float)i-81.0)/81.0; + if( i==0 || (fp != fplast) ) { // only calculate sin/cos if necessary + dphi0=twopidt*(fp-df15); + cdphi0=cos(dphi0); + sdphi0=sin(dphi0); + + dphi1=twopidt*(fp-df05); + cdphi1=cos(dphi1); + sdphi1=sin(dphi1); + + dphi2=twopidt*(fp+df05); + cdphi2=cos(dphi2); + sdphi2=sin(dphi2); + + dphi3=twopidt*(fp+df15); + cdphi3=cos(dphi3); + sdphi3=sin(dphi3); + + c0[0]=1; s0[0]=0; + c1[0]=1; s1[0]=0; + c2[0]=1; s2[0]=0; + c3[0]=1; s3[0]=0; + + for (j=1; j<256; j++) { + c0[j]=c0[j-1]*cdphi0 - s0[j-1]*sdphi0; + s0[j]=c0[j-1]*sdphi0 + s0[j-1]*cdphi0; + c1[j]=c1[j-1]*cdphi1 - s1[j-1]*sdphi1; + s1[j]=c1[j-1]*sdphi1 + s1[j-1]*cdphi1; + c2[j]=c2[j-1]*cdphi2 - s2[j-1]*sdphi2; + s2[j]=c2[j-1]*sdphi2 + s2[j-1]*cdphi2; + c3[j]=c3[j-1]*cdphi3 - s3[j-1]*sdphi3; + s3[j]=c3[j-1]*sdphi3 + s3[j-1]*cdphi3; + } + fplast = fp; + } + + i0[i]=0.0; q0[i]=0.0; + i1[i]=0.0; q1[i]=0.0; + i2[i]=0.0; q2[i]=0.0; + i3[i]=0.0; q3[i]=0.0; + + for (j=0; j<256; j++) { + k=lag+i*256+j; + if( (k>0) && (k syncmax ) { //Save best parameters + syncmax=ss; + best_shift=lag; + fbest=f0; + } + } // lag loop + } //freq loop + + if( mode <=1 ) { //Send best params back to caller + *sync=syncmax; + *shift1=best_shift; + *f1=fbest; + return; + } + + if( mode == 2 ) { + *sync=syncmax; + for (i=0; i<162; i++) { //Normalize the soft symbols + fsum=fsum+fsymb[i]/162.0; + f2sum=f2sum+fsymb[i]*fsymb[i]/162.0; + } + fac=sqrt(f2sum-fsum*fsum); + for (i=0; i<162; i++) { + fsymb[i]=symfac*fsymb[i]/fac; + if( fsymb[i] > 127) fsymb[i]=127.0; + if( fsymb[i] < -128 ) fsymb[i]=-128.0; + symbols[i]=fsymb[i] + 128; + } + return; + } + return; +} + +void noncoherent_sequence_detection(float *id, float *qd, long np, + unsigned char *symbols, float *f1, int *shift1, + float *drift1, int symfac, int *nblocksize, int *bitmetric) +{ + /************************************************************************ + * Noncoherent sequence detection for wspr. * + * Allowed block lengths are nblock=1,2,3,6, or 9 symbols. * + * Longer block lengths require longer channel coherence time. * + * The whole block is estimated at once. * + * nblock=1 corresponds to noncoherent detection of individual symbols * + * like the original wsprd symbol demodulator. * + ************************************************************************/ + static float fplast=-10000.0; + static float dt=1.0/375.0, df=375.0/256.0; + static float pi=3.14159265358979323846; + float twopidt, df15=df*1.5, df05=df*0.5; + + int i, j, k, lag, itone, ib, b, nblock, nseq, imask; + float xi[512],xq[512]; + float is[4][162],qs[4][162],cf[4][162],sf[4][162],cm,sm,cmp,smp; + float p[512],fac,xm1,xm0; + float c0[257],s0[257],c1[257],s1[257],c2[257],s2[257],c3[257],s3[257]; + float dphi0, cdphi0, sdphi0, dphi1, cdphi1, sdphi1, dphi2, cdphi2, sdphi2, + dphi3, cdphi3, sdphi3; + float f0, fp, fsum=0.0, f2sum=0.0, fsymb[162]; + + twopidt=2*pi*dt; + f0=*f1; + lag=*shift1; + nblock=*nblocksize; + nseq=1<0) && (k>(nblock-1-ib); + itone=pr3[i+ib]+2*b; + xi[j]=xi[j]+is[itone][i+ib]*cm + qs[itone][i+ib]*sm; + xq[j]=xq[j]+qs[itone][i+ib]*cm - is[itone][i+ib]*sm; + cmp=cf[itone][i+ib]*cm - sf[itone][i+ib]*sm; + smp=sf[itone][i+ib]*cm + cf[itone][i+ib]*sm; + cm=cmp; sm=smp; + } + p[j]=xi[j]*xi[j]+xq[j]*xq[j]; + p[j]=sqrt(p[j]); + } + for (ib=0; ib xm1) xm1=p[j]; + } + if((j & imask)==0) { + if(p[j]>xm0) xm0=p[j]; + } + } + fsymb[i+ib]=xm1-xm0; + if( bitbybit == 1 ) { + fsymb[i+ib]=fsymb[i+ib]/(xm1 > xm0 ? xm1 : xm0); + } + } + } + for (i=0; i<162; i++) { //Normalize the soft symbols + fsum=fsum+fsymb[i]/162.0; + f2sum=f2sum+fsymb[i]*fsymb[i]/162.0; + } + fac=sqrt(f2sum-fsum*fsum); + for (i=0; i<162; i++) { + fsymb[i]=symfac*fsymb[i]/fac; + if( fsymb[i] > 127) fsymb[i]=127.0; + if( fsymb[i] < -128 ) fsymb[i]=-128.0; + symbols[i]=fsymb[i] + 128; + } + return; +} + +/*************************************************************************** + symbol-by-symbol signal subtraction + ****************************************************************************/ +void subtract_signal(float *id, float *qd, long np, + float f0, int shift0, float drift0, unsigned char* channel_symbols) +{ + float dt=1.0/375.0, df=375.0/256.0; + int i, j, k; + float pi=4.*atan(1.0),twopidt, fp; + + float i0,q0; + float c0[256],s0[256]; + float dphi, cdphi, sdphi; + + twopidt=2*pi*dt; + + for (i=0; i<162; i++) { + fp = f0 + ((float)drift0/2.0)*((float)i-81.0)/81.0; + + dphi=twopidt*(fp+((float)channel_symbols[i]-1.5)*df); + cdphi=cos(dphi); + sdphi=sin(dphi); + + c0[0]=1; s0[0]=0; + + for (j=1; j<256; j++) { + c0[j]=c0[j-1]*cdphi - s0[j-1]*sdphi; + s0[j]=c0[j-1]*sdphi + s0[j-1]*cdphi; + } + + i0=0.0; q0=0.0; + + for (j=0; j<256; j++) { + k=shift0+i*256+j; + if( (k>0) & (k0) & (k0) && (k(nsig-1-nfilt/2) ) { + norm=partialsum[nfilt/2+nsig-1-i]; + } else { + norm=1.0; + } + k=shift0+i; + j=i+nfilt; + if( (k>0) && (k=2 ? 1:0; + } + deinterleave(cw); + nerrors=0; + for (i=0; i<162; i++) { + is = symbols[i] > 127 ? 1:0; + nerrors = nerrors + (is == cw[i] ? 0:1); + } + return nerrors; +} + +//*************************************************************************** +void usage(void) +{ + printf("Usage: wsprd [options...] infile\n"); + printf(" infile must have suffix .wav or .c2\n"); + printf("\n"); + printf("Options:\n"); + printf(" -a path to writeable data files, default=\".\"\n"); + printf(" -B disable block demodulation - use single-symbol noncoherent demod\n"); + printf(" -c write .c2 file at the end of the first pass\n"); + printf(" -C maximum number of decoder cycles per bit, default 10000\n"); + printf(" -d deeper search. Slower, a few more decodes\n"); + printf(" -e x (x is transceiver dial frequency error in Hz)\n"); + printf(" -f x (x is transceiver dial frequency in MHz)\n"); + printf(" -H do not use (or update) the hash table\n"); + printf(" -J use the stack decoder instead of Fano decoder\n"); + printf(" -m decode wspr-15 .wav file\n"); + printf(" -o n (0<=n<=5), decoding depth for OSD, default is disabled\n"); + printf(" -q quick mode - doesn't dig deep for weak signals\n"); + printf(" -s single pass mode, no subtraction (same as original wsprd)\n"); + printf(" -v verbose mode (shows dupes)\n"); + printf(" -w wideband mode - decode signals within +/- 150 Hz of center\n"); + printf(" -z x (x is fano metric table bias, default is 0.45)\n"); +} + +//*************************************************************************** +int main(int argc, char *argv[]) +{ + char cr[] = "(C) 2018, Steven Franke - K9AN"; + (void)cr; + extern char *optarg; + extern int optind; + int i,j,k; + unsigned char *symbols, *decdata, *channel_symbols, *apmask, *cw; + signed char message[]={-9,13,-35,123,57,-39,64,0,0,0,0}; + char *callsign, *grid, *call_loc_pow; + char *ptr_to_infile,*ptr_to_infile_suffix; + char *data_dir="."; + char wisdom_fname[200],all_fname[200],spots_fname[200]; + char timer_fname[200],hash_fname[200]; + char uttime[5],date[7]; + int c,delta,maxpts=65536,verbose=0,quickmode=0,more_candidates=0, stackdecoder=0; + int usehashtable=1,wspr_type=2, ipass, nblocksize; + int nhardmin,ihash; + int writec2=0,maxdrift; + int shift1, lagmin, lagmax, lagstep, ifmin, ifmax, not_decoded; + unsigned int nbits=81, stacksize=200000; + struct snode * stack=NULL; + unsigned int npoints, cycles, maxnp, metric; + float df=375.0/256.0/2; + float fsymbs[162]; + float dt=1.0/375.0, dt_print; + double dialfreq_cmdline=0.0, dialfreq, freq_print; + double dialfreq_error=0.0; + float fmin=-110, fmax=110; + float f1, fstep, sync1, drift1; + float dmin; + float psavg[512]; + float *idat, *qdat; + clock_t t0,t00; + float tfano=0.0,treadwav=0.0,tcandidates=0.0,tsync0=0.0; + float tsync1=0.0,tsync2=0.0,tosd=0.0,ttotal=0.0; + + struct cand { float freq; float snr; int shift; float drift; float sync; }; + struct cand candidates[200]; + + struct result { char date[7]; char time[5]; float sync; float snr; + float dt; double freq; char message[23]; float drift; + unsigned int cycles; int jitter; int blocksize; unsigned int metric; + int nhardmin; int ipass; int decodetype;}; + struct result decodes[50]; + + char *hashtab; + hashtab=calloc(32768*13,sizeof(char)); + char *loctab; + loctab=calloc(32768*5,sizeof(char)); + int nh; + symbols=calloc(nbits*2,sizeof(unsigned char)); + apmask=calloc(162,sizeof(unsigned char)); + cw=calloc(162,sizeof(unsigned char)); + decdata=calloc(11,sizeof(unsigned char)); + channel_symbols=calloc(nbits*2,sizeof(unsigned char)); + callsign=calloc(13,sizeof(char)); + grid=calloc(5,sizeof(char)); + call_loc_pow=calloc(23,sizeof(char)); + float allfreqs[100]; + char allcalls[100][13]; + for (i=0; i<100; i++) allfreqs[i]=0.0; + memset(allcalls,0,sizeof(char)*100*13); + + int uniques=0, noprint=0, ndecodes_pass=0; + + // Parameters used for performance-tuning: + unsigned int maxcycles=10000; //Decoder timeout limit + float minsync1=0.10; //First sync limit + float minsync2=0.12; //Second sync limit + int iifac=8; //Step size in final DT peakup + int symfac=50; //Soft-symbol normalizing factor + int subtraction=1; + int npasses=3; + int ndepth=-1; //Depth for OSD + + float minrms=52.0 * (symfac/64.0); //Final test for plausible decoding + delta=60; //Fano threshold step + float bias=0.45; //Fano metric bias (used for both Fano and stack algorithms) + + t00=clock(); + fftwf_complex *fftin, *fftout; +#include "./metric_tables.c" + + int mettab[2][256]; + + idat=calloc(maxpts,sizeof(float)); + qdat=calloc(maxpts,sizeof(float)); + + while ( (c = getopt(argc, argv, "a:BcC:de:f:HJmo:qstwvz:")) !=-1 ) { + switch (c) { + case 'a': + data_dir = optarg; + break; + case 'B': + npasses=2; + break; + case 'c': + writec2=1; + break; + case 'C': + maxcycles=(unsigned int) strtoul(optarg,NULL,10); + break; + case 'd': + more_candidates=1; + break; + case 'e': + dialfreq_error = strtod(optarg,NULL); // units of Hz + // dialfreq_error = dial reading - actual, correct frequency + break; + case 'f': + dialfreq_cmdline = strtod(optarg,NULL); // units of MHz + break; + case 'H': + usehashtable = 0; + break; + case 'J': //Stack (Jelinek) decoder, Fano decoder is the default + stackdecoder = 1; + break; + case 'm': //15-minute wspr mode + wspr_type = 15; + break; + case 'o': //use ordered-statistics-decoder + ndepth=(int) strtol(optarg,NULL,10); + break; + case 'q': //no shift jittering + quickmode = 1; + break; + case 's': //single pass mode + subtraction = 0; + npasses = 1; + break; + case 'v': + verbose = 1; + break; + case 'w': + fmin=-150.0; + fmax=150.0; + break; + case 'z': + bias=strtod(optarg,NULL); //fano metric bias (default is 0.45) + break; + case '?': + usage(); + return 1; + } + } + + if( access(data_dir, R_OK | W_OK)) { + fprintf(stderr, "Error: inaccessible data directory: '%s'\n", data_dir); + usage(); + return EXIT_FAILURE; + } + + if( optind+1 > argc) { + usage(); + return 1; + } else { + ptr_to_infile=argv[optind]; + } + + if( stackdecoder ) { + stack=calloc(stacksize,sizeof(struct snode)); + } + + // setup metric table + for(i=0; i<256; i++) { + mettab[0][i]=round( 10*(metric_tables[2][i]-bias) ); + mettab[1][i]=round( 10*(metric_tables[2][255-i]-bias) ); + } + + FILE *fp_fftwf_wisdom_file, *fall_wspr, *fwsprd, *fhash, *ftimer; + strcpy(wisdom_fname,"."); + strcpy(all_fname,"."); + strcpy(spots_fname,"."); + strcpy(timer_fname,"."); + strcpy(hash_fname,"."); + if(data_dir != NULL) { + strncpy(wisdom_fname,data_dir, sizeof wisdom_fname); + strncpy(all_fname,data_dir, sizeof all_fname); + strncpy(spots_fname,data_dir, sizeof spots_fname); + strncpy(timer_fname,data_dir, sizeof timer_fname); + strncpy(hash_fname,data_dir, sizeof hash_fname); + } + strncat(wisdom_fname,"/wspr_wisdom.dat",20); + strncat(all_fname,"/ALL_WSPR.TXT",20); + strncat(spots_fname,"/wspr_spots.txt",20); + strncat(timer_fname,"/wspr_timer.out",20); + strncat(hash_fname,"/hashtable.txt",20); + if ((fp_fftwf_wisdom_file = fopen(wisdom_fname, "r"))) { //Open FFTW wisdom + fftwf_import_wisdom_from_file(fp_fftwf_wisdom_file); + fclose(fp_fftwf_wisdom_file); + } + + fall_wspr=fopen(all_fname,"a"); + fwsprd=fopen(spots_fname,"w"); + // FILE *fdiag; + // fdiag=fopen("wsprd_diag","a"); + + if((ftimer=fopen(timer_fname,"r"))) { + //Accumulate timing data + int nr=fscanf(ftimer,"%f %f %f %f %f %f %f %f", + &treadwav,&tcandidates,&tsync0,&tsync1,&tsync2,&tfano,&tosd,&ttotal); + fclose(ftimer); + if(nr == 0) fprintf(stderr, "Empty timer file: '%s'\n", timer_fname); + } + ftimer=fopen(timer_fname,"w"); + + if( strstr(ptr_to_infile,".wav") ) { + ptr_to_infile_suffix=strstr(ptr_to_infile,".wav"); + + t0 = clock(); + npoints=readwavfile(ptr_to_infile, wspr_type, idat, qdat); + treadwav += (float)(clock()-t0)/CLOCKS_PER_SEC; + + if( npoints == 1 ) { + return 1; + } + dialfreq=dialfreq_cmdline - (dialfreq_error*1.0e-06); + } else if ( strstr(ptr_to_infile,".c2") !=0 ) { + ptr_to_infile_suffix=strstr(ptr_to_infile,".c2"); + npoints=readc2file(ptr_to_infile, idat, qdat, &dialfreq, &wspr_type); + if( npoints == 1 ) { + return 1; + } + dialfreq -= (dialfreq_error*1.0e-06); + } else { + printf("Error: Failed to open %s\n",ptr_to_infile); + printf("WSPR file must have suffix .wav or .c2\n"); + return 1; + } + + // Parse date and time from given filename + strncpy(date,ptr_to_infile_suffix-11,6); + strncpy(uttime,ptr_to_infile_suffix-4,4); + date[6]='\0'; + uttime[4]='\0'; + + // Do windowed ffts over 2 symbols, stepped by half symbols + int nffts=4*floor(npoints/512)-1; + fftin=(fftwf_complex*) fftwf_malloc(sizeof(fftwf_complex)*512); + fftout=(fftwf_complex*) fftwf_malloc(sizeof(fftwf_complex)*512); + PLAN3 = fftwf_plan_dft_1d(512, fftin, fftout, FFTW_FORWARD, PATIENCE); + + float ps[512][nffts]; + float w[512]; + for(i=0; i<512; i++) { + w[i]=sin(0.006147931*i); + } + + if( usehashtable ) { + char line[80], hcall[13], hgrid[5]; + if( (fhash=fopen(hash_fname,"r+")) ) { + while (fgets(line, sizeof(line), fhash) != NULL) { + hgrid[0]='\0'; + sscanf(line,"%d %s %s",&nh,hcall,hgrid); + strcpy(hashtab+nh*13,hcall); + if(strlen(hgrid)>0) strcpy(loctab+nh*5,hgrid); + } + } else { + fhash=fopen(hash_fname,"w+"); + } + fclose(fhash); + } + + //*************** main loop starts here ***************** + for (ipass=0; ipass2) ipass=2; + if(ipass < 2) { + nblocksize=1; + maxdrift=4; + minsync2=0.12; + } + if(ipass == 2 ) { + nblocksize=4; // try 3 blocksizes plus bitbybit normalization + maxdrift=0; // no drift for smaller frequency estimator variance + minsync2=0.10; + } + ndecodes_pass=0; // still needed? + + for (i=0; i511 ) + k=k-512; + ps[j][i]=fftout[k][0]*fftout[k][0]+fftout[k][1]*fftout[k][1]; + } + } + + // Compute average spectrum + for (i=0; i<512; i++) psavg[i]=0.0; + for (i=0; ismspec[j-1]) && + (smspec[j]>smspec[j+1]) && + (npk<200); + if ( candidate ) { + candidates[npk].freq = (j-205)*df; + candidates[npk].snr = 10*log10(smspec[j])-snr_scaling_factor; + npk++; + } + } + if( more_candidates ) { + for(j=0; j<411; j=j+3) { + candidate = (smspec[j]>min_snr) && (npk<200); + if ( candidate ) { + candidates[npk].freq = (j-205)*df; + candidates[npk].snr = 10*log10(smspec[j])-snr_scaling_factor; + npk++; + } + } + } + + // Compute corrected fmin, fmax, accounting for dial frequency error + fmin += dialfreq_error; // dialfreq_error is in units of Hz + fmax += dialfreq_error; + + // Don't waste time on signals outside of the range [fmin,fmax]. + i=0; + for( j=0; j= fmin && candidates[j].freq <= fmax ) { + candidates[i]=candidates[j]; + i++; + } + } + npk=i; + + // bubble sort on snr + int pass; + struct cand tmp; + for (pass = 1; pass <= npk - 1; pass++) { + for (k = 0; k < npk - pass ; k++) { + if (candidates[k].snr < candidates[k+1].snr) { + tmp = candidates[k]; + candidates[k]=candidates[k+1]; + candidates[k+1] = tmp; + } + } + } + + t0=clock(); + + /* Make coarse estimates of shift (DT), freq, and drift + + * Look for time offsets up to +/- 8 symbols (about +/- 5.4 s) relative + to nominal start time, which is 2 seconds into the file + + * Calculates shift relative to the beginning of the file + + * Negative shifts mean that signal started before start of file + + * The program prints DT = shift-2 s + + * Shifts that cause sync vector to fall off of either end of the data + vector are accommodated by "partial decoding", such that missing + symbols produce a soft-decision symbol value of 128 + + * The frequency drift model is linear, deviation of +/- drift/2 over the + span of 162 symbols, with deviation equal to 0 at the center of the + signal vector. + */ + + int idrift,ifr,if0,ifd,k0; + int kindex; + float smax,ss,pow,p0,p1,p2,p3; + for(j=0; j= 0 && kindex < nffts ) { + p0=ps[ifd-3][kindex]; + p1=ps[ifd-1][kindex]; + p2=ps[ifd+1][kindex]; + p3=ps[ifd+3][kindex]; + + p0=sqrt(p0); + p1=sqrt(p1); + p2=sqrt(p2); + p3=sqrt(p3); + + ss=ss+(2*pr3[k]-1)*((p1+p3)-(p0+p2)); + pow=pow+p0+p1+p2+p3; + } + } + sync1=ss/pow; + if( sync1 > smax ) { //Save coarse parameters + smax=sync1; + candidates[j].shift=128*(k0+1); + candidates[j].drift=idrift; + candidates[j].freq=(ifr-256)*df; + candidates[j].sync=sync1; + } + } + } + } + } + tcandidates += (float)(clock()-t0)/CLOCKS_PER_SEC; + + /* + Refine the estimates of freq, shift using sync as a metric. + Sync is calculated such that it is a float taking values in the range + [0.0,1.0]. + + Function sync_and_demodulate has three modes of operation + mode is the last argument: + + 0 = no frequency or drift search. find best time lag. + 1 = no time lag or drift search. find best frequency. + 2 = no frequency or time lag search. Calculate soft-decision + symbols using passed frequency and shift. + + NB: best possibility for OpenMP may be here: several worker threads + could each work on one candidate at a time. + */ + for (j=0; jminsync1 continue + fstep=0.0; ifmin=0; ifmax=0; + lagmin=shift1-128; + lagmax=shift1+128; + lagstep=64; + t0 = clock(); + sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1, + lagmin, lagmax, lagstep, &drift1, symfac, &sync1, 0); + tsync0 += (float)(clock()-t0)/CLOCKS_PER_SEC; + + fstep=0.25; ifmin=-2; ifmax=2; + t0 = clock(); + sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1, + lagmin, lagmax, lagstep, &drift1, symfac, &sync1, 1); + + if(ipass < 2) { + // refine drift estimate + fstep=0.0; ifmin=0; ifmax=0; + float driftp,driftm,syncp,syncm; + driftp=drift1+0.5; + sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1, + lagmin, lagmax, lagstep, &driftp, symfac, &syncp, 1); + + driftm=drift1-0.5; + sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1, + lagmin, lagmax, lagstep, &driftm, symfac, &syncm, 1); + + if(syncp>sync1) { + drift1=driftp; + sync1=syncp; + } else if (syncm>sync1) { + drift1=driftm; + sync1=syncm; + } + } + tsync1 += (float)(clock()-t0)/CLOCKS_PER_SEC; + + // fine-grid lag and freq search + if( sync1 > minsync1 ) { + + lagmin=shift1-32; lagmax=shift1+32; lagstep=16; + t0 = clock(); + sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1, + lagmin, lagmax, lagstep, &drift1, symfac, &sync1, 0); + tsync0 += (float)(clock()-t0)/CLOCKS_PER_SEC; + + // fine search over frequency + fstep=0.05; ifmin=-2; ifmax=2; + t0 = clock(); + sync_and_demodulate(idat, qdat, npoints, symbols, &f1, ifmin, ifmax, fstep, &shift1, + lagmin, lagmax, lagstep, &drift1, symfac, &sync1, 1); + tsync1 += (float)(clock()-t0)/CLOCKS_PER_SEC; + + candidates[j].freq=f1; + candidates[j].shift=shift1; + candidates[j].drift=drift1; + candidates[j].sync=sync1; + } + } + + int nwat=0; + int idupe; + for ( j=0; j candidates[k].sync) candidates[k]=candidates[j]; + } else if ( candidates[j].sync > minsync2 ) { + candidates[nwat]=candidates[j]; + nwat++; + } + } + + int idt, ii, jittered_shift; + float y,sq,rms; + int ib, blocksize, bitmetric; + int n1,n2,n3,nadd,nu,ntype; + int osd_decode; + for (j=0; j minrms) { + deinterleave(symbols); + t0 = clock(); + + if ( stack ) { + not_decoded = jelinek(&metric, &cycles, decdata, symbols, nbits, + stacksize, stack, mettab,maxcycles); + } else { + not_decoded = fano(&metric,&cycles,&maxnp,decdata,symbols,nbits, + mettab,delta,maxcycles); + } + + tfano += (float)(clock()-t0)/CLOCKS_PER_SEC; + + if( (ndepth >= 0) && not_decoded ) { + for(i=0; i<162; i++) { + fsymbs[i]=symbols[i]-128.0; + } + t0 = clock(); + osdwspr_(fsymbs,apmask,&ndepth,cw,&nhardmin,&dmin); + tosd += (float)(clock()-t0)/CLOCKS_PER_SEC; + + for(i=0; i<162; i++) { + symbols[i]=255*cw[i]; + } + fano(&metric,&cycles,&maxnp,decdata,symbols,nbits, + mettab,delta,maxcycles); + for(i=0; i<11; i++) { + if( decdata[i]>127 ) { + message[i]=decdata[i]-256; + } else { + message[i]=decdata[i]; + } + } + unpack50(message,&n1,&n2); + if( !unpackcall(n1,callsign) ) break; + callsign[12]=0; + if( !unpackgrid(n2, grid) ) break; + grid[4]=0; + ntype = (n2&127) - 64; + int itype; + if( (ntype >= 0) && (ntype <= 62) ) { + nu = ntype%10; + itype=1; + if( !(nu == 0 || nu == 3 || nu == 7) ) { + nadd=nu; + if( nu > 3 ) nadd=nu-3; + if( nu > 7 ) nadd=nu-7; + n3=n2/128+32768*(nadd-1); + if( !unpackpfx(n3,callsign) ) { + break; + } + itype=2; + } + ihash=nhash(callsign,strlen(callsign),(uint32_t)146); + if(strncmp(hashtab+ihash*13,callsign,13)==0) { + if( (itype==1 && strncmp(loctab+ihash*5,grid,5)==0) || + (itype==2) ) { + not_decoded=0; + osd_decode =1; + } + } + } + } + + } + idt++; + if( quickmode ) break; + } + ib++; + } + + if( !not_decoded ) { + ndecodes_pass++; + + for(i=0; i<11; i++) { + + if( decdata[i]>127 ) { + message[i]=decdata[i]-256; + } else { + message[i]=decdata[i]; + } + + } + + // Unpack the decoded message, update the hashtable, apply + // sanity checks on grid and power, and return + // call_loc_pow string and also callsign (for de-duping). + noprint=unpk_(message,hashtab,loctab,call_loc_pow,callsign); + if( subtraction && !noprint ) { + if( get_wspr_channel_symbols(call_loc_pow, hashtab, loctab, channel_symbols) ) { + subtract_signal2(idat, qdat, npoints, f1, shift1, drift1, channel_symbols); + if(!osd_decode) nhardmin=count_hard_errors(symbols,channel_symbols); + } else { + break; + } + } + + // Remove dupes (same callsign and freq within 4 Hz) + int dupe=0; + for (i=0; i decodes[k+1].freq) { + temp = decodes[k]; + decodes[k]=decodes[k+1];; + decodes[k+1] = temp; + } + } + } + + for (i=0; i\n"); + + fftwf_free(fftin); + fftwf_free(fftout); + + if ((fp_fftwf_wisdom_file = fopen(wisdom_fname, "w"))) { + fftwf_export_wisdom_to_file(fp_fftwf_wisdom_file); + fclose(fp_fftwf_wisdom_file); + } + + ttotal += (float)(clock()-t00)/CLOCKS_PER_SEC; + + fprintf(ftimer,"%7.2f %7.2f %7.2f %7.2f %7.2f %7.2f %7.2f %7.2f\n\n", + treadwav,tcandidates,tsync0,tsync1,tsync2,tfano,tosd,ttotal); + + fprintf(ftimer,"Code segment Seconds Frac\n"); + fprintf(ftimer,"-----------------------------------\n"); + fprintf(ftimer,"readwavfile %7.2f %7.2f\n",treadwav,treadwav/ttotal); + fprintf(ftimer,"Coarse DT f0 f1 %7.2f %7.2f\n",tcandidates, + tcandidates/ttotal); + fprintf(ftimer,"sync_and_demod(0) %7.2f %7.2f\n",tsync0,tsync0/ttotal); + fprintf(ftimer,"sync_and_demod(1) %7.2f %7.2f\n",tsync1,tsync1/ttotal); + fprintf(ftimer,"sync_and_demod(2) %7.2f %7.2f\n",tsync2,tsync2/ttotal); + fprintf(ftimer,"Stack/Fano decoder %7.2f %7.2f\n",tfano,tfano/ttotal); + fprintf(ftimer,"OSD decoder %7.2f %7.2f\n",tosd,tosd/ttotal); + fprintf(ftimer,"-----------------------------------\n"); + fprintf(ftimer,"Total %7.2f %7.2f\n",ttotal,1.0); + + fclose(fall_wspr); + fclose(fwsprd); + // fclose(fdiag); + fclose(ftimer); + fftwf_destroy_plan(PLAN1); + fftwf_destroy_plan(PLAN2); + fftwf_destroy_plan(PLAN3); + + if( usehashtable ) { + fhash=fopen(hash_fname,"w"); + for (i=0; i<32768; i++) { + if( strncmp(hashtab+i*13,"\0",1) != 0 ) { + fprintf(fhash,"%5d %s %s\n",i,hashtab+i*13,loctab+i*5); + } + } + fclose(fhash); + } + + free(hashtab); + free(loctab); + free(symbols); + free(decdata); + free(channel_symbols); + free(callsign); + free(call_loc_pow); + free(idat); + free(qdat); + free(stack); + + return 0; +} diff --git a/wsjtx_lib/lib/wsprd/wsprd_stats.txt b/wsjtx_lib/lib/wsprd/wsprd_stats.txt new file mode 100644 index 0000000..0d925aa --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprd_stats.txt @@ -0,0 +1,24 @@ + Linux Windows +Program Time Decodes Time Decodes +------------------------------------------------- +wsprd (Mar 2013) 2413 1451 2718 1451 + +k9an-wsprd 1800 2122 +k9an_wsprd -q 354 1939 + +wsprd 399 2190 356 2190 +wsprd -q 214 2034 192 2034 + +wsprd* 1240 2215 +wsprd# 1599 2220 + +------------------------------------------------- +* maxcycles=30000 +# maxcycles=20000, iifac=1 +------------------------------------------------- +Test data: 638 *.wav files (recorded by WSJT-X) +------------------------------------------------- +Linux machine: Core 2 Duo, E6750 CPU +Windows machine: 4-Core i5-2500 CPU +wsprd git commit: eecc274 +------------------------------------------------- diff --git a/wsjtx_lib/lib/wsprd/wsprd_utils.c b/wsjtx_lib/lib/wsprd/wsprd_utils.c new file mode 100644 index 0000000..64e809f --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprd_utils.c @@ -0,0 +1,340 @@ +/* + This file is part of program wsprd, a detector/demodulator/decoder + for the Weak Signal Propagation Reporter (WSPR) mode. + + File name: wsprd_utils.c + + Copyright 2001-2015, Joe Taylor, K1JT + + Most of the code is based on work by Steven Franke, K9AN, which + in turn was based on earlier work by K1JT. + + Copyright 2014-2015, Steven Franke, K9AN + + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + */ +#include "wsprd_utils.h" + +#ifndef int32_t +#define int32_t int +#endif + +void unpack50( signed char *dat, int32_t *n1, int32_t *n2 ) +{ + int32_t i,i4; + + i=dat[0]; + i4=i&255; + *n1=i4<<20; + + i=dat[1]; + i4=i&255; + *n1=*n1+(i4<<12); + + i=dat[2]; + i4=i&255; + *n1=*n1+(i4<<4); + + i=dat[3]; + i4=i&255; + *n1=*n1+((i4>>4)&15); + *n2=(i4&15)<<18; + + i=dat[4]; + i4=i&255; + *n2=*n2+(i4<<10); + + i=dat[5]; + i4=i&255; + *n2=*n2+(i4<<2); + + i=dat[6]; + i4=i&255; + *n2=*n2+((i4>>6)&3); +} + +int unpackcall( int32_t ncall, char *call ) +{ + char c[]={'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E', + 'F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T', + 'U','V','W','X','Y','Z',' '}; + int32_t n; + int i; + char tmp[7]; + + n=ncall; + strcpy(call,"......"); + if (n < 262177560 ) { + i=n%27+10; + tmp[5]=c[i]; + n=n/27; + i=n%27+10; + tmp[4]=c[i]; + n=n/27; + i=n%27+10; + tmp[3]=c[i]; + n=n/27; + i=n%10; + tmp[2]=c[i]; + n=n/10; + i=n%36; + tmp[1]=c[i]; + n=n/36; + i=n; + tmp[0]=c[i]; + tmp[6]='\0'; + // remove leading whitespace + for(i=0; i<5; i++) { + if( tmp[i] != c[36] ) + break; + } + sprintf(call,"%-6s",&tmp[i]); + // remove trailing whitespace + for(i=0; i<6; i++) { + if( call[i] == c[36] ) { + call[i]='\0'; + } + } + } else { + return 0; + } + return 1; +} + +int unpackgrid( int32_t ngrid, char *grid) +{ + char c[]={'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E', + 'F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T', + 'U','V','W','X','Y','Z',' '}; + int dlat, dlong; + + ngrid=ngrid>>7; + if( ngrid < 32400 ) { + dlat=(ngrid%180)-90; + dlong=(ngrid/180)*2 - 180 + 2; + if( dlong < -180 ) + dlong=dlong+360; + if( dlong > 180 ) + dlong=dlong+360; + int nlong = 60.0*(180.0-dlong)/5.0; + int n1 = nlong/240; + int n2 = (nlong - 240*n1)/24; + grid[0] = c[10+n1]; + grid[2]= c[n2]; + + int nlat = 60.0*(dlat+90)/2.5; + n1 = nlat/240; + n2 = (nlat-240*n1)/24; + grid[1]=c[10+n1]; + grid[3]=c[n2]; + } else { + strcpy(grid,"XXXX"); + return 0; + } + return 1; +} + +int unpackpfx( int32_t nprefix, char *call) +{ + char nc, pfx[4]={'\0'}, tmpcall[7]; + int i; + int32_t n; + + strcpy(tmpcall,call); + if( nprefix < 60000 ) { + // add a prefix of 1 to 3 characters + n=nprefix; + for (i=2; i>=0; i--) { + nc=n%37; + if( (nc >= 0) & (nc <= 9) ) { + pfx[i]=nc+48; + } + else if( (nc >= 10) & (nc <= 35) ) { + pfx[i]=nc+55; + } + else { + pfx[i]=' '; + } + n=n/37; + } + + char * p = strrchr(pfx,' '); + strcpy(call, p ? p + 1 : pfx); + strncat(call,"/",1); + strncat(call,tmpcall,strlen(tmpcall)); + + } else { + // add a suffix of 1 or 2 characters + nc=nprefix-60000; + if( (nc >= 0) & (nc <= 9) ) { + pfx[0]=nc+48; + strcpy(call,tmpcall); + strncat(call,"/",1); + strncat(call,pfx,1); + } + else if( (nc >= 10) & (nc <= 35) ) { + pfx[0]=nc+55; + strcpy(call,tmpcall); + strncat(call,"/",1); + strncat(call,pfx,1); + } + else if( (nc >= 36) & (nc <= 125) ) { + pfx[0]=(nc-26)/10+48; + pfx[1]=(nc-26)%10+48; + strcpy(call,tmpcall); + strncat(call,"/",1); + strncat(call,pfx,2); + } + else { + return 0; + } + } + return 1; +} + +void deinterleave(unsigned char *sym) +{ + unsigned char tmp[162]; + unsigned char p, i, j; + + p=0; + i=0; + while (p<162) { + j=((i * 0x80200802ULL) & 0x0884422110ULL) * 0x0101010101ULL >> 32; + if (j < 162 ) { + tmp[p]=sym[j]; + p=p+1; + } + i=i+1; + } + for (i=0; i<162; i++) { + sym[i]=tmp[i]; + } +} + +// used by qsort +int doublecomp(const void* elem1, const void* elem2) +{ + if(*(const double*)elem1 < *(const double*)elem2) + return -1; + return *(const double*)elem1 > *(const double*)elem2; +} + +int floatcomp(const void* elem1, const void* elem2) +{ + if(*(const float*)elem1 < *(const float*)elem2) + return -1; + return *(const float*)elem1 > *(const float*)elem2; +} + +int unpk_(signed char *message, char *hashtab, char *loctab, char *call_loc_pow, char *callsign) +{ + int n1,n2,n3,ndbm,ihash,nadd,noprint=0; + char grid[5],grid6[7],cdbm[4]; + + unpack50(message,&n1,&n2); + if( !unpackcall(n1,callsign) ) return 1; + if( !unpackgrid(n2, grid) ) return 1; + int ntype = (n2&127) - 64; + callsign[12]=0; + grid[4]=0; + + /* + Based on the value of ntype, decide whether this is a Type 1, 2, or + 3 message. + + * Type 1: 6 digit call, grid, power - ntype is positive and is a member + of the set {0,3,7,10,13,17,20...60} + + * Type 2: extended callsign, power - ntype is positive but not + a member of the set of allowed powers + + * Type 3: hash, 6 digit grid, power - ntype is negative. + */ + + if( (ntype >= 0) && (ntype <= 62) ) { + int nu=ntype%10; + if( nu == 0 || nu == 3 || nu == 7 ) { + ndbm=ntype; + memset(call_loc_pow,0,sizeof(char)*23); + sprintf(cdbm,"%2d",ndbm); + strncat(call_loc_pow,callsign,strlen(callsign)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,grid,4); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,cdbm,2); + strncat(call_loc_pow,"\0",1); + ihash=nhash(callsign,strlen(callsign),(uint32_t)146); + strcpy(hashtab+ihash*13,callsign); + strcpy(loctab+ihash*5,grid); + } else { + nadd=nu; + if( nu > 3 ) nadd=nu-3; + if( nu > 7 ) nadd=nu-7; + n3=n2/128+32768*(nadd-1); + if( !unpackpfx(n3,callsign) ) return 1; + ndbm=ntype-nadd; + memset(call_loc_pow,0,sizeof(char)*23); + sprintf(cdbm,"%2d",ndbm); + strncat(call_loc_pow,callsign,strlen(callsign)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,cdbm,2); + strncat(call_loc_pow,"\0",1); + int nu=ndbm%10; + if( nu == 0 || nu == 3 || nu == 7 || nu == 10 ) { //make sure power is OK + ihash=nhash(callsign,strlen(callsign),(uint32_t)146); + strcpy(hashtab+ihash*13,callsign); + } else noprint=1; + } + } else if ( ntype < 0 ) { + ndbm=-(ntype+1); + memset(grid6,0,sizeof(char)*7); +// size_t len=strlen(callsign); + size_t len=6; + strncat(grid6,callsign+len-1,1); + strncat(grid6,callsign,len-1); + int nu=ndbm%10; + if ((nu != 0 && nu != 3 && nu != 7 && nu != 10) || + !isalpha(grid6[0]) || !isalpha(grid6[1]) || + !isdigit(grid6[2]) || !isdigit(grid6[3])) { + // not testing 4'th and 5'th chars because of this case: JO33 40 + // grid is only 4 chars even though this is a hashed callsign... + // isalpha(grid6[4]) && isalpha(grid6[5]) ) ) { + noprint=1; + } + + ihash=(n2-ntype-64)/128; + if( strncmp(hashtab+ihash*13,"\0",1) != 0 ) { + sprintf(callsign,"<%s>",hashtab+ihash*13); + } else { + sprintf(callsign,"%5s","<...>"); + } + + memset(call_loc_pow,0,sizeof(char)*23); + sprintf(cdbm,"%2d",ndbm); + strncat(call_loc_pow,callsign,strlen(callsign)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,grid6,strlen(grid6)); + strncat(call_loc_pow," ",1); + strncat(call_loc_pow,cdbm,2); + strncat(call_loc_pow,"\0",1); + + + // I don't know what to do with these... They show up as "A000AA" grids. + if( ntype == -64 ) noprint=1; + } + return noprint; +} diff --git a/wsjtx_lib/lib/wsprd/wsprd_utils.h b/wsjtx_lib/lib/wsprd/wsprd_utils.h new file mode 100644 index 0000000..db6ba94 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprd_utils.h @@ -0,0 +1,29 @@ +#ifndef WSPRD_UTILS_H +#define WSPRD_UTILS_H + +#include +#include +#include +#include +#include +#include +#include +#include "nhash.h" + +void unpack50( signed char *dat, int32_t *n1, int32_t *n2 ); + +int unpackcall( int32_t ncall, char *call ); + +int unpackgrid( int32_t ngrid, char *grid); + +int unpackpfx( int32_t nprefix, char *call); + +void deinterleave(unsigned char *sym); + +// used by qsort +int doublecomp(const void* elem1, const void* elem2); +int floatcomp(const void* elem1, const void* elem2); + +int unpk_( signed char *message, char* hashtab, char* loctab, char *call_loc_pow, char *callsign); + +#endif diff --git a/wsjtx_lib/lib/wsprd/wsprsim.c b/wsjtx_lib/lib/wsprd/wsprsim.c new file mode 100644 index 0000000..f6633c1 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprsim.c @@ -0,0 +1,212 @@ +/* + File name: wsprsim.c (first committed to wsjtx June 13, 2015) + */ +#include +#include +#include +#include + +#include "wsprsim_utils.h" +#include "wsprd_utils.h" +#include "fano.h" + +int printdata=0; + +void usage() { + printf("Usage: wsprsim [options] message\n"); + printf(" message format: \"K1ABC FN42 33\"\n"); + printf(" \"PJ4/K1ABC 33\"\n"); + printf(" \" FK52UD 33\"\n"); + printf("Options:\n"); + printf(" -c (print channel symbols)\n"); + printf(" -d (print packed data with zero tail - 11 bytes)\n"); + printf(" -f x (-100 Hz < f < 100 Hz)\n"); + printf(" -o filename (write a c2 file with this name)\n"); + printf(" -s x (x is snr of signal that is written to .c2 file)\n"); + printf("\n"); + printf(" e.g. ./wsprsim -cds -28 -o 150613_1920.c2 \"K1ABC FN42 33\"\n"); + printf(" then ./wsprd 150613_1920.c2\n"); +} + +int add_signal_vector(float f0, float t0, float amp, unsigned char* symbols + , double* isig, double* qsig) +{ + int i, j, ii, idelay; + double phi=0.0, twopidt, df, dt, dphi; + twopidt=8.0*atan(1.0)/375.0; + df=375.0/256.0; + dt=1/375.0; + idelay=t0/dt; + + for (i=0; i<162; i++) { + dphi=twopidt*(f0 + ( (double)symbols[i]-1.5)*df ); + for ( j=0; j<256; j++ ) { + ii=idelay+256*i+j; + isig[ii]=isig[ii]+amp*cos(phi); + qsig[ii]=qsig[ii]+amp*sin(phi); + phi=phi+dphi; + } + } + return 1; +} + +char* tobinary(int x) +{ + static char b[33]; + b[0] = '\0'; + + long unsigned int z; + for (z = 0x80000000; z > 0; z >>= 1) + { + strcat(b, ((x & z) == z) ? "1" : "0"); + } + + return b; +} + +double gaussrand() +{ + static double V1, V2, S; + static int phase = 0; + double X; + + if(phase == 0) { + do { + double U1 = (double)rand() / RAND_MAX; + double U2 = (double)rand() / RAND_MAX; + + V1 = 2 * U1 - 1; + V2 = 2 * U2 - 1; + S = V1 * V1 + V2 * V2; + } while(S >= 1 || S == 0); + + X = V1 * sqrt(-2 * log(S) / S); + } else + X = V2 * sqrt(-2 * log(S) / S); + + phase = 1 - phase; + + return X; +} + +unsigned long writec2file(char *c2filename, int trmin, double freq + , double *idat, double *qdat) +{ + int i; + float buffer[2*45000]; + memset(buffer,0,sizeof(float)*2*45000); + FILE *fp; + + fp = fopen(c2filename,"wb"); + if( fp == NULL ) { + fprintf(stderr, "Could not open c2 file '%s'\n", c2filename); + return 0; + } + unsigned long nwrite = fwrite(c2filename,sizeof(char),14,fp); + nwrite = fwrite(&trmin, sizeof(int), 1, fp); + nwrite = fwrite(&freq, sizeof(double), 1, fp); + + for(i=0; i<45000; i++) { + buffer[2*i]=idat[i]; + buffer[2*i+1]=-qdat[i]; + } + + nwrite = fwrite(buffer, sizeof(float), 2*45000, fp); + if( nwrite == 2*45000 ) { + return nwrite; + } else { + return 0; + } +} + + +//******************************************************************** +int main(int argc, char *argv[]) +{ + extern char *optarg; + extern int optind; + int i, c, printchannel=0, writec2=0; + float snr=50.0; + float f0=0.0, t0=1.0; + char *message, *c2filename, *hashtab, *loctab; + c2filename=malloc(sizeof(char)*15); + hashtab=malloc(sizeof(char)*32768*13); + loctab=malloc(sizeof(char)*32768*5); + memset(hashtab,0,sizeof(char)*32768*13); + memset(hashtab,0,sizeof(char)*32768*5); + + // message length is 22 characters + message=malloc(sizeof(char)*23); + + strcpy(c2filename,"000000_0001.c2"); + + srand(getpid()); + + while ( (c = getopt(argc, argv, "cdf:o:s:")) !=-1 ) { + switch (c) { + case 'c': + printchannel=1; + break; + case 'd': + printdata=1; + break; + case 'f': + f0 = atof(optarg); + break; + case 'o': + c2filename = optarg; + writec2=1; + break; + case 's': +// snr = (float)atoi(optarg); + snr = atof(optarg); + break; + } + } + + if( optind+1 > argc ) { + usage(); + return 0; + } else { + message=argv[optind]; + } + + unsigned char channel_symbols[162]; + get_wspr_channel_symbols(message, hashtab, loctab, channel_symbols); + + if( printchannel ) { + printf("Channel symbols:\n"); + for (i=0; i<162; i++) { + printf("%d ",channel_symbols[i]); + } + printf("\n"); + } + + // add noise, then signal + double isig[45000], qsig[45000]; + memset(isig,0,sizeof(double)*45000); + memset(qsig,0,sizeof(double)*45000); + + if( snr < 40 ) { + // snr in 375Hz is 8.2 dB higher than in 2500 Hz. + snr=snr+8.2; + snr=pow(10,snr/20.0)*pow(2,0.5); + + for (i = 0; i<45000; i++) { + isig[i]=isig[i]+gaussrand(); + qsig[i]=qsig[i]+gaussrand(); + } + } else { + snr=1.0; + } + + add_signal_vector(f0, t0, snr, channel_symbols, isig, qsig); + if( writec2) { + // write a .c2 file + double carrierfreq=10.1387; + int wsprtype=2; + printf("Writing %s\n",c2filename); + writec2file(c2filename, wsprtype, carrierfreq, isig, qsig); + } + return 1; +} diff --git a/wsjtx_lib/lib/wsprd/wsprsim_utils.c b/wsjtx_lib/lib/wsprd/wsprsim_utils.c new file mode 100644 index 0000000..0130a87 --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprsim_utils.c @@ -0,0 +1,312 @@ +/* + Functions used by wsprsim + */ +#include "wsprsim_utils.h" +#include "wsprd_utils.h" +#include "nhash.h" +#include "fano.h" + +static char get_locator_character_code(char ch); +static char get_callsign_character_code(char ch); +static long unsigned int pack_grid4_power(char const *grid4, int power); +static long unsigned int pack_call(char const *callsign); +static void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd ); +static void interleave(unsigned char *sym); + +char get_locator_character_code(char ch) { + if( ch >=48 && ch <=57 ) { //0-9 + return ch-48; + } + if( ch == 32 ) { //space + return 36; + } + if( ch >= 65 && ch <= 82 ) { //A-Z + return ch-65; + } + return -1; +} + +char get_callsign_character_code(char ch) { + if( ch >=48 && ch <=57 ) { //0-9 + return ch-48; + } + if( ch == 32 ) { //space + return 36; + } + if( ch >= 65 && ch <= 90 ) { //A-Z + return ch-55; + } + return -1; +} + +long unsigned int pack_grid4_power(char const *grid4, int power) { + long unsigned int m; + + m=(179-10*grid4[0]-grid4[2])*180+10*grid4[1]+grid4[3]; + m=m*128+power+64; + return m; +} + +long unsigned int pack_call(char const *callsign) { + unsigned int i; + long unsigned int n; + char call6[6]; + memset(call6,' ',sizeof(call6)); + // callsign is 6 characters in length. Exactly. + size_t call_len = strlen(callsign); + if( call_len > 6 ) { + return 0; + } + if( isdigit(callsign[2]) ) { + for (i=0; i= 48 && nc <= 57 ) { + *m=nc-48; + } else if ( nc >= 65 && nc <= 90 ) { + *m=nc-65+10; + } else { + *m=38; + } + *m=60000-32768+*m; + } else if( callsign[i1+3]==0 ) { + //two char suffix + for (i=0; i= 48 && nc <= 57 ) { + nc=nc-48; + } else if ( nc >= 65 && nc <= 90 ) { + nc=nc-65+10; + } else { + nc=36; + } + *m=37*(*m)+nc; + } + *nadd=0; + if( *m > 32768 ) { + *m=*m-32768; + *nadd=1; + } + } + free (call6); +} + +void interleave(unsigned char *sym) +{ + unsigned char tmp[162]; + unsigned char p, i, j; + + p=0; + i=0; + while (p<162) { + j=((i * 0x80200802ULL) & 0x0884422110ULL) * 0x0101010101ULL >> 32; + if (j < 162 ) { + tmp[j]=sym[p]; + p=p+1; + } + i=i+1; + } + for (i=0; i<162; i++) { + sym[i]=tmp[i]; + } +} + +int get_wspr_channel_symbols(char* rawmessage, char* hashtab, char* loctab, unsigned char* symbols) { + int m=0, ntype=0; + long unsigned int n=0; + int i, j, ihash; + unsigned char pr3[162]= + {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}; + int nu[10]={0,-1,1,0,-1,2,1,0,-1,1}; + char *callsign, *grid, *powstr; + char grid4[5], message[23]; + + memset(message,0,sizeof(char)*23); + i=0; + while ( rawmessage[i] != 0 && i<23 ) { + message[i]=rawmessage[i]; + i++; + } + + size_t i1=strcspn(message," "); + size_t i2=strcspn(message,"/"); + size_t i3=strcspn(message,"<"); + size_t i4=strcspn(message,">"); + size_t mlen=strlen(message); + + // Use the presence and/or absence of "<" and "/" to decide what + // type of message. No sanity checks! Beware! + + if( i1 >= 3 && i1 < 7 && i2 == mlen && i3 == mlen ) { + // Type 1 message: K9AN EN50 33 + // xxnxxxx xxnn nn + callsign = strtok(message," "); + grid = strtok(NULL," "); + powstr = strtok(NULL," "); + int power = atoi(powstr); + n = pack_call(callsign); + + for (i=0; i<4; i++) { + grid4[i]=get_locator_character_code(*(grid+i)); + } + m = pack_grid4_power(grid4,power); + + } else if ( i3 == 0 && i4 < mlen ) { + // Type 3: EN50WC 33 + // FK52UD 37 + // send hash instead of callsign to make room for 6 char grid. + // if 4-digit locator is specified, 2 spaces are added to the end. + callsign=strtok(message,"<> "); + grid=strtok(NULL," "); + powstr=strtok(NULL," "); + int power = atoi(powstr); + if( power < 0 ) power=0; + if( power > 60 ) power=60; + power=power+nu[power%10]; + ntype=-(power+1); + ihash=nhash(callsign,strlen(callsign),(uint32_t)146); + m=128*ihash + ntype + 64; + + char grid6[7]; + memset(grid6,0,sizeof(char)*7); + j=strlen(grid); + for(i=0; istrlen(callsign) ) return 0; //guards against pathological case + powstr = strtok (NULL," "); + int power = atoi (powstr); + if( power < 0 ) power=0; + if( power > 60 ) power=60; + power=power+nu[power%10]; + int n1, ng, nadd; + pack_prefix(callsign, &n1, &ng, &nadd); + ntype=power + 1 + nadd; + m=128*ng+ntype+64; + n=n1; + } else { + return 0; + } + + // pack 50 bits + 31 (0) tail bits into 11 bytes + unsigned char it, data[11]; + memset(data,0,sizeof(char)*11); + it=0xFF & (n>>20); + data[0]=it; + it=0xFF & (n>>12); + data[1]=it; + it=0xFF & (n>>4); + data[2]=it; + it= ((n&(0x0F))<<4) + ((m>>18)&(0x0F)); + data[3]=it; + it=0xFF & (m>>10); + data[4]=it; + it=0xFF & (m>>2); + data[5]=it; + it=(m & 0x03)<<6 ; + data[6]=it; + data[7]=0; + data[8]=0; + data[9]=0; + data[10]=0; + + if( printdata ) { + printf("Data is :"); + for (i=0; i<11; i++) { + printf("%02X ",data[i]); + } + printf("\n"); + } + + // make sure that the 11-byte data vector is unpackable + // unpack it with the routine that the decoder will use and display + // the result. let the operator decide whether it worked. + + char *check_call_loc_pow, *check_callsign; + check_call_loc_pow=malloc(sizeof(char)*23); + check_callsign=malloc(sizeof(char)*13); + signed char check_data[11]; + memcpy(check_data,data,sizeof(char)*11); + + unpk_(check_data,hashtab,loctab,check_call_loc_pow,check_callsign); +// printf("Will decode as: %s\n",check_call_loc_pow); + + unsigned int nbytes=11; // The message with tail is packed into almost 11 bytes. + unsigned char channelbits[nbytes*8*2]; /* 162 rounded up */ + memset(channelbits,0,sizeof(char)*nbytes*8*2); + + encode(channelbits,data,nbytes); + + interleave(channelbits); + + for (i=0; i<162; i++) { + symbols[i]=2*channelbits[i]+pr3[i]; + } + free(check_call_loc_pow); + free(check_callsign); + return 1; +} diff --git a/wsjtx_lib/lib/wsprd/wsprsim_utils.h b/wsjtx_lib/lib/wsprd/wsprsim_utils.h new file mode 100644 index 0000000..7f1f62e --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprsim_utils.h @@ -0,0 +1,16 @@ +#ifndef WSPRSIM_UTILS_H +#define WSPRSIM_UTILS_H + +#include +#include +#include +#include +#include +#include +#include + +extern int printdata; + +int get_wspr_channel_symbols(char* message, char* hashtab, char*loctab, unsigned char* symbols); + +#endif diff --git a/wsjtx_lib/lib/wsprd/wsprsimf.f90 b/wsjtx_lib/lib/wsprd/wsprsimf.f90 new file mode 100644 index 0000000..d6ee25d --- /dev/null +++ b/wsjtx_lib/lib/wsprd/wsprsimf.f90 @@ -0,0 +1,113 @@ +!------------------------------------------------------------------------------- +! +! 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 diff --git a/wsjtx_lib/lib/xcall.txt b/wsjtx_lib/lib/xcall.txt new file mode 100644 index 0000000..8ace434 --- /dev/null +++ b/wsjtx_lib/lib/xcall.txt @@ -0,0 +1,268 @@ +2E0DGP IO83 +5P6MJ JO54 +AA2UK FM29 +AA4HV EM55 +AA4QE EM78 +AA7UN DN32 +AB6BT CM88 +AB9QZ EN41 +AC4VM EM78 +AC9QI EN52 +AD0PL EM48 +AD9H EN61 +AF5NP EM10 +AF7M DM42 +AG4QX EL87 +AH0U CM97 +AK3Q EM79 +CC6IJM FO03 +CE4SFG FF45 +CF7GEM CN89 +CO2DC EL83 +CO2ER EL83 +CO2YQ EL83 +CO3LT EL93 +CT1FIU IN50 +CT7AEL IM69 +CU2DX HM77 +DL5UZ JN49 +DL6BEN JO44 +EA1AAE IN81 +EA5IGV IM99 +EA5ISK IM99 +EA5WO IM99 +EA5YI IM99 +EA7OM IM87 +EB3ENW JN11 +F6CAX JO00 +F6GCP JN18 +G4IUA IO91 +GI4FUE IO74 +HK2PMR FJ29 +HK4SAN FJ26 +HK6JCF FJ25 +I3FGX JN55 +IK2DJV JN45 +IK5BSC JN53 +IK8IJN JM78 +IN3BJS JN55 +IS0FWY JM49 +IU8CNE JN71 +IW4EJK JN54 +JA9AVA PM86 +JA9LJS PM86 +JR3IIR PM74 +K0AY FN20 +K1BMW CM99 +K1GG EM97 +K1HTV FM18 +K1VOI FN32 +K2AK DM41 +K2RMA EM90 +K2SST EM85 +K2TE EL98 +K3DBD FN20 +K3ZGA EL98 +K4DL EM63 +K4ELI EM74 +K4OP EM77 +K4SHQ EM64 +K5CIA EM12 +K5EJ EM45 +K5KLA EL49 +K5RCD EL09 +K5RWD EL09 +K5WP EM71 +K6JQ CM88 +K6MKF CM97 +K6RIM CM87 +K6SJT DM13 +K7CAH CN87 +K7NN DM42 +K7VNE DM43 +K9LRE EM57 +K9PY EN61 +KA1AQP FN42 +KA4RSZ EM73 +KA5JTM EL29 +KA6A EM13 +KA8TBW EN61 +KA9KQH EM59 +KB2M EL99 +KB5IKR EM70 +KC6AWX CM88 +KC9H EN62 +KC9UPE EN53 +KC9WIB EN61 +KC9WNZ EM48 +KD9E EM58 +KE0HQZ EN12 +KE0N EN34 +KE7HHW DN13 +KF4ZLO EM78 +KG5GCC EM50 +KG6TT CM88 +KG7GPM DN17 +KI7JFH CN85 +KI7MT DN46 +KK0M CM97 +KK6PTO DM14 +KM2J EL87 +KM4DDJ EM76 +KM4PJJ EM72 +KN1SIX EM90 +KN4CRD EM73 +KN9TVE EN52 +KO4PU EM67 +KP2L EM93 +KP4KD EL95 +KP4PR FK68 +KP4SX FK78 +KR6EN EM59 +KS0CW FM16 +KS4OT EM83 +KW4HT EM64 +LA5SJA KQ50 +LU6UBM FF84 +LU8AFR GF05 +LU8DQS GF05 +LU8EKC GF05 +LV7QFH EM95 +LZ1OI KN22 +M0LVL IO84 +M0OIC IO92 +M6RUG IO83 +MI0KOA IO74 +MM0LGS IO85 +N0BAK EN34 +N1SER EM90 +N2BJ EN61 +N2PPI FN30 +N3HI DM03 +N3MK FM27 +N4HYK EL87 +N4LAG EM85 +N4MKA EM84 +N5AYB EL17 +N5BCA EM12 +N5BSA EM12 +N5SLY EM13 +N6GP DM13 +N6OJ CM88 +N6PM DM13 +N6QQ DM03 +N6UK DM14 +N7IP DN26 +N7IY CN84 +N7NT DM43 +N7ZO CN85 +N8EHW EN81 +N8HMG EN91 +N8JAF EM89 +N9MUF EN51 +N9NTC EN53 +NA6L DM12 +NE6I DM12 +NN3V DM13 +NQ6F DM12 +NS2X EM76 +NU4T EM74 +NV8B EN63 +NX8Y EN80 +NY4I EL87 +ON3BZ JO20 +ON3EA JO21 +ON3LMA JO20 +ON7ZV JO20 +OT1V JO20 +OX6EYS LB60 +OZ1FHU JO55 +PA2GP JO33 +PD0LH JO22 +PD9BG JO21 +PE2K JO22 +PR7MB HI22 +PY2LK GG66 +PY2RJ GG66 +PY2XIZ GG66 +PY2YZB GG66 +PY4OY GG78 +PY7BC HI21 +RW0SR OO22 +SM6THE JO68 +SV2WT KN10 +TI4DJ EK70 +UT7QF KN77 +VA3DAZ EN82 +VA3LU EN58 +VE7AHT CN89 +VE9GJ FN77 +W0OGH DM52 +W0TW EN74 +W0YF EN11 +W1PFZ FN42 +W2HRO FN20 +W2PKY EL88 +W3BI FN20 +W3BS EM55 +W3KM FN20 +W3MR FM18 +W4EIS EM13 +W4GE FM02 +W4JSI EM64 +W4SFG EM74 +W4WYI EM83 +W5JPT EM11 +W5ZTX EL29 +W6AER CM87 +W6AUN DM79 +W6NWS FM05 +W6RYO DM08 +W7AUF CN85 +W7CT DN41 +W7DMC CN85 +W7SUR DM49 +W7VP CN87 +W8AKS EM97 +W8FHF EN90 +W8HC EM98 +W8MSC EN82 +W8OI EM88 +W8RES EM79 +W8WEJ EM99 +W8WKE EL16 +W9CTH EM69 +W9EO DM04 +W9WB EN51 +W9YSX EM79 +WA0LIF EN35 +WA1SXK EM95 +WA2HIP FN54 +WA4MIT EM63 +WA4VJK EM66 +WA6PHR CM94 +WA7DVD DN40 +WA9DU EM69 +WA9EIC EN60 +WA9JWL EN70 +WA9NNN EN61 +WB2JEP DM33 +WB2KSP FN31 +WB2REM EL97 +WB3FSR FN20 +WB5OZA EM30 +WB5TKI EL29 +WB5UDI EM20 +WB5XX EM33 +WB7UZO CN78 +WD4KAV CN87 +WD5IQR EM10 +WE5EE EL49 +WL7CG BP61 +WP4NSE FK68 +WS5W EM13 +WV5Y EL29 +WV8DOH EM99 +WV9L EM59 +WW7B DM33 +YV5BM FK60 diff --git a/wsjtx_lib/lib/xcor.f90 b/wsjtx_lib/lib/xcor.f90 new file mode 100644 index 0000000..8393773 --- /dev/null +++ b/wsjtx_lib/lib/xcor.f90 @@ -0,0 +1,76 @@ +!subroutine xcor(ss,ipk,nsteps,nsym,lag1,lag2,ccf,ccf0,lagpk,flip,fdot,nrobust) +subroutine xcor(ipk,nsteps,nsym,lag1,lag2,ccf,ccf0,lagpk,flip,fdot,nrobust) + +! Computes ccf of a row of ss and the pseudo-random array pr. Returns +! peak of the CCF and the lag at which peak occurs. For JT65, the +! CCF peak may be either positive or negative, with negative implying +! the "OOO" message. + + use jt65_mod + parameter (NHMAX=3413) !Max length of power spectra + parameter (NSMAX=552) !Max number of quarter-symbol steps + real ss(NSMAX,NHMAX) !2d spectrum, stepped by half-symbols + real a(NSMAX) +! real ccf(-44:118) + real ccf(lag1:lag2) + data lagmin/0/ !Silence g77 warning +! save + common/sync/ss + + df=12000.0/8192. +! dtstep=0.5/df + dtstep=0.25/df + fac=dtstep/(60.0*df) + do j=1,nsteps + ii=nint((j-nsteps/2)*fdot*fac)+ipk + if( (ii.ge.1) .and. (ii.le.NHMAX) ) then + a(j)=ss(j,ii) + endif + enddo + + if(nrobust.eq.1) then +! use robust correlation estimator to mitigate AGC attack spikes at beginning +! this reduces the number of spurious candidates overall + call pctile(a,nsteps,50,xmed) + do j=1,nsteps + if( a(j).ge.xmed ) then + a(j)=1 + else + a(j)=-1 + endif + enddo + endif + + ccfmax=0. + ccfmin=0. + do lag=lag1,lag2 + x=0. + do i=1,nsym + j=4*i-3+lag + if(j.ge.1 .and. j.le.nsteps) x=x+a(j)*pr(i) + enddo + ccf(lag)=2*x !The 2 is for plotting scale + if(ccf(lag).gt.ccfmax) then + ccfmax=ccf(lag) + lagpk=lag + endif + + if(ccf(lag).lt.ccfmin) then + ccfmin=ccf(lag) + lagmin=lag + endif + enddo + + ccf0=ccfmax + flip=1.0 + if(-ccfmin.gt.ccfmax) then + do lag=lag1,lag2 + ccf(lag)=-ccf(lag) + enddo + lagpk=lagmin + ccf0=-ccfmin + flip=-1.0 + endif + + return +end subroutine xcor diff --git a/wsjtx_lib/lib/xcor4.f90 b/wsjtx_lib/lib/xcor4.f90 new file mode 100644 index 0000000..fa9c201 --- /dev/null +++ b/wsjtx_lib/lib/xcor4.f90 @@ -0,0 +1,95 @@ +subroutine xcor4(s2,ipk,nsteps,nsym,lag1,lag2,ich,mode4,ccf,ccf0, & + lagpk,flip) + +! Computes ccf of the 4_FSK spectral array s2 and the pseudo-random +! array pr2. Returns peak of CCF and the lag at which peak occurs. +! The CCF peak may be either positive or negative, with negative +! implying the "OOO" message. + + parameter (NHMAX=1260) !Max length of power spectra + parameter (NSMAX=525) !Max number of half-symbol steps + real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols + real a(NSMAX) + real ccf(-5:540) + integer nch(7) + integer npr2(207) + real pr2(207) + logical first + data lagmin/0/ !Silence compiler warning + data first/.true./ + data npr2/ & + 0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, & + 0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, & + 1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, & + 0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, & + 0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, & + 0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, & + 1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/ + data nch/1,2,4,9,18,36,72/ + save + + if(first) then + do i=1,207 + pr2(i)=2*npr2(i)-1 + enddo + first=.false. + endif + + ccfmax=0. + ccfmin=0. + nw=nch(min(max(ich,1),7)) + + do j=1,nsteps + n=2*mode4 + if(mode4.eq.1) then + a(j)=max(s2(ipk+n,j),s2(ipk+3*n,j)) - max(s2(ipk ,j),s2(ipk+2*n,j)) + else + kz=max(1,nw/2) + ss0=0. + ss1=0. + ss2=0. + ss3=0. + wsum=0. + do k=-kz+1,kz-1 + w=float(kz-iabs(k))/nw + wsum=wsum+w + ss0=ss0 + w*s2(ipk +k,j) + ss1=ss1 + w*s2(ipk+ n+k,j) + ss2=ss2 + w*s2(ipk+2*n+k,j) + ss3=ss3 + w*s2(ipk+3*n+k,j) + enddo + a(j)=(max(ss1,ss3) - max(ss0,ss2))/sqrt(wsum) + endif + enddo + + do lag=lag1,lag2 + x=0. + do i=1,nsym + j=2*i-1+lag + if(j.ge.1 .and. j.le.nsteps) x=x+a(j)*pr2(i) + enddo + ccf(lag)=2*x !The 2 is for plotting scale + if(ccf(lag).gt.ccfmax) then + ccfmax=ccf(lag) + lagpk=lag + endif + + if(ccf(lag).lt.ccfmin) then + ccfmin=ccf(lag) + lagmin=lag + endif + enddo + + ccf0=ccfmax + flip=1.0 + if(-ccfmin.gt.ccfmax) then + do lag=lag1,lag2 + ccf(lag)=-ccf(lag) + enddo + lagpk=lagmin + ccf0=-ccfmin + flip=-1.0 + endif + + return +end subroutine xcor4 diff --git a/wsjtx_lib/lib/zplot9.f90 b/wsjtx_lib/lib/zplot9.f90 new file mode 100644 index 0000000..6c56c9f --- /dev/null +++ b/wsjtx_lib/lib/zplot9.f90 @@ -0,0 +1,31 @@ +subroutine zplot9(s,freq,drift) + + real s(0:8,85) + character*1 line(85),mark(0:6) + data mark/' ',' ','.','-','+','X','$'/ + include 'jt9sync.f90' + + write(32,1000) freq,drift +1000 format('Freq:',f7.1,' Drift:',f5.1,' ',60('-')) + do j=8,0,-1 + do i=1,85 + n=(s(j,i)) + if(n.lt.0) n=0 + if(n.gt.6) n=6 + line(i)=mark(n) + enddo + write(32,1010) j,line +1010 format(i1,1x,85a1) + enddo + do i=1,85 + line(i)=' ' + if(isync(i).eq.1) line(i)='@' + enddo + write(32,1015) +1015 format(87('-')) + write(32,1020) line +1020 format(2x,85a1) + call flush(32) + + return +end subroutine zplot9 diff --git a/wsjtx_lib/lib/zplt.f90 b/wsjtx_lib/lib/zplt.f90 new file mode 100644 index 0000000..a7f6e57 --- /dev/null +++ b/wsjtx_lib/lib/zplt.f90 @@ -0,0 +1,112 @@ +subroutine zplt(z,iplt,sync,dtx,nfreq,flip,sync2,nplot,emedelay,dttol, & + nfqso,ntol) + + real z(458,65) + real zz(458,65) + integer ij(2) + character*4 lab + + call pctile(z,458*65,84,rms) + fac=0.05/rms + z=fac*z + dtq=0.114286 + df=11025.0/(2.0*2520.0) + + ia=nint((nfqso-ntol)/df) - 273 + if(ia.lt.1) ia=1 + ib=nint((nfqso+ntol)/df) - 273 + if(ib.gt.458) ib=458 + ja=(emedelay+0.8-dttol)/dtq + if(ja.lt.1) ja=1 + jb=(emedelay+0.8+dttol)/dtq + if(jb.gt.65) jb=65 + + zz=0. + zz(ia:ib,ja:jb)=z(ia:ib,ja:jb) + + zmin=minval(zz) + zmax=maxval(zz) + flip=1.0 + if(abs(zmin).gt.abs(zmax)) flip=-1.0 + + ij=maxloc(zz) + if(flip.lt.0.0) ij=minloc(zz) + i0=ij(1) + j0=ij(2) + nfreq=nint((i0+273)*df) + dtx=j0*dtq-0.8 +! write(69,3101) ia,ib,ja,jb,ij,dtx,nfreq +!3101 format(6i5,f8.2,i6) + + ia=max(1,i0-72) + ib=min(458,i0+72) + sync=16.33*flip*(z(i0,j0) - 0.5*(z(ia,j0)+z(ib,j0))) + sync2=20.0*flip*z(i0,j0) + + if(nplot.eq.0) go to 900 + + zmax=max(abs(zmin),abs(zmax),1.0) + zmin=-zmax + + do j=1,65 + write(61,1100) j*dtq-0.8,z(i0,j) +1100 format(2f10.3) + enddo + + do i=1,458 + write(62,1100) (i+273)*df,flip*z(i,j0) + enddo + + xx=1.5 + yy=7.5 - 3.0*iplt + width=6.0 + height=2.0 + IP=458 + JP=65 + imax=IP + jmax=JP + + if(iplt.eq.0) then + call imopen("testjt4.ps") + call imfont("Helvetica",16) + call impalette("BlueRed.pal") + endif + + call imr4mat_color(z,IP,JP,imax,jmax,zmin,zmax,xx,yy, & + width,height,1) + call imstring("Frequency (Hz)",xx+0.5*width,yy-0.5,2,0) + dy=0.1 + do i=1,9 + x=xx + 0.1*i*width + call imyline(x,yy,dy) + call imyline(x,yy+height,-dy) + enddo + do i=1,6 + nf=(i-1)*200 + 600 + write(lab,1020) nf +1020 format(i4) + x=xx + (i-1)*0.2*width + call imstring(lab,x,yy-0.25,2,0) + enddo + + dx=0.1 + do i=0,6 + y=yy + height*(0.8+i)/(65.0*0.114286) + call imxline(xx,y,dx) + call imxline(xx+width,y,-dx) + enddo + + do i=0,6,2 + y=yy + height*(0.8+i)/(65.0*0.114286) + write(lab,1020) i + call imstring(lab(4:4),xx-0.15,y-0.08,2,0) + enddo + + y=yy + height*(3.8)/(65.0*0.114286) + call imstring("DT", xx-0.5,y ,2,0) + call imstring("(s)",xx-0.5,y-0.25,2,0) + + if(iplt.eq.2) call imclose + +900 return +end subroutine zplt diff --git a/wsjtx_lib/wsjtx_decode.cpp b/wsjtx_lib/wsjtx_decode.cpp new file mode 100644 index 0000000..38b2734 --- /dev/null +++ b/wsjtx_lib/wsjtx_decode.cpp @@ -0,0 +1,275 @@ +#include "wsjtx_lib.h" +#include "wsjtx_decode.h" +#include +#include +#include +#include +#include +#include +#include +#include + +static thread_local DataQueue* s_currentQueue = nullptr; +void wsjtx_set_message_queue(DataQueue* q) { s_currentQueue = q; } + +namespace { +constexpr int MSK144_SAMPLE_RATE = 12000; +constexpr int MSK144_BLOCK_SIZE = 7168; +constexpr int MSK144_STEP_SIZE = MSK144_BLOCK_SIZE / 2; +constexpr int MSK144_MAX_12K_SAMPLES = 30 * MSK144_SAMPLE_RATE; + +int current_nutc() +{ + auto now = std::chrono::system_clock::now(); + time_t tt = std::chrono::system_clock::to_time_t(now); + tm local_tm = *localtime(&tt); + return local_tm.tm_hour * 10000 + local_tm.tm_min * 100 + local_tm.tm_sec; +} + +std::string trim_copy(const std::string &s) +{ + const auto first = s.find_first_not_of(" \t\r\n\0", 0); + if (first == std::string::npos) return {}; + const auto last = s.find_last_not_of(" \t\r\n\0"); + return s.substr(first, last - first + 1); +} + +short int float_to_i16(float v) +{ + const int x = static_cast(std::lround(std::max(-1.0f, std::min(1.0f, v)) * 32768.0f)); + return static_cast(std::max(-32768, std::min(32767, x))); +} + +IntWsjTxVector msk144_samples_from_float(const WsjTxVector &samples) +{ + IntWsjTxVector out; + if (samples.size() > MSK144_MAX_12K_SAMPLES && samples.size() >= 4) { + out.reserve(samples.size() / 4); + for (size_t i = 0; i + 3 < samples.size(); i += 4) { + const float avg = 0.25f * (samples[i] + samples[i + 1] + samples[i + 2] + samples[i + 3]); + out.push_back(float_to_i16(avg)); + } + } else { + out.reserve(samples.size()); + for (float sample : samples) out.push_back(float_to_i16(sample)); + } + return out; +} + +IntWsjTxVector msk144_samples_from_int16(const IntWsjTxVector &samples) +{ + IntWsjTxVector out; + if (samples.size() > MSK144_MAX_12K_SAMPLES && samples.size() >= 4) { + out.reserve(samples.size() / 4); + for (size_t i = 0; i + 3 < samples.size(); i += 4) { + const int avg = static_cast(std::lround( + 0.25 * (samples[i] + samples[i + 1] + samples[i + 2] + samples[i + 3]))); + out.push_back(static_cast(std::max(-32768, std::min(32767, avg)))); + } + } else { + out = samples; + } + return out; +} + +void copy_fortran_call(char *dst, size_t len, const std::string &src) +{ + std::memset(dst, ' ', len); + std::memcpy(dst, src.data(), std::min(len, src.size())); +} + +std::string fortran_line_to_string(const char *line, size_t len) +{ + const void *zero = std::memchr(line, '\0', len); + const size_t used = zero ? static_cast(zero) - line : len; + return trim_copy(std::string(line, used)); +} + +bool parse_msk144_line(const std::string &line, WsjtxMessage &msg) +{ + if (line.size() < 24 || line.find("DecodeFinished") != std::string::npos) return false; + try { + const int nutc = std::stoi(line.substr(0, 6)); + const int snr = std::stoi(line.substr(6, 4)); + const float dt = std::stof(line.substr(10, 5)); + const int freq = std::stoi(line.substr(15, 5)); + const std::string text = trim_copy(line.substr(24, 37)); + if (text.empty()) return false; + msg = WsjtxMessage(nutc / 10000, (nutc / 100) % 100, nutc % 100, snr, dt, freq, text); + return true; + } catch (...) { + return false; + } +} +} + +extern "C" { + +void wsjtx_decoded_(int *nutc, int *snr, float *dt, int *freq, char *decoded, int len) +{ + char message[38]; + std::strncpy(message, decoded, 37); + message[37] = '\0'; + for (int i = 37; i != 0; i--) { + if (message[i] == ' ' || message[i] == '\0') message[i] = '\0'; + else break; + } + if (!strstr(message, "DecodeFinished") && s_currentQueue) { + s_currentQueue->push(WsjtxMessage(*nutc / 10000, (*nutc / 100) % 100, *nutc % 100, *snr, *dt, *freq, std::string(message))); + } +} + +void wsjtx_decoded_fst4_(int *nutc, float *sync, int *snr, float *dt, float *freq, char *decoded, int len) +{ + char message[38]; + std::strncpy(message, decoded, 37); + message[37] = '\0'; + for (int i = 37; i != 0; i--) { + if (message[i] == ' ' || message[i] == '\0') message[i] = '\0'; + else break; + } + if (!strstr(message, "DecodeFinished") && s_currentQueue) { + s_currentQueue->push(WsjtxMessage(*nutc / 10000, (*nutc / 100) % 100, *nutc % 100, *snr, *sync, *dt, *freq, std::string(message))); + } +} +} + +void wstjx_decode::setDxInfo(const std::string& call, const std::string& grid) { + dx_call_ = call; + dx_grid_ = grid; +} +void wstjx_decode::setStationInfo(const std::string& myCall, const std::string& myGrid, + const std::string& dxCall, const std::string& dxGrid) { + my_call_ = myCall; + my_grid_ = myGrid; + dx_call_ = dxCall; + dx_grid_ = dxGrid; +} +void wstjx_decode::setDecodeRange(int low, int high, int tol) { nfa_ = low; nfb_ = high; ntol_ = tol; } +void wstjx_decode::setDecodeControls(bool apDecode, int decodeDepth, int txFrequency, int qsoProgress) { + ap_decode_ = apDecode; + decode_depth_ = decodeDepth < 1 ? 1 : decodeDepth; + tx_frequency_ = txFrequency; + qso_progress_ = qsoProgress < 0 ? 0 : qsoProgress; +} + +void wstjx_decode::decode(wsjtxMode mode, WsjTxVector &audiosamples, int freq, int threads) +{ + if (mode == MSK144) { + decode_msk144(msk144_samples_from_float(audiosamples), freq, threads); + return; + } + + samplebuffer.push(std::move(audiosamples)); + std::memset(¶ms, 0, sizeof(params)); + params.nmode = 8; params.ntrperiod = 60.0; params.nQSOProgress = qso_progress_; + params.nfqso = freq; params.nftx = tx_frequency_; + params.newdat = true; params.npts8 = 74736; params.nfa = nfa_; + params.nfSplit = 2700; params.nfb = nfb_; params.ntol = ntol_; + params.kin = 64800; params.nzhsym = 79; params.nsubmode = 0; + params.nagain = false; params.ndepth = decode_depth_; params.lft8apon = ap_decode_; + params.lapcqonly = false; params.ljt65apon = true; params.napwid = 75; + params.ntxmode = 65; params.nmode = 8; params.minw = 0; + params.nclearave = false; params.minSync = 0; params.emedelay = 0.0; + params.dttol = 3; params.nlist = 0; params.listutc[0] = '\0'; + params.n2pass = 2; params.nranera = 6; params.naggressive = 0; + params.nrobust = false; params.nexp_decode = 0; + if (!my_call_.empty()) std::strncpy(params.mycall, my_call_.c_str(), sizeof(params.mycall) - 1); + if (!my_grid_.empty()) std::strncpy(params.mygrid, my_grid_.c_str(), sizeof(params.mygrid) - 1); + if (!dx_call_.empty()) std::strncpy(params.hiscall, dx_call_.c_str(), sizeof(params.hiscall) - 1); + if (!dx_grid_.empty()) std::strncpy(params.hisgrid, dx_grid_.c_str(), sizeof(params.hisgrid) - 1); + switch (mode) { + case FT8: params.nmode = 8; break; + case FT4: params.nmode = 5; break; + default: return; + } + int nfsample = 12000; + for (size_t i = 0; i < audiosamples.size(); i++) + dec_data.d2[i] = (short int)(audiosamples[i] * 32768.0f); + auto now = std::chrono::system_clock::now(); + time_t tt = std::chrono::system_clock::to_time_t(now); + tm local_tm = *localtime(&tt); + params.nutc = local_tm.tm_hour * 10000 + local_tm.tm_min * 100 + local_tm.tm_sec; + fftwf_plan_with_nthreads(threads); + multimode_decoder_(dec_data.ss, dec_data.d2, ¶ms, &nfsample); +} + +void wstjx_decode::decode(wsjtxMode mode, IntWsjTxVector &audiosamples, int freq, int threads) +{ + if (mode == MSK144) { + decode_msk144(msk144_samples_from_int16(audiosamples), freq, threads); + return; + } + + std::memset(¶ms, 0, sizeof(params)); + params.nmode = 8; params.ntrperiod = 60.0; params.nQSOProgress = qso_progress_; + params.nfqso = freq; params.nftx = tx_frequency_; + params.newdat = true; params.npts8 = 74736; params.nfa = nfa_; + params.nfSplit = 2700; params.nfb = nfb_; params.ntol = ntol_; + params.kin = 64800; params.nzhsym = 50; params.nsubmode = 0; + params.nagain = false; params.ndepth = decode_depth_; params.lft8apon = ap_decode_; + params.lapcqonly = false; params.ljt65apon = true; params.napwid = 75; + params.ntxmode = 65; + switch (mode) { + case FT8: params.nmode = 8; break; + case FT4: params.nmode = 5; break; + default: return; + } + params.minw = 0; params.nclearave = false; params.minSync = 0; + params.emedelay = 0.0; params.dttol = 3; params.nlist = 0; + params.listutc[0] = '\0'; params.n2pass = 2; params.nranera = 6; + params.naggressive = 0; params.nrobust = false; params.nexp_decode = 0; + if (!my_call_.empty()) std::strncpy(params.mycall, my_call_.c_str(), sizeof(params.mycall) - 1); + if (!my_grid_.empty()) std::strncpy(params.mygrid, my_grid_.c_str(), sizeof(params.mygrid) - 1); + if (!dx_call_.empty()) std::strncpy(params.hiscall, dx_call_.c_str(), sizeof(params.hiscall) - 1); + if (!dx_grid_.empty()) std::strncpy(params.hisgrid, dx_grid_.c_str(), sizeof(params.hisgrid) - 1); + int nfsample = 12000; + for (size_t i = 0; i < audiosamples.size(); i++) + dec_data.d2[i] = (short int)audiosamples[i]; + auto now = std::chrono::system_clock::now(); + time_t tt = std::chrono::system_clock::to_time_t(now); + tm local_tm = *localtime(&tt); + params.nutc = local_tm.tm_hour * 10000 + local_tm.tm_min * 100 + local_tm.tm_sec; + fftwf_plan_with_nthreads(threads); + multimode_decoder_(dec_data.ss, dec_data.d2, ¶ms, &nfsample); +} + +void wstjx_decode::decode_msk144(const IntWsjTxVector &audiosamples, int freq, int threads) +{ + if (audiosamples.size() < MSK144_BLOCK_SIZE) return; + + int nutc = current_nutc(); + int ntol = ntol_; + int nrxfreq = freq; + int ndepth = decode_depth_; + bool bshmsg = true; + bool btrain = false; + bool bswl = false; + double pcoeffs[5] = {0.0, 0.0, 0.0, 0.0, 0.0}; + char mycall[12]; + char hiscall[12]; + char datadir[500]; + char line[80]; + short int block[MSK144_BLOCK_SIZE]; + + copy_fortran_call(mycall, sizeof(mycall), my_call_); + copy_fortran_call(hiscall, sizeof(hiscall), dx_call_); + std::memset(datadir, ' ', sizeof(datadir)); + datadir[0] = '.'; + + fftwf_plan_with_nthreads(threads); + for (size_t pos = 0; pos + MSK144_BLOCK_SIZE <= audiosamples.size(); pos += MSK144_STEP_SIZE) { + std::copy_n(audiosamples.data() + pos, MSK144_BLOCK_SIZE, block); + std::memset(line, 0, sizeof(line)); + float tsec = static_cast(pos) / MSK144_SAMPLE_RATE; + + mskrtd_(block, &nutc, &tsec, &ntol, &nrxfreq, &ndepth, + mycall, hiscall, &bshmsg, &btrain, pcoeffs, &bswl, + datadir, line, 12, 12, 500, 80); + + WsjtxMessage msg; + if (s_currentQueue && parse_msk144_line(fortran_line_to_string(line, sizeof(line)), msg)) { + s_currentQueue->push(msg); + } + } +} diff --git a/wsjtx_lib/wsjtx_decode.h b/wsjtx_lib/wsjtx_decode.h new file mode 100644 index 0000000..d4c9aa2 --- /dev/null +++ b/wsjtx_lib/wsjtx_decode.h @@ -0,0 +1,32 @@ +#pragma once +#include +#include "DataBuffer.h" +#include "commons.h" +#include "fortran_interface.h" +#include "wsjtx_lib.h" + +void wsjtx_set_message_queue(DataQueue* q); + +class wstjx_decode +{ + public: + void decode(wsjtxMode mode, WsjTxVector &audiosamples, int freq, int threads = 1); + void decode(wsjtxMode mode, IntWsjTxVector &audiosamples, int freq, int threads = 1); + void setDxInfo(const std::string& call, const std::string& grid); + void setStationInfo(const std::string& myCall, const std::string& myGrid, + const std::string& dxCall, const std::string& dxGrid); + void setDecodeRange(int low, int high, int tol); + void setDecodeControls(bool apDecode, int decodeDepth, int txFrequency, int qsoProgress); + private: + void decode_msk144(const IntWsjTxVector &audiosamples, int freq, int threads); + params_t params; + DataBuffer samplebuffer; + dec_data_t dec_data; + int nfa_ = 200, nfb_ = 4000, ntol_ = 20; + bool ap_decode_ = true; + int decode_depth_ = 1; + int tx_frequency_ = 0; + int qso_progress_ = 0; + std::string my_call_, my_grid_; + std::string dx_call_, dx_grid_; +}; diff --git a/wsjtx_lib/wsjtx_encode.cpp b/wsjtx_lib/wsjtx_encode.cpp new file mode 100644 index 0000000..1aa2ba1 --- /dev/null +++ b/wsjtx_lib/wsjtx_encode.cpp @@ -0,0 +1,128 @@ +#include "wsjtx_encode.h" +#include "DataBuffer.h" +#include "commons.h" +#include "fortran_interface.h" +#include +#include +#include + +std::vector wsjtx_encode::encode_ft8(wsjtxMode mode, int frequency, std::string message, std::string &msgsent) +{ + std::vector signal; + + int i3 = 0; + int n3 = 0; + char ft8msgbits[77]; + + std::memset(msg, 0, 38); + std::memset(sendmsg, 0, 38); + std::copy_n(message.c_str(), std::min(message.size(), 37), msg); + genft8_(msg, &i3, &n3, sendmsg, const_cast(ft8msgbits), + const_cast(itone), 37, 37); + sendmsg[37] = '\0'; + msgsent = std::string(sendmsg); + + int nsym = FT8_NN; + printf("FSK tones: "); + for (int j = 0; j < nsym; ++j) + { + printf("%d", itone[j]); + } + printf("\n"); + + nsps = 4 * 1920; + fsample = 48000.0; + bt = 2.0; + icmplx = 0; + nwave = nsym * nsps; + f0 = frequency; + + signal.clear(); + signal.resize(nwave); + gen_ft8wave_(const_cast(itone), &nsym, &nsps, &bt, &fsample, &f0, signal.data(), + signal.data(), &icmplx, &nwave); + printf("ft8 frequency %4.0f number of tones %d, samplerate %6.0f no samples %d\n", f0, nsym, fsample, nwave); + //save_wav(signal.data(), signal.size(), FT8_SAMPLERATE, "./wave.wav"); + return signal; +} + +//void genft4_(char *msg, int *ichk, char *msgsent, char ft4msgbits[], int itone[], +// fortran_charlen_t, fortran_charlen_t); + +std::vector wsjtx_encode::encode_ft4(wsjtxMode mode, int frequency, std::string message, std::string &msgsent) +{ + int ichk = 0; + char ft4msgbits[101]; + std::vector signal; + + std::memset(msg, 0, 38); + std::memset(sendmsg, 0, 38); + std::copy_n(message.c_str(), std::min(message.size(), 37), msg); + genft4_(msg, &ichk, sendmsg, const_cast(ft4msgbits), const_cast(itone), 37, 37); + sendmsg[37] = '\0'; + msgsent = std::string(sendmsg); + + int nsym = 103; + int nsps = 4 * 576; + float fsample = 48000.0; + float f0 = frequency; //ui->TxFreqSpinBox->value() - m_XIT; + int nwave = (nsym + 2) * nsps; + int icmplx = 0; + + printf("FSK tones: "); + for (int j = 0; j < nsym; ++j) + { + printf("%d", itone[j]); + } + printf("\n"); + + signal.clear(); + signal.resize(nwave); + gen_ft4wave_(const_cast(itone), &nsym, &nsps, &fsample, &f0, signal.data(), + signal.data(), &icmplx, &nwave); + printf("ft4 frequency %d number of tones %d, samplerate %6.0f no samples %d\n", frequency, nsym, fsample, nwave); + return signal; +} + +std::vector wsjtx_encode::encode_msk144(wsjtxMode mode, int frequency, std::string message, std::string &msgsent) +{ + std::vector signal; + int ichk = 0; + int itype = 1; + + std::memset(msg, 0, 38); + std::memset(sendmsg, 0, 38); + std::fill_n(itone, MAX_NUM_SYMBOLS, 0); + std::copy_n(message.c_str(), std::min(message.size(), 37), msg); + genmsk_128_90_(msg, &ichk, sendmsg, const_cast(itone), &itype, 37, 37); + sendmsg[37] = '\0'; + msgsent = std::string(sendmsg); + if (itype < 1 || itype > 7) return signal; + + const int nsym = itone[40] < 0 ? 40 : 144; + const double sampleRate = 48000.0; + const double baud = 2000.0; + const int samplesPerSymbol = static_cast(sampleRate / baud); + const int numSamples = static_cast(15.0 * sampleRate); + const double twoPi = 8.0 * std::atan(1.0); + const double dphi0 = twoPi * (static_cast(frequency) - 0.25 * baud) / sampleRate; + const double dphi1 = twoPi * (static_cast(frequency) + 0.25 * baud) / sampleRate; + double phi = 0.0; + + signal.resize(numSamples); + for (int i = 0; i < numSamples; ++i) { + const int isym = (i / samplesPerSymbol) % nsym; + const double dphi = itone[isym] == 0 ? dphi0 : dphi1; + signal[i] = static_cast(std::cos(phi)); + phi = std::fmod(phi + dphi, twoPi); + } + + return signal; +} + +std::vector wsjtx_encode::encode_wspr(wsjtxMode mode, int frequency, std::string message, std::string &msgsent) +{ + std::vector signal; + + return signal; +} diff --git a/wsjtx_lib/wsjtx_encode.h b/wsjtx_lib/wsjtx_encode.h new file mode 100644 index 0000000..3cecbe9 --- /dev/null +++ b/wsjtx_lib/wsjtx_encode.h @@ -0,0 +1,29 @@ +#pragma once +#include "wsjtx_lib.h" +#include "constants.h" +#include +#include + +#define FT8_SYMBOL_BT 2.0f ///< symbol smoothing filter bandwidth factor (BT) +#define FT4_SYMBOL_BT 1.0f ///< symbol smoothing filter bandwidth factor (BT) +#define MAX_NUM_SYMBOLS 250 +#define GFSK_CONST_K 5.336446f ///< == pi * sqrt(2 / log(2)) + +class wsjtx_encode +{ + public: + std::vector encode_ft8(wsjtxMode mode, int frequency, std::string message, std::string &msgsent); + std::vector encode_ft4(wsjtxMode mode, int frequency, std::string message, std::string &msgsent); + std::vector encode_msk144(wsjtxMode mode, int frequency, std::string message, std::string &msgsent); + std::vector encode_wspr(wsjtxMode mode, int frequency, std::string message, std::string &msgsent); + + private: + int itone[MAX_NUM_SYMBOLS] = {0}; + char msg[38], sendmsg[38]; + int nsps ; + float fsample ; + float bt; + int icmplx{0}; + int nwave; + float f0; +}; diff --git a/wsjtx_lib/wsjtx_lib.cpp b/wsjtx_lib/wsjtx_lib.cpp new file mode 100644 index 0000000..c435245 --- /dev/null +++ b/wsjtx_lib/wsjtx_lib.cpp @@ -0,0 +1,91 @@ +#include "wsjtx_lib.h" +#include "wsjtx_decode.h" +#include "wsjtx_encode.h" +#include "constants.h" +#include +#include + +static int s_Test = 0; +int wsjtx_libTest() { return ++s_Test; } + +wsjtx_lib::wsjtx_lib() { fftwf_init_threads(); } + +void wsjtx_lib::setDxCall(const std::string& call) { dx_call_ = call; } +void wsjtx_lib::setDxGrid(const std::string& grid) { dx_grid_ = grid; } + +void wsjtx_lib::setDecodeRange(int lowFreq, int highFreq, int tolerance) +{ + decode_low_ = lowFreq; + decode_high_ = highFreq; + decode_tol_ = tolerance; +} + +void wsjtx_lib::setDecodeStationInfo(const std::string& myCall, const std::string& myGrid, + const std::string& dxCall, const std::string& dxGrid) +{ + my_call_ = myCall; + my_grid_ = myGrid; + dx_call_ = dxCall; + dx_grid_ = dxGrid; +} + +void wsjtx_lib::setDecodeControls(bool apDecode, int decodeDepth, int txFrequency, int qsoProgress) +{ + ap_decode_ = apDecode; + decode_depth_ = decodeDepth < 1 ? 1 : decodeDepth; + tx_frequency_ = txFrequency; + qso_progress_ = qsoProgress < 0 ? 0 : qsoProgress; +} + +bool wsjtx_lib::pullMessage(WsjtxMessage &msg) { return messageQueue_.pull(msg); } + +void wsjtx_lib::decode(wsjtxMode mode, WsjTxVector &audiosamples, int freq, int thread) +{ + std::unique_ptr ptr = std::make_unique(); + ptr->setStationInfo(my_call_, my_grid_, dx_call_, dx_grid_); + ptr->setDecodeRange(decode_low_, decode_high_, decode_tol_); + ptr->setDecodeControls(ap_decode_, decode_depth_, tx_frequency_, qso_progress_); + wsjtx_set_message_queue(&messageQueue_); + ptr->decode(mode, audiosamples, freq, thread); + wsjtx_set_message_queue(nullptr); +} + +void wsjtx_lib::decode(wsjtxMode mode, IntWsjTxVector &audiosamples, int freq, int thread) +{ + std::unique_ptr ptr = std::make_unique(); + ptr->setStationInfo(my_call_, my_grid_, dx_call_, dx_grid_); + ptr->setDecodeRange(decode_low_, decode_high_, decode_tol_); + ptr->setDecodeControls(ap_decode_, decode_depth_, tx_frequency_, qso_progress_); + wsjtx_set_message_queue(&messageQueue_); + ptr->decode(mode, audiosamples, freq, thread); + wsjtx_set_message_queue(nullptr); +} + +int wspr_decode(std::vector> &iqdat, int samples, + decoder_options options, std::vector &decodes, int threads); + +std::vector wsjtx_lib::wspr_decode(WsjtxIQSampleVector &iqsignal, decoder_options options) +{ + std::vector results; + ::wspr_decode(iqsignal, iqsignal.size(), options, results, 4); + return results; +} + +std::vector wsjtx_lib::encode(wsjtxMode mode, int frequency, std::string message, std::string &messagesend) +{ + switch (mode) { + case FT8: { + auto ptr = std::make_unique(); + return ptr->encode_ft8(mode, frequency, message, messagesend); + } + case FT4: { + auto ptr = std::make_unique(); + return ptr->encode_ft4(mode, frequency, message, messagesend); + } + case MSK144: { + auto ptr = std::make_unique(); + return ptr->encode_msk144(mode, frequency, message, messagesend); + } + default: return {}; + } +} diff --git a/wsjtx_lib/wsjtx_lib.h b/wsjtx_lib/wsjtx_lib.h new file mode 100644 index 0000000..5de551b --- /dev/null +++ b/wsjtx_lib/wsjtx_lib.h @@ -0,0 +1,84 @@ +#pragma once +#include +#include +#include +#include "DataBuffer.h" + +typedef std::vector WsjTxVector; +typedef std::vector IntWsjTxVector; +typedef std::vector> WsjtxIQSampleVector; + +class decoder_results +{ + public: + double freq; + float sync; + float snr; + float dt; + float drift; + int jitter; + char message[23]; + char call[13]; + char loc[7]; + char pwr[3]; + int cycles; +}; + +class decoder_options +{ + public: + int freq; + char rcall[13]; + char rloc[7]; + int quickmode; + int usehashtable; + int npasses; + int subtraction; + decoder_options(); +}; + +enum wsjtxMode { FT8, FT4, JT4, JT65, JT9, FST4, Q65, FST4W, JT65JT9, WSPR, MSK144 }; + +class WsjtxMessage +{ + public: + WsjtxMessage(int chh, int cmm, int css, int csnr, float cdt, int cfreq, std::string cmsg) + : hh{chh}, min{cmm}, sec{css}, snr{csnr}, dt{cdt}, freq{cfreq}, msg{cmsg}, sync{0.0} {}; + WsjtxMessage() : hh{0}, min{0}, sec{0}, snr{0}, freq{0}, dt{0}, msg{""} {}; + WsjtxMessage(int chh, int cmm, int css, int csnr, float csync, float cdt, int cfreq, std::string cmsg) + : hh{chh}, min{cmm}, sec{css}, snr{csnr}, sync{csync}, dt{cdt}, freq{cfreq}, msg{cmsg} {}; + int hh, min, sec, snr; + float sync, dt; + int freq; + std::string msg; +}; + +class wsjtx_lib +{ + public: + wsjtx_lib(); + void decode(wsjtxMode mode, WsjTxVector &audiosamples, int freq, int thread = 1); + void decode(wsjtxMode mode, IntWsjTxVector &audiosamples, int freq, int thread = 1); + std::vector encode(wsjtxMode mode, int frequency, std::string message, std::string &messagesend); + bool pullMessage(WsjtxMessage &msg); + std::vector wspr_decode(WsjtxIQSampleVector &iqsignal, decoder_options options); + void setDxCall(const std::string& call); + void setDxGrid(const std::string& grid); + void setDecodeRange(int lowFreq, int highFreq, int tolerance); + void setDecodeStationInfo(const std::string& myCall, const std::string& myGrid, + const std::string& dxCall, const std::string& dxGrid); + void setDecodeControls(bool apDecode, int decodeDepth, int txFrequency, int qsoProgress); + private: + std::string my_call_; + std::string my_grid_; + std::string dx_call_; + std::string dx_grid_; + int decode_low_ = 200; + int decode_high_ = 4000; + int decode_tol_ = 20; + bool ap_decode_ = true; + int decode_depth_ = 1; + int tx_frequency_ = 0; + int qso_progress_ = 0; + DataQueue messageQueue_; +}; diff --git a/wsjtx_lib/wsjtx_lib.sln b/wsjtx_lib/wsjtx_lib.sln new file mode 100644 index 0000000..e326ca1 --- /dev/null +++ b/wsjtx_lib/wsjtx_lib.sln @@ -0,0 +1,28 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 17 +VisualStudioVersion = 17.5.33516.290 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{803FD0C6-D64E-4E16-9DC3-1DAEC859A3D2}") = "wsjtx_lib", "wsjtx_lib.vgdbcmake", "{83C1C653-2196-4FDE-9E70-959722766649}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|VisualGDB = Debug|VisualGDB + MinSizeRel|VisualGDB = MinSizeRel|VisualGDB + Release|VisualGDB = Release|VisualGDB + RelWithDebInfo|VisualGDB = RelWithDebInfo|VisualGDB + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {83C1C653-2196-4FDE-9E70-959722766649}.Debug|VisualGDB.ActiveCfg = Debug|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.Debug|VisualGDB.Build.0 = Debug|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.MinSizeRel|VisualGDB.ActiveCfg = MinSizeRel|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.MinSizeRel|VisualGDB.Build.0 = MinSizeRel|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.Release|VisualGDB.ActiveCfg = Release|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.Release|VisualGDB.Build.0 = Release|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.RelWithDebInfo|VisualGDB.ActiveCfg = RelWithDebInfo|VisualGDB + {83C1C653-2196-4FDE-9E70-959722766649}.RelWithDebInfo|VisualGDB.Build.0 = RelWithDebInfo|VisualGDB + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/wsjtx_lib/wsjtx_lib.vgdbcmake b/wsjtx_lib/wsjtx_lib.vgdbcmake new file mode 100644 index 0000000..5fd03a8 --- /dev/null +++ b/wsjtx_lib/wsjtx_lib.vgdbcmake @@ -0,0 +1,209 @@ + + + + + + RemoteUnix + + true + + 192.168.88.62 + SSH + pi + + + false + + 192.168.88.41 + SSH + pi + + $(ProjectDir) + /tmp/VisualGDB/$(ProjectDirUnixStyle) + + *.cpp + *.h + *.hpp + *.c + *.cc + *.cxx + *.mak + Makefile + *.txt + *.cmake + CMakeLists.txt + *.cmake + *.f90 + *.inc + *.f + *.f03 + + true + true + + true + true + + Outgoing + false + LocalCache + + + false + false + false + false + false + $(ProjectDir) + + + + + com.sysprogs.toolchain.default-gcc + + 0 + + + + DEBUG + build/$(PlatformName)/$(ConfigurationName) + + false + + BuildMachine + BuiltinShortcut + + ninja + $(BuildDir) + + + + false + + BuildMachine + BuiltinShortcut + + $(ToolchainCMake) + + + true + false + false + Ninja + false + RemoveBuildDirectory + false + + + true + true + true + false + true + false + true + HideOuterProjectTargets + true + false + true + + + true + 83c1c653-2196-4fde-9e70-959722766649 + + Upper + None + true + false + + false + + + + + + + + + + + + + Default + + + + true + + + + + Unknown + + true + true + true + + + + false + + + + + + + + + false + false + false + false + false + false + false + false + false + + false + false + false + false + false + false + true + false + None + false + false + main + true + false + false + true + 0 + false + 0 + true + false + true + + + $(TargetPath) + 2000 + $(SelectedCMakeTargetArgs) + $(SelectedCMakeTargetLaunchDir) + Auto + + false + false + Local + false + false + Auto + true + false + false + false + + \ No newline at end of file diff --git a/wsjtx_lib/wsjtx_wspr.h b/wsjtx_lib/wsjtx_wspr.h new file mode 100644 index 0000000..224ef5f --- /dev/null +++ b/wsjtx_lib/wsjtx_wspr.h @@ -0,0 +1,21 @@ +#pragma once +#include +#include + +void subtract_signal(std::vector> &iqdat, + long np, + float f0, + int shift, + float drift, + unsigned char *channel_symbols); +void subtract_signal2(std::vector> &iqdat, + long np, + float f0, + int shift, + float drift, + unsigned char *channel_symbols); +int wspr_decode(std::vector> &iqdat, + int samples, + decoder_options options, + std::vector &decodes, + int threads); \ No newline at end of file diff --git a/wsjtx_lib/wsprd/fano.cpp b/wsjtx_lib/wsprd/fano.cpp new file mode 100644 index 0000000..2a124d2 --- /dev/null +++ b/wsjtx_lib/wsprd/fano.cpp @@ -0,0 +1,238 @@ +/* + This file is part of wsprd. + + File name: fano.c + + Description: Soft decision Fano sequential decoder for K=32 r=1/2 + convolutional code. + + Copyright 1994, Phil Karn, KA9Q + Minor modifications by Joe Taylor, K1JT +*/ + +#define LL 1 // Select Layland-Lushbaugh code + +#include +#include + +#include "./fano.h" + +struct node { + unsigned long encstate; // Encoder state of next node + long gamma; // Cumulative metric to this node + int metrics[4]; // Metrics indexed by all possible tx syms + int tm[2]; // Sorted metrics for current hypotheses + int i; // Current branch being tested +}; + +// Convolutional coding polynomials. All are rate 1/2, K=32 +#ifdef NASA_STANDARD +/* "NASA standard" code by Massey & Costello + * Nonsystematic, quick look-in, dmin=11, dfree=23 + * used on Pioneer 10-12, Helios A,B + */ +#define POLY1 0xbbef6bb7 +#define POLY2 0xbbef6bb5 +#endif + +#ifdef MJ +/* Massey-Johannesson code + * Nonsystematic, quick look-in, dmin=13, dfree>=23 + * Purported to be more computationally efficient than Massey-Costello + */ +#define POLY1 0xb840a20f +#define POLY2 0xb840a20d +#endif + +#ifdef LL +/* Layland-Lushbaugh code + * Nonsystematic, non-quick look-in, dmin=?, dfree=? + */ +#define POLY1 0xf2d05351 +#define POLY2 0xe4613c47 +#endif + +/* Convolutionally encode a packet. The input data bytes are read + * high bit first and the encoded packet is written into 'symbols', + * one symbol per byte. The first symbol is generated from POLY1, + * the second from POLY2. + * + * Storing only one symbol per byte uses more space, but it is faster + * and easier than trying to pack them more compactly. + */ +int encode(unsigned char *symbols, // Output buffer, 2*8*nbytes + unsigned char *data, // Input buffer, nbytes + unsigned int nbytes) { // Number of bytes in data + + unsigned long encstate; + int sym; + int i; + + encstate = 0; + while (nbytes-- != 0) { + for (i = 7; i >= 0; i--) { + encstate = (encstate << 1) | ((*data >> i) & 1); + ENCODE(sym, encstate); + *symbols++ = sym >> 1; + *symbols++ = sym & 1; + } + data++; + } + return 0; +} + +/* Decode packet with the Fano algorithm. + * Return 0 on success, -1 on timeout + */ +int fano(unsigned int *metric, // Final path metric (returned value) + unsigned int *cycles, // Cycle count (returned value) + unsigned int *maxnp, // Progress before timeout (returned value) + unsigned char *data, // Decoded output data + unsigned char *symbols, // Raw deinterleaved input symbols + unsigned int nbits, // Number of output bits + int mettab[2][256], // Metric table, [sent sym][rx symbol] + int delta, // Threshold adjust parameter + unsigned int maxcycles) { // Decoding timeout in cycles per bit + + struct node *nodes; // First node + struct node *np; // Current node + struct node *lastnode; // Last node + struct node *tail; // First node of tail + int t; // Threshold + int m0, m1; + int ngamma; + unsigned int lsym; + unsigned int i; + + if ((nodes = (struct node *)malloc((nbits + 1) * sizeof(struct node))) == NULL) { + printf("malloc failed\n"); + return 0; + } + lastnode = &nodes[nbits - 1]; + tail = &nodes[nbits - 31]; + *maxnp = 0; + + /* Compute all possible branch metrics for each symbol pair + * This is the only place we actually look at the raw input symbols + */ + for (np = nodes; np <= lastnode; np++) { + np->metrics[0] = mettab[0][symbols[0]] + mettab[0][symbols[1]]; + np->metrics[1] = mettab[0][symbols[0]] + mettab[1][symbols[1]]; + np->metrics[2] = mettab[1][symbols[0]] + mettab[0][symbols[1]]; + np->metrics[3] = mettab[1][symbols[0]] + mettab[1][symbols[1]]; + symbols += 2; + } + np = nodes; + np->encstate = 0; + + // Compute and sort branch metrics from root node */ + ENCODE(lsym, np->encstate); // 0-branch (LSB is 0) + m0 = np->metrics[lsym]; + + /* Now do the 1-branch. To save another ENCODE call here and + * inside the loop, we assume that both polynomials are odd, + * providing complementary pairs of branch symbols. + + * This code should be modified if a systematic code were used. + */ + + m1 = np->metrics[3 ^ lsym]; + if (m0 > m1) { + np->tm[0] = m0; // 0-branch has better metric + np->tm[1] = m1; + } else { + np->tm[0] = m1; // 1-branch is better + np->tm[1] = m0; + np->encstate++; // Set low bit + } + np->i = 0; // Start with best branch + maxcycles *= nbits; + np->gamma = t = 0; + + // Start the Fano decoder + for (i = 1; i <= maxcycles; i++) { + if ((int)(np - nodes) > (int)*maxnp) *maxnp = (int)(np - nodes); + + // Look forward */ + ngamma = np->gamma + np->tm[np->i]; + if (ngamma >= t) { + if (np->gamma < t + delta) { // Node is acceptable + /* First time we've visited this node; + * Tighten threshold. + * + * This loop could be replaced with + * t += delta * ((ngamma - t)/delta); + * but the multiply and divide are slower. + */ + while (ngamma >= t + delta) t += delta; + } + np[1].gamma = ngamma; // Move forward + np[1].encstate = np->encstate << 1; + if (++np == (lastnode + 1)) { + break; // Done! + } + + /* Compute and sort metrics, starting with the + * zero branch + */ + ENCODE(lsym, np->encstate); + if (np >= tail) { + /* The tail must be all zeroes, so don't + * bother computing the 1-branches here. + */ + np->tm[0] = np->metrics[lsym]; + } else { + m0 = np->metrics[lsym]; + m1 = np->metrics[3 ^ lsym]; + if (m0 > m1) { + np->tm[0] = m0; // 0-branch is better + np->tm[1] = m1; + } else { + np->tm[0] = m1; // 1-branch is better + np->tm[1] = m0; + np->encstate++; // Set low bit + } + } + np->i = 0; // Start with best branch + continue; + } + // Threshold violated, can't go forward + for (;;) { // Look backward + if (np == nodes || np[-1].gamma < t) { + /* Can't back up either. + * Relax threshold and and look + * forward again to better branch. + */ + t -= delta; + if (np->i != 0) { + np->i = 0; + np->encstate ^= 1; + } + break; + } + // Back up + if (--np < tail && np->i != 1) { + np->i++; // Search next best branch + np->encstate ^= 1; + break; + } // else keep looking back + } + } + *metric = np->gamma; // Return the final path metric + + // Copy decoded data to user's buffer + nbits >>= 3; + np = &nodes[7]; + + while (nbits-- != 0) { + *data++ = np->encstate; + np += 8; + } + *cycles = i + 1; + + free(nodes); + if (i >= maxcycles) + return -1; // Decoder timed out + + return 0; // Successful completion +} diff --git a/wsjtx_lib/wsprd/fano.h b/wsjtx_lib/wsprd/fano.h new file mode 100644 index 0000000..43c7465 --- /dev/null +++ b/wsjtx_lib/wsprd/fano.h @@ -0,0 +1,44 @@ +/* + This file is part of wsprd. + + File name: fano.h + + Description: Header file for sequential Fano decoder. + + Copyright 1994, Phil Karn, KA9Q + Minor modifications by Joe Taylor, K1JT +*/ + +#pragma once + +int fano(unsigned int *metric, + unsigned int *cycles, + unsigned int *maxnp, + unsigned char *data, + unsigned char *symbols, + unsigned int nbits, + int mettab[2][256], + int delta, + unsigned int maxcycles); + +int encode(unsigned char *symbols, + unsigned char *data, + unsigned int nbytes); + +extern unsigned char Partab[]; + +/* Convolutional encoder macro. Takes the encoder state, generates + * a rate 1/2 symbol pair and stores it in 'sym'. The symbol generated from + * POLY1 goes into the 2-bit of sym, and the symbol generated from POLY2 + * goes into the 1-bit. + */ +#define ENCODE(sym, encstate) \ + { \ + unsigned long _tmp; \ + _tmp = (encstate)&POLY1; \ + _tmp ^= _tmp >> 16; \ + (sym) = Partab[(_tmp ^ (_tmp >> 8)) & 0xff] << 1; \ + _tmp = (encstate)&POLY2; \ + _tmp ^= _tmp >> 16; \ + (sym) |= Partab[(_tmp ^ (_tmp >> 8)) & 0xff]; \ + } diff --git a/wsjtx_lib/wsprd/metric_tables.h b/wsjtx_lib/wsprd/metric_tables.h new file mode 100644 index 0000000..7db6e27 --- /dev/null +++ b/wsjtx_lib/wsprd/metric_tables.h @@ -0,0 +1,139 @@ +/******************************************************************************* + * 4 metric tables calculated via simulation for 2-FSK with Es/No=0,3,6,9 dB + * tables were calculated for constant rms noise level of 50. The symbol vector + * should be normalized to have rms amplitude equal to "symbol_scale". + ********************************************************************************/ + +//float symbol_scale[5]={42.6, 53.3, 72.7, 100.2, 125.4}; +float metric_tables[5][256]={ + {0.9782, 0.9695, 0.9689, 0.9669, 0.9666, 0.9653, 0.9638, 0.9618, 0.9599, 0.9601, + 0.9592, 0.9570, 0.9556, 0.9540, 0.9525, 0.9527, 0.9486, 0.9477, 0.9450, 0.9436, + 0.9424, 0.9400, 0.9381, 0.9360, 0.9340, 0.9316, 0.9301, 0.9272, 0.9254, 0.9224, + 0.9196, 0.9171, 0.9154, 0.9123, 0.9076, 0.9061, 0.9030, 0.9000, 0.8965, 0.8934, + 0.8903, 0.8874, 0.8834, 0.8792, 0.8760, 0.8726, 0.8685, 0.8639, 0.8599, 0.8550, + 0.8504, 0.8459, 0.8422, 0.8364, 0.8320, 0.8262, 0.8215, 0.8159, 0.8111, 0.8052, + 0.7996, 0.7932, 0.7878, 0.7812, 0.7745, 0.7685, 0.7616, 0.7550, 0.7479, 0.7405, + 0.7336, 0.7255, 0.7184, 0.7102, 0.7016, 0.6946, 0.6860, 0.6769, 0.6687, 0.6598, + 0.6503, 0.6416, 0.6325, 0.6219, 0.6122, 0.6016, 0.5920, 0.5818, 0.5711, 0.5606, + 0.5487, 0.5374, 0.5266, 0.5142, 0.5020, 0.4908, 0.4784, 0.4663, 0.4532, 0.4405, + 0.4271, 0.4144, 0.4006, 0.3865, 0.3731, 0.3594, 0.3455, 0.3304, 0.3158, 0.3009, + 0.2858, 0.2708, 0.2560, 0.2399, 0.2233, 0.2074, 0.1919, 0.1756, 0.1590, 0.1427, + 0.1251, 0.1074, 0.0905, 0.0722, 0.0550, 0.0381, 0.0183, 0.0000, -0.0185, -0.0391, + -0.0571, -0.0760, -0.0966, -0.1160, -0.1370, -0.1584, -0.1787, -0.1999, -0.2214, -0.2423, + -0.2643, -0.2879, -0.3114, -0.3336, -0.3568, -0.3806, -0.4050, -0.4293, -0.4552, -0.4798, + -0.5046, -0.5296, -0.5564, -0.5836, -0.6093, -0.6372, -0.6645, -0.6933, -0.7208, -0.7495, + -0.7763, -0.8065, -0.8378, -0.8660, -0.8964, -0.9293, -0.9592, -0.9907, -1.0214, -1.0509, + -1.0850, -1.1168, -1.1528, -1.1847, -1.2157, -1.2511, -1.2850, -1.3174, -1.3540, -1.3900, + -1.4201, -1.4580, -1.4956, -1.5292, -1.5683, -1.6030, -1.6411, -1.6789, -1.7147, -1.7539, + -1.7887, -1.8289, -1.8699, -1.9043, -1.9469, -1.9849, -2.0267, -2.0610, -2.1028, -2.1391, + -2.1855, -2.2215, -2.2712, -2.3033, -2.3440, -2.3870, -2.4342, -2.4738, -2.5209, -2.5646, + -2.6016, -2.6385, -2.6868, -2.7356, -2.7723, -2.8111, -2.8524, -2.9009, -2.9428, -2.9879, + -3.0103, -3.0832, -3.1340, -3.1628, -3.2049, -3.2557, -3.3101, -3.3453, -3.4025, -3.4317, + -3.4828, -3.5270, -3.5745, -3.6181, -3.6765, -3.7044, -3.7410, -3.8118, -3.8368, -3.9549, + -3.9488, -3.9941, -4.0428, -4.0892, -4.1648, -4.1965, -4.1892, -4.2565, -4.3356, -4.3948, + -4.4481, -4.4607, -4.5533, -4.5809, -4.5927, -5.1047}, + {0.9978, 0.9962, 0.9961, 0.9959, 0.9958, 0.9954, 0.9949, 0.9950, 0.9947, 0.9942, + 0.9940, 0.9939, 0.9933, 0.9931, 0.9928, 0.9924, 0.9921, 0.9916, 0.9911, 0.9909, + 0.9903, 0.9900, 0.9892, 0.9887, 0.9883, 0.9877, 0.9869, 0.9863, 0.9857, 0.9848, + 0.9842, 0.9835, 0.9825, 0.9817, 0.9808, 0.9799, 0.9791, 0.9777, 0.9767, 0.9757, + 0.9744, 0.9729, 0.9716, 0.9704, 0.9690, 0.9674, 0.9656, 0.9641, 0.9625, 0.9609, + 0.9587, 0.9567, 0.9548, 0.9524, 0.9501, 0.9478, 0.9453, 0.9426, 0.9398, 0.9371, + 0.9339, 0.9311, 0.9277, 0.9242, 0.9206, 0.9168, 0.9131, 0.9087, 0.9043, 0.8999, + 0.8953, 0.8907, 0.8857, 0.8803, 0.8747, 0.8690, 0.8632, 0.8572, 0.8507, 0.8439, + 0.8368, 0.8295, 0.8217, 0.8138, 0.8058, 0.7972, 0.7883, 0.7784, 0.7694, 0.7597, + 0.7489, 0.7378, 0.7269, 0.7152, 0.7030, 0.6911, 0.6782, 0.6643, 0.6506, 0.6371, + 0.6211, 0.6054, 0.5897, 0.5740, 0.5565, 0.5393, 0.5214, 0.5027, 0.4838, 0.4643, + 0.4436, 0.4225, 0.4004, 0.3787, 0.3562, 0.3324, 0.3089, 0.2839, 0.2584, 0.2321, + 0.2047, 0.1784, 0.1499, 0.1213, 0.0915, 0.0628, 0.0314, 0.0000, -0.0321, -0.0657, + -0.0977, -0.1324, -0.1673, -0.2036, -0.2387, -0.2768, -0.3150, -0.3538, -0.3936, -0.4327, + -0.4739, -0.5148, -0.5561, -0.6000, -0.6438, -0.6889, -0.7331, -0.7781, -0.8247, -0.8712, + -0.9177, -0.9677, -1.0142, -1.0631, -1.1143, -1.1686, -1.2169, -1.2680, -1.3223, -1.3752, + -1.4261, -1.4806, -1.5356, -1.5890, -1.6462, -1.7041, -1.7591, -1.8124, -1.8735, -1.9311, + -1.9891, -2.0459, -2.1048, -2.1653, -2.2248, -2.2855, -2.3466, -2.4079, -2.4668, -2.5263, + -2.5876, -2.6507, -2.7142, -2.7761, -2.8366, -2.8995, -2.9620, -3.0279, -3.0973, -3.1576, + -3.2238, -3.2890, -3.3554, -3.4215, -3.4805, -3.5518, -3.6133, -3.6812, -3.7473, -3.8140, + -3.8781, -3.9450, -4.0184, -4.0794, -4.1478, -4.2241, -4.2853, -4.3473, -4.4062, -4.4839, + -4.5539, -4.6202, -4.6794, -4.7478, -4.8309, -4.9048, -4.9669, -5.0294, -5.1194, -5.1732, + -5.2378, -5.3094, -5.3742, -5.4573, -5.5190, -5.5728, -5.6637, -5.7259, -5.7843, -5.8854, + -5.9553, -6.0054, -6.0656, -6.1707, -6.2241, -6.3139, -6.3393, -6.4356, -6.5153, -6.5758, + -6.6506, -6.7193, -6.7542, -6.8942, -6.9219, -6.9605, -7.1013, -7.1895, -7.1549, -7.2799, + -7.4119, -7.4608, -7.5256, -7.5879, -7.7598, -8.4120}, + {0.9999, 0.9998, 0.9998, 0.9998, 0.9998, 0.9998, 0.9997, 0.9997, 0.9997, 0.9997, + 0.9997, 0.9996, 0.9996, 0.9996, 0.9995, 0.9995, 0.9994, 0.9994, 0.9994, 0.9993, + 0.9993, 0.9992, 0.9991, 0.9991, 0.9990, 0.9989, 0.9988, 0.9988, 0.9988, 0.9986, + 0.9985, 0.9984, 0.9983, 0.9982, 0.9980, 0.9979, 0.9977, 0.9976, 0.9974, 0.9971, + 0.9969, 0.9968, 0.9965, 0.9962, 0.9960, 0.9957, 0.9953, 0.9950, 0.9947, 0.9941, + 0.9937, 0.9933, 0.9928, 0.9922, 0.9917, 0.9911, 0.9904, 0.9897, 0.9890, 0.9882, + 0.9874, 0.9863, 0.9855, 0.9843, 0.9832, 0.9819, 0.9806, 0.9792, 0.9777, 0.9760, + 0.9743, 0.9724, 0.9704, 0.9683, 0.9659, 0.9634, 0.9609, 0.9581, 0.9550, 0.9516, + 0.9481, 0.9446, 0.9406, 0.9363, 0.9317, 0.9270, 0.9218, 0.9160, 0.9103, 0.9038, + 0.8972, 0.8898, 0.8822, 0.8739, 0.8647, 0.8554, 0.8457, 0.8357, 0.8231, 0.8115, + 0.7984, 0.7854, 0.7704, 0.7556, 0.7391, 0.7210, 0.7038, 0.6840, 0.6633, 0.6408, + 0.6174, 0.5939, 0.5678, 0.5410, 0.5137, 0.4836, 0.4524, 0.4193, 0.3850, 0.3482, + 0.3132, 0.2733, 0.2315, 0.1891, 0.1435, 0.0980, 0.0493, 0.0000, -0.0510, -0.1052, + -0.1593, -0.2177, -0.2759, -0.3374, -0.4005, -0.4599, -0.5266, -0.5935, -0.6626, -0.7328, + -0.8051, -0.8757, -0.9498, -1.0271, -1.1019, -1.1816, -1.2642, -1.3459, -1.4295, -1.5077, + -1.5958, -1.6818, -1.7647, -1.8548, -1.9387, -2.0295, -2.1152, -2.2154, -2.3011, -2.3904, + -2.4820, -2.5786, -2.6730, -2.7652, -2.8616, -2.9546, -3.0526, -3.1445, -3.2445, -3.3416, + -3.4357, -3.5325, -3.6324, -3.7313, -3.8225, -3.9209, -4.0248, -4.1278, -4.2261, -4.3193, + -4.4220, -4.5262, -4.6214, -4.7242, -4.8234, -4.9245, -5.0298, -5.1250, -5.2232, -5.3267, + -5.4332, -5.5342, -5.6431, -5.7270, -5.8401, -5.9350, -6.0407, -6.1418, -6.2363, -6.3384, + -6.4536, -6.5429, -6.6582, -6.7433, -6.8438, -6.9478, -7.0789, -7.1894, -7.2714, -7.3815, + -7.4810, -7.5575, -7.6852, -7.8071, -7.8580, -7.9724, -8.1000, -8.2207, -8.2867, -8.4017, + -8.5287, -8.6347, -8.7082, -8.8319, -8.9448, -9.0355, -9.1885, -9.2095, -9.2863, -9.4186, + -9.5064, -9.6386, -9.7207, -9.8286, -9.9453, -10.0701, -10.1735, -10.3001, -10.2858, -10.5427, + -10.5982, -10.7361, -10.7042, -10.9212, -11.0097, -11.0469, -11.1155, -11.2812, -11.3472, -11.4988, + -11.5327, -11.6692, -11.9376, -11.8606, -12.1372, -13.2539}, + {1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, + 0.9999, 0.9998, 0.9998, 0.9998, 0.9998, 0.9997, 0.9997, 0.9997, 0.9997, 0.9996, + 0.9996, 0.9995, 0.9995, 0.9994, 0.9994, 0.9993, 0.9992, 0.9991, 0.9991, 0.9989, + 0.9988, 0.9986, 0.9985, 0.9983, 0.9981, 0.9980, 0.9977, 0.9974, 0.9971, 0.9968, + 0.9965, 0.9962, 0.9956, 0.9950, 0.9948, 0.9941, 0.9933, 0.9926, 0.9919, 0.9910, + 0.9899, 0.9889, 0.9877, 0.9863, 0.9845, 0.9829, 0.9811, 0.9791, 0.9769, 0.9741, + 0.9716, 0.9684, 0.9645, 0.9611, 0.9563, 0.9519, 0.9463, 0.9406, 0.9344, 0.9272, + 0.9197, 0.9107, 0.9016, 0.8903, 0.8791, 0.8653, 0.8523, 0.8357, 0.8179, 0.7988, + 0.7779, 0.7562, 0.7318, 0.7024, 0.6753, 0.6435, 0.6089, 0.5700, 0.5296, 0.4860, + 0.4366, 0.3855, 0.3301, 0.2735, 0.2114, 0.1443, 0.0682, 0.0000, -0.0715, -0.1604, + -0.2478, -0.3377, -0.4287, -0.5277, -0.6291, -0.7384, -0.8457, -0.9559, -1.0742, -1.1913, + -1.3110, -1.4238, -1.5594, -1.6854, -1.8093, -1.9414, -2.0763, -2.2160, -2.3611, -2.4876, + -2.6374, -2.7710, -2.9225, -3.0591, -3.2077, -3.3452, -3.4916, -3.6316, -3.7735, -3.9296, + -4.0682, -4.2334, -4.3607, -4.5270, -4.6807, -4.8108, -4.9753, -5.1212, -5.2631, -5.4042, + -5.5510, -5.7227, -5.8794, -6.0244, -6.1677, -6.3271, -6.4862, -6.6130, -6.7449, -6.9250, + -7.1232, -7.1736, -7.3628, -7.5596, -7.6906, -7.8129, -7.9817, -8.1440, -8.3016, -8.4797, + -8.5734, -8.7692, -8.9198, -9.0610, -9.1746, -9.3536, -9.5939, -9.6957, -9.8475, -9.9639, + -10.1730, -10.2427, -10.4573, -10.5413, -10.7303, -10.9339, -11.0215, -11.2047, -11.2894, -11.4572, + -11.6256, -11.7794, -11.8801, -12.1717, -12.2354, -12.3686, -12.6195, -12.6527, -12.8247, -12.9560, + -13.3265, -13.1667, -13.4274, -13.6064, -13.5515, -13.9501, -13.9926, -14.4049, -14.1653, -14.4348, + -14.7983, -14.7807, -15.2349, -15.3536, -15.3026, -15.2739, -15.7170, -16.2161, -15.9185, -15.9490, + -16.6258, -16.5568, -16.4318, -16.7999, -16.4101, -17.6393, -17.7643, -17.2644, -17.5973, -17.0403, + -17.7039, -18.0073, -18.1840, -18.3848, -18.6286, -20.7063}, + {1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, 1.0000, + 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, 0.9999, + 0.9999, 0.9998, 0.9998, 0.9998, 0.9998, 0.9997, 0.9997, 0.9997, 0.9997, 0.9996, + 0.9996, 0.9995, 0.9995, 0.9994, 0.9994, 0.9993, 0.9992, 0.9991, 0.9991, 0.9989, + 0.9988, 0.9986, 0.9985, 0.9983, 0.9981, 0.9980, 0.9977, 0.9974, 0.9971, 0.9968, + 0.9965, 0.9962, 0.9956, 0.9950, 0.9948, 0.9941, 0.9933, 0.9926, 0.9919, 0.9910, + 0.9899, 0.9889, 0.9877, 0.9863, 0.9845, 0.9829, 0.9811, 0.9791, 0.9769, 0.9741, + 0.9716, 0.9684, 0.9645, 0.9611, 0.9563, 0.9519, 0.9463, 0.9406, 0.9344, 0.9272, + 0.9197, 0.9107, 0.9016, 0.8903, 0.8791, 0.8653, 0.8523, 0.8357, 0.8179, 0.7988, + 0.7779, 0.7562, 0.7318, 0.7024, 0.6753, 0.6435, 0.6089, 0.5700, 0.5296, 0.4860, + 0.4366, 0.3855, 0.3301, 0.2735, 0.2114, 0.1443, 0.0682, 0.0000, -0.0715, -0.1604, + -0.2478, -0.3377, -0.4287, -0.5277, -0.6291, -0.7384, -0.8457, -0.9559, -1.0742, -1.1913, + -1.3110, -1.4238, -1.5594, -1.6854, -1.8093, -1.9414, -2.0763, -2.2160, -2.3611, -2.4876, + -2.6374, -2.7710, -2.9225, -3.0591, -3.2077, -3.3452, -3.4916, -3.6316, -3.7735, -3.9296, + -4.0682, -4.2334, -4.3607, -4.5270, -4.6807, -4.8108, -4.9753, -5.1212, -5.2631, -5.4042, + -5.5510, -5.7227, -5.8794, -6.0244, -6.1677, -6.3271, -6.4862, -6.6130, -6.7449, -6.9250, + -7.1232, -7.1736, -7.3628, -7.5596, -7.6906, -7.8129, -7.9817, -8.1440, -8.3016, -8.4797, + -8.5734, -8.7692, -8.9198, -9.0610, -9.1746, -9.3536, -9.5939, -9.6957, -9.8475, -9.9639, + -10.1730, -10.2427, -10.4573, -11.7794, -11.8801, -12.1717, -12.2354, -12.3686, -12.6195, -12.6527, + -12.8247, -12.9560, -13.3265, -13.1667, -13.4274, -13.6064, -13.5515, -13.9501, -13.9926, -14.4049, + -14.1653, -14.4348, -14.7983, -14.7807, -15.2349, -15.3536, -15.3026, -15.2739, -15.7170, -16.2161, + -15.9185, -15.9490, -16.6258, -16.5568, -16.4318, -16.7999, -16.4101, -17.6393, -17.7643, -17.2644, + -17.5973, -17.0403, -17.7039, -18.0073, -18.1840, -18.3848, -18.6286, -20.7063, 1.43370769e-019, + 2.64031087e-006, 6.6908396e+031, 1.77537994e+028, 2.79322819e+020, 1.94326e-019, + 0.00019371575, 2.80722121e-041}}; diff --git a/wsjtx_lib/wsprd/nhash.cpp b/wsjtx_lib/wsprd/nhash.cpp new file mode 100644 index 0000000..ea5c601 --- /dev/null +++ b/wsjtx_lib/wsprd/nhash.cpp @@ -0,0 +1,451 @@ +/* + This file is part of wsprd. + + File name: nhash.c + + *------------------------------------------------------------------------------ + * + * This file is part of the WSPR application, Weak Signal Propagation Reporter + * + * File Name: nhash.c + * Description: Functions to produce 32-bit hashes for hash table lookup + * + * Copyright (C) 2008-2014 Joseph Taylor, K1JT + * License: GNU GPL v3+ + * + * This program is free software; you can redistribute it and/or modify it under + * the terms of the GNU General Public License as published by the Free Software + * Foundation; either version 3 of the License, or (at your option) any later + * version. + * + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + * details. + * + * You should have received a copy of the GNU General Public License along with + * this program; if not, write to the Free Software Foundation, Inc., 51 Franklin + * Street, Fifth Floor, Boston, MA 02110-1301, USA. + * + * Files: lookup3.c + * Copyright: Copyright (C) 2006 Bob Jenkins + * License: public-domain + * You may use this code any way you wish, private, educational, or commercial. + * It's free. + * + *------------------------------------------------------------------------------- +*/ + +/* +These are functions for producing 32-bit hashes for hash table lookup. +hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() +are externally useful functions. Routines to test the hash are included +if SELF_TEST is defined. You can use this free for any purpose. It's in +the public domain. It has no warranty. + +You probably want to use hashlittle(). hashlittle() and hashbig() +hash byte arrays. hashlittle() is is faster than hashbig() on +little-endian machines. Intel and AMD are little-endian machines. +On second thought, you probably want hashlittle2(), which is identical to +hashlittle() except it returns two 32-bit hashes for the price of one. +You could implement hashbig2() if you wanted but I haven't bothered here. + +If you want to find a hash of, say, exactly 7 integers, do + a = i1; b = i2; c = i3; + mix(a,b,c); + a += i4; b += i5; c += i6; + mix(a,b,c); + a += i7; + final(a,b,c); +then use c as the hash value. If you have a variable length array of +4-byte integers to hash, use hashword(). If you have a byte array (like +a character string), use hashlittle(). If you have several byte arrays, or +a mix of things, see the comments above hashlittle(). + +Why is this so big? I read 12 bytes at a time into 3 4-byte integers, +then mix those integers. This is fast (you can do a lot more thorough +mixing with 12*3 instructions on 3 integers than you can with 3 instructions +on 1 byte), but shoehorning those bytes into integers efficiently is messy. +*/ + +#define SELF_TEST 1 + +#include +#include + +#include "./nhash.h" +//#include /* attempt to define endianness */ +//#ifdef linux +//# include /* attempt to define endianness */ +//#endif + +#define HASH_LITTLE_ENDIAN 1 + +#define hashsize(n) ((uint32_t)1 << (n)) +#define hashmask(n) (hashsize(n) - 1) +#define rot(x, k) (((x) << (k)) | ((x) >> (32 - (k)))) + +/* +------------------------------------------------------------------------------- +mix -- mix 3 32-bit values reversibly. + +This is reversible, so any information in (a,b,c) before mix() is +still in (a,b,c) after mix(). + +If four pairs of (a,b,c) inputs are run through mix(), or through +mix() in reverse, there are at least 32 bits of the output that +are sometimes the same for one pair and different for another pair. +This was tested for: +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that +satisfy this are + 4 6 8 16 19 4 + 9 15 3 18 27 15 + 14 9 3 7 17 3 +Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing +for "differ" defined as + with a one-bit base and a two-bit delta. I +used http://burtleburtle.net/bob/hash/avalanche.html to choose +the operations, constants, and arrangements of the variables. + +This does not achieve avalanche. There are input bits of (a,b,c) +that fail to affect some output bits of (a,b,c), especially of a. The +most thoroughly mixed value is c, but it doesn't really even achieve +avalanche in c. + +This allows some parallelism. Read-after-writes are good at doubling +the number of bits affected, so the goal of mixing pulls in the opposite +direction as the goal of parallelism. I did what I could. Rotates +seem to cost as much as shifts on every machine I could lay my hands +on, and rotates are much kinder to the top and bottom bits, so I used +rotates. +------------------------------------------------------------------------------- +*/ +#define mix(a, b, c) \ + { \ + a -= c; a ^= rot(c, 4); c += b; \ + b -= a; b ^= rot(a, 6); a += c; \ + c -= b; c ^= rot(b, 8); b += a; \ + a -= c; a ^= rot(c,16); c += b; \ + b -= a; b ^= rot(a,19); a += c; \ + c -= b; c ^= rot(b, 4); b += a; \ + } + +/* +------------------------------------------------------------------------------- +final -- final mixing of 3 32-bit values (a,b,c) into c + +Pairs of (a,b,c) values differing in only a few bits will usually +produce values of c that look totally different. This was tested for +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +These constants passed: + 14 11 25 16 4 14 24 + 12 14 25 16 4 14 24 +and these came close: + 4 8 15 26 3 22 24 + 10 8 15 26 3 22 24 + 11 8 15 26 3 22 24 +------------------------------------------------------------------------------- +*/ +#define final(a, b, c) \ + { \ + c ^= b; c -= rot(b,14); \ + a ^= c; a -= rot(c,11); \ + b ^= a; b -= rot(a,25); \ + c ^= b; c -= rot(b,16); \ + a ^= c; a -= rot(c,4); \ + b ^= a; b -= rot(a,14); \ + c ^= b; c -= rot(b,24); \ + } + +/* +------------------------------------------------------------------------------- +hashlittle() -- hash a variable-length key into a 32-bit value + k : the key (the unaligned variable-length array of bytes) + length : the length of the key, counting by bytes + initval : can be any 4-byte value +Returns a 32-bit value. Every bit of the key affects every bit of +the return value. Two keys differing by one or two bits will have +totally different hash values. + +The best hash table sizes are powers of 2. There is no need to do +mod a prime (mod is sooo slow!). If you need less than 32 bits, +use a bitmask. For example, if you need only 10 bits, do + h = (h & hashmask(10)); +In which case, the hash table should have hashsize(10) elements. + +If you are hashing n strings (uint8_t **)k, do it like this: + for (i=0, h=0; i 12) { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a, b, c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticeably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch (length) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += k[2] & 0xffffff; + b += k[1]; + a += k[0]; + break; + case 10: + c += k[2] & 0xffff; + b += k[1]; + a += k[0]; + break; + case 9: + c += k[2] & 0xff; + b += k[1]; + a += k[0]; + break; + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += k[1] & 0xffffff; + a += k[0]; + break; + case 6: + b += k[1] & 0xffff; + a += k[0]; + break; + case 5: + b += k[1] & 0xff; + a += k[0]; + break; + case 4: + a += k[0]; + break; + case 3: + a += k[0] & 0xffffff; + break; + case 2: + a += k[0] & 0xffff; + break; + case 1: + a += k[0] & 0xff; + break; + case 0: + return c; /* zero length strings require no mixing */ + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch (length) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += ((uint32_t)k8[10]) << 16; /* fall through */ + case 10: + c += ((uint32_t)k8[9]) << 8; /* fall through */ + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += ((uint32_t)k8[6]) << 16; /* fall through */ + case 6: + b += ((uint32_t)k8[5]) << 8; /* fall through */ + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0]; + break; + case 3: + a += ((uint32_t)k8[2]) << 16; /* fall through */ + case 2: + a += ((uint32_t)k8[1]) << 8; /* fall through */ + case 1: + a += k8[0]; + break; + case 0: + return c; + } + +#endif /* !valgrind */ + + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; + + /*--------------- all but last block: aligned reads and different mixing */ + while (length > 12) { + a += k[0] + (((uint32_t)k[1]) << 16); + b += k[2] + (((uint32_t)k[3]) << 16); + c += k[4] + (((uint32_t)k[5]) << 16); + mix(a, b, c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) block */ + k8 = (const uint8_t *)k; + switch (length) { + case 12: + c += k[4] + (((uint32_t)k[5]) << 16); + b += k[2] + (((uint32_t)k[3]) << 16); + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 11: + c += ((uint32_t)k8[10]) << 16; /* fall through */ + case 10: + c += k[4]; + b += k[2] + (((uint32_t)k[3]) << 16); + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[2] + (((uint32_t)k[3]) << 16); + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 7: + b += ((uint32_t)k8[6]) << 16; /* fall through */ + case 6: + b += k[2]; + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 3: + a += ((uint32_t)k8[2]) << 16; /* fall through */ + case 2: + a += k[0]; + break; + case 1: + a += k8[0]; + break; + case 0: + return c; /* zero length requires no mixing */ + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length > 12) { + a += k[0]; + a += ((uint32_t)k[1]) << 8; + a += ((uint32_t)k[2]) << 16; + a += ((uint32_t)k[3]) << 24; + b += k[4]; + b += ((uint32_t)k[5]) << 8; + b += ((uint32_t)k[6]) << 16; + b += ((uint32_t)k[7]) << 24; + c += k[8]; + c += ((uint32_t)k[9]) << 8; + c += ((uint32_t)k[10]) << 16; + c += ((uint32_t)k[11]) << 24; + mix(a, b, c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch (length) { /* all the case statements fall through */ + case 12: + c += ((uint32_t)k[11]) << 24; + case 11: + c += ((uint32_t)k[10]) << 16; + case 10: + c += ((uint32_t)k[9]) << 8; + case 9: + c += k[8]; + case 8: + b += ((uint32_t)k[7]) << 24; + case 7: + b += ((uint32_t)k[6]) << 16; + case 6: + b += ((uint32_t)k[5]) << 8; + case 5: + b += k[4]; + case 4: + a += ((uint32_t)k[3]) << 24; + case 3: + a += ((uint32_t)k[2]) << 16; + case 2: + a += ((uint32_t)k[1]) << 8; + case 1: + a += k[0]; + break; + case 0: + return c; + } + } + + final(a, b, c); + c = (32767 & c); + + return c; +} diff --git a/wsjtx_lib/wsprd/nhash.h b/wsjtx_lib/wsprd/nhash.h new file mode 100644 index 0000000..18e8bee --- /dev/null +++ b/wsjtx_lib/wsprd/nhash.h @@ -0,0 +1,14 @@ +#pragma once + +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +uint32_t nhash(const void* key, size_t length, uint32_t initval); + +#ifdef __cplusplus +} +#endif diff --git a/wsjtx_lib/wsprd/tab.cpp b/wsjtx_lib/wsprd/tab.cpp new file mode 100644 index 0000000..d1c5c27 --- /dev/null +++ b/wsjtx_lib/wsprd/tab.cpp @@ -0,0 +1,41 @@ +/* + This file is part of wsprd. + + File name: tab.c + Description: 8-bit parity lookup table. +*/ +unsigned char Partab[] = { + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, + 0, 1, 1, 0, 1, 0, 0, 1, + 0, 1, 1, 0, 1, 0, 0, 1, + 1, 0, 0, 1, 0, 1, 1, 0, +}; + diff --git a/wsjtx_lib/wsprd/wsprd.cpp b/wsjtx_lib/wsprd/wsprd.cpp new file mode 100644 index 0000000..2a44c2f --- /dev/null +++ b/wsjtx_lib/wsprd/wsprd.cpp @@ -0,0 +1,879 @@ +/* + This file is part of program wsprd, a detector/demodulator/decoder + for the Weak Signal Propagation Reporter (WSPR) mode. + + File name: wsprd.c + + Copyright 2001-2015, Joe Taylor, K1JT + + Much of the present code is based on work by Steven Franke, K9AN, + which in turn was based on earlier work by K1JT. + + Copyright 2014-2015, Steven Franke, K9AN + + Minor modifications + + Copyright 2016, Guenael Jouchet, VA2GKA + + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + */ + +#include +#include +#include +#include +#include +#include +#include + +#include "./wsprd.h" +#include "./fano.h" +#include "./nhash.h" +#include "./wsprd_utils.h" +#include "./wsprsim_utils.h" +#include "./metric_tables.h" + +#define SIGNAL_LENGHT 120 +#define SIGNAL_SAMPLE_RATE 375 +#define SIGNAL_SAMPLES SIGNAL_LENGHT * SIGNAL_SAMPLE_RATE +#define NBITS 81 +#define NSYM 162 +#define NSPERSYM 256 +#define DF 375.0 / 256.0 +#define DT 1.0 / 375.0 +#define DF05 DF * 0.5 +#define DF15 DF * 1.5 +#define TWOPIDT 2.0 * M_PI * DT + + +/* Possible PATIENCE options: F + FTW_ESTIMATE, + FFTW_ESTIMATE_PATIENT, + FFTW_MEASURE, + FFTW_PATIENT, + FFTW_EXHAUSTIVE +*/ +#define PATIENCE FFTW_ESTIMATE + +fftwf_plan PLAN; +int32_t printdata = 0; + +uint8_t pr3vector[NSYM] = { + 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}; + +decoder_options::decoder_options() +{ + usehashtable = 0; + npasses = 2; + subtraction = 1; + quickmode = 0; +} + +/* mode = 0: no frequency or drift search. find best time lag. + * 1: no time lag or drift search. find best frequency. + * 2: no frequency or time lag search. calculate soft-decision + * symbols using passed frequency and shift. + */ +void sync_and_demodulate(std::vector> &iqdat, + long np, + unsigned char *symbols, + float *freq, + int ifmin, + int ifmax, + float fstep, + int *shift, + int lagmin, + int lagmax, + int lagstep, + float *drift, + int symfac, + float *sync, + int mode) { + + float i0[NSYM], q0[NSYM], + i1[NSYM], q1[NSYM], + i2[NSYM], q2[NSYM], + i3[NSYM], q3[NSYM]; + float c0[NSPERSYM], s0[NSPERSYM], + c1[NSPERSYM], s1[NSPERSYM], + c2[NSPERSYM], s2[NSPERSYM], + c3[NSPERSYM], s3[NSPERSYM]; + float fsymb[NSYM]; + + float fbest = 0.0, + fsum = 0.0, + f2sum = 0.0; + + int best_shift = 0; + static float fplast = -10000.0; + float syncmax = -1e30; + + if (mode == 0) { + ifmin = 0; + ifmax = 0; + fstep = 0.0; + } else if (mode == 1) { + lagmin = *shift; + lagmax = *shift; + } else if (mode == 2) { + lagmin = *shift; + lagmax = *shift; + ifmin = 0; + ifmax = 0; + } + + for (int ifreq = ifmin; ifreq <= ifmax; ifreq++) { + float f0 = *freq + ifreq * fstep; + for (int lag = lagmin; lag <= lagmax; lag = lag + lagstep) { + float ss = 0.0; + float totp = 0.0; + for (int i = 0; i < NSYM; i++) { + float fp = f0 + (*drift / 2.0) * ((float)i - (float)NBITS) / (float)NBITS; + if (i == 0 || (fp != fplast)) { // only calculate sin/cos if necessary + float dphi0 = TWOPIDT * (fp - DF15); + float cdphi0 = cosf(dphi0); + float sdphi0 = sinf(dphi0); + + float dphi1 = TWOPIDT * (fp - DF05); + float cdphi1 = cosf(dphi1); + float sdphi1 = sinf(dphi1); + + float dphi2 = TWOPIDT * (fp + DF05); + float cdphi2 = cosf(dphi2); + float sdphi2 = sinf(dphi2); + + float dphi3 = TWOPIDT * (fp + DF15); + float cdphi3 = cosf(dphi3); + float sdphi3 = sinf(dphi3); + + c0[0] = 1; s0[0] = 0; + c1[0] = 1; s1[0] = 0; + c2[0] = 1; s2[0] = 0; + c3[0] = 1; s3[0] = 0; + + for (int j = 1; j < NSPERSYM; j++) { + c0[j] = c0[j - 1] * cdphi0 - s0[j - 1] * sdphi0; + s0[j] = c0[j - 1] * sdphi0 + s0[j - 1] * cdphi0; + c1[j] = c1[j - 1] * cdphi1 - s1[j - 1] * sdphi1; + s1[j] = c1[j - 1] * sdphi1 + s1[j - 1] * cdphi1; + c2[j] = c2[j - 1] * cdphi2 - s2[j - 1] * sdphi2; + s2[j] = c2[j - 1] * sdphi2 + s2[j - 1] * cdphi2; + c3[j] = c3[j - 1] * cdphi3 - s3[j - 1] * sdphi3; + s3[j] = c3[j - 1] * sdphi3 + s3[j - 1] * cdphi3; + } + fplast = fp; + } + + i0[i] = 0.0; q0[i] = 0.0; + i1[i] = 0.0; q1[i] = 0.0; + i2[i] = 0.0; q2[i] = 0.0; + i3[i] = 0.0; q3[i] = 0.0; + + for (int j = 0; j < NSPERSYM; j++) { + int k = lag + i * NSPERSYM + j; + if ((k > 0) && (k < np)) { + i0[i] = i0[i] + iqdat[k].real() * c0[j] + iqdat[k].imag() * s0[j]; + q0[i] = q0[i] - iqdat[k].real() * s0[j] + iqdat[k].imag() * c0[j]; + i1[i] = i1[i] + iqdat[k].real() * c1[j] + iqdat[k].imag() * s1[j]; + q1[i] = q1[i] - iqdat[k].real() * s1[j] + iqdat[k].imag() * c1[j]; + i2[i] = i2[i] + iqdat[k].real() * c2[j] + iqdat[k].imag() * s2[j]; + q2[i] = q2[i] - iqdat[k].real() * s2[j] + iqdat[k].imag() * c2[j]; + i3[i] = i3[i] + iqdat[k].real() * c3[j] + iqdat[k].imag() * s3[j]; + q3[i] = q3[i] - iqdat[k].real() * s3[j] + iqdat[k].imag() * c3[j]; + } + } + + float p0 = sqrt(i0[i] * i0[i] + q0[i] * q0[i]); + float p1 = sqrt(i1[i] * i1[i] + q1[i] * q1[i]); + float p2 = sqrt(i2[i] * i2[i] + q2[i] * q2[i]); + float p3 = sqrt(i3[i] * i3[i] + q3[i] * q3[i]); + + totp = totp + p0 + p1 + p2 + p3; + float cmet = (p1 + p3) - (p0 + p2); + ss = (pr3vector[i] == 1) ? ss + cmet : ss - cmet; + if (mode == 2) { // Compute soft symbols + if (pr3vector[i] == 1) { + fsymb[i] = p3 - p1; + } else { + fsymb[i] = p2 - p0; + } + } + } + ss = ss / totp; + if (ss > syncmax) { // Save best parameters + syncmax = ss; + best_shift = lag; + fbest = f0; + } + } // lag loop + } // freq loop + + if (mode <= 1) { // Send best params back to caller + *sync = syncmax; + *shift = best_shift; + *freq = fbest; + return; + } + + if (mode == 2) { + *sync = syncmax; + for (int i = 0; i < NSYM; i++) { // Normalize the soft symbols + fsum += fsymb[i] / NSYM; + f2sum += fsymb[i] * fsymb[i] / NSYM; + } + float fac = sqrt(f2sum - fsum * fsum); + for (int i = 0; i < NSYM; i++) { + fsymb[i] = symfac * fsymb[i] / fac; + if (fsymb[i] > 127) fsymb[i] = 127.0; + if (fsymb[i] < -128) fsymb[i] = -128.0; + symbols[i] = fsymb[i] + 128; + } + return; + } + return; +} + + +/* symbol-by-symbol signal subtraction */ +void subtract_signal(std::vector> &iqdat, + long np, + float f0, + int shift, + float drift, + unsigned char *channel_symbols) { + + float c0[NSPERSYM], s0[NSPERSYM]; + + for (int i = 0; i < NSYM; i++) { + float fp = f0 + ((float)drift / 2.0) * ((float)i - (float)NBITS) / (float)NBITS; + + float dphi = TWOPIDT * (fp + ((float)channel_symbols[i] - 1.5) * DF); + float cdphi = cosf(dphi); + float sdphi = sinf(dphi); + + c0[0] = 1; + s0[0] = 0; + + for (int j = 1; j < NSPERSYM; j++) { + c0[j] = c0[j - 1] * cdphi - s0[j - 1] * sdphi; + s0[j] = c0[j - 1] * sdphi + s0[j - 1] * cdphi; + } + + float i0 = 0.0; + float q0 = 0.0; + + for (int j = 0; j < NSPERSYM; j++) { + int k = shift + i * NSPERSYM + j; + if ((k > 0) & (k < np)) { + i0 = i0 + iqdat[k].real() * c0[j] + iqdat[k].imag() * s0[j]; + q0 = q0 - iqdat[k].real() * s0[j] + iqdat[k].imag() * c0[j]; + } + } + + // subtract the signal here. + i0 = i0 / (float)NSPERSYM; // will be wrong for partial symbols at the edges... + q0 = q0 / (float)NSPERSYM; + + for (int j = 0; j < NSPERSYM; j++) { + int k = shift + i * NSPERSYM + j; + if ((k > 0) & (k < np)) { + iqdat[k].real(iqdat[k].real() - (i0 * c0[j] - q0 * s0[j])); + iqdat[k].imag(iqdat[k].imag() - (q0 * c0[j] + i0 * s0[j])); + } + } + } + return; +} + + +/* Subtract the coherent component of a signal */ +void subtract_signal2(std::vector> &iqdat, + long np, + float f0, + int shift, + float drift, + unsigned char *channel_symbols) { + + float phi = 0.0; + const int nfilt = 360; // nfilt must be even number. + + float refi[SIGNAL_SAMPLES] = {0}, refq[SIGNAL_SAMPLES] = {0}, + ci[SIGNAL_SAMPLES] = {0}, cq[SIGNAL_SAMPLES] = {0}, + cfi[SIGNAL_SAMPLES] = {0}, cfq[SIGNAL_SAMPLES] = {0}; + + /****************************************************************************** + Measured signal: s(t)=a(t)*exp( j*theta(t) ) + Reference is: r(t) = exp( j*phi(t) ) + Complex amplitude is estimated as: c(t)=LPF[s(t)*conjugate(r(t))] + so c(t) has phase angle theta-phi + Multiply r(t) by c(t) and subtract from s(t), i.e. s'(t)=s(t)-c(t)r(t) + *******************************************************************************/ + + /* create reference wspr signal vector, centered on f0. */ + for (int i = 0; i < NSYM; i++) { + float cs = (float)channel_symbols[i]; + + float dphi = TWOPIDT * (f0 + (drift / 2.0) * ((float)i - (float)NSYM / 2.0) / ((float)NSYM / 2.0) + (cs - 1.5) * DF); + + for (int j = 0; j < NSPERSYM; j++) { + int ii = NSPERSYM * i + j; + refi[ii] = cosf(phi); // cannot precompute sin/cos because dphi is changing + refq[ii] = sinf(phi); + phi = phi + dphi; + } + } + + float w[nfilt], norm = 0, partialsum[nfilt]; + + /* lowpass filter and remove startup transient */ + for (int i = 0; i < nfilt; i++) { + partialsum[i] = 0.0; + } + for (int i = 0; i < nfilt; i++) { + w[i] = sinf(M_PI * (float)i / (float)(nfilt - 1)); + norm = norm + w[i]; + } + for (int i = 0; i < nfilt; i++) { + w[i] = w[i] / norm; + } + for (int i = 1; i < nfilt; i++) { + partialsum[i] = partialsum[i - 1] + w[i]; + } + + // s(t) * conjugate(r(t)) + // beginning of first symbol in reference signal is at i=0 + // beginning of first symbol in received data is at shift value. + // filter transient lasts nfilt samples + // leave nfilt zeros as a pad at the beginning of the unfiltered reference signal + for (int i = 0; i < NSYM * NSPERSYM; i++) { + int k = shift + i; + if ((k > 0) && (k < np)) { + ci[i + nfilt] = iqdat[k].real() * refi[i] + iqdat[k].imag() * refq[i]; + cq[i + nfilt] = iqdat[k].imag() * refi[i] - iqdat[k].real() * refq[i]; + } + } + + // LPF + for (int i = nfilt / 2; i < SIGNAL_SAMPLES - nfilt / 2; i++) { + cfi[i] = 0.0; + cfq[i] = 0.0; + for (int j = 0; j < nfilt; j++) { + cfi[i] = cfi[i] + w[j] * ci[i - nfilt / 2 + j]; + cfq[i] = cfq[i] + w[j] * cq[i - nfilt / 2 + j]; + } + } + + // subtract c(t)*r(t) here + // (ci+j*cq)(refi+j*refq)=(ci*refi-cq*refq)+j(ci*refq+cq*refi) + // beginning of first symbol in reference signal is at i=nfilt + // beginning of first symbol in received data is at shift value. + for (int i = 0; i < NSYM * NSPERSYM; i++) { + if (i < nfilt / 2) { // take care of the end effect (LPF step response) here + norm = partialsum[nfilt / 2 + i]; + } else if (i > (NSYM * NSPERSYM - 1 - nfilt / 2)) { + norm = partialsum[nfilt / 2 + NSYM * NSPERSYM - 1 - i]; + } else { + norm = 1.0; + } + int k = shift + i; + int j = i + nfilt; + if ((k > 0) && (k < np)) { + iqdat[k].real(iqdat[k].real() - (cfi[j] * refi[i] - cfq[j] * refq[i]) / norm); + iqdat[k].imag(iqdat[k].imag() - (cfi[j] * refq[i] + cfq[j] * refi[i]) / norm); + } + } + return; +} + +int wspr_decode(std::vector> &iqdat, + int samples, + decoder_options options, + std::vector &decodes, + int threads) { + + /* Parameters used for performance-tuning */ + float minsync1 = 0.10; // First sync limit + float minsync2 = 0.12; // Second sync limit + int iifac = 3; // Step size in final DT peakup + int symfac = 50; // Soft-symbol normalizing factor + int maxdrift = 4; // Maximum (+/-) drift + float minrms = 52.0 * (symfac / 64.0); // Final test for plausible decoding + int delta = 60; // Fano threshold step + int maxcycles = 10000; // Fano timeout limit + float fmin = -110.0; + float fmax = 110.0; + + /* Search live parameters */ + float fstep; + int lagmin; + int lagmax; + int lagstep; + int ifmin; + int ifmax; + + /* Decoder flags */ + int worth_a_try; + int uniques = 0; + + decodes.clear(); + fftwf_plan_with_nthreads(threads); + /* CPU usage stats */ + uint32_t metric, cycles, maxnp; + + /* Candidates properties */ + struct cand candidates[200]; + + /* Decoded candidate */ + uint8_t symbols[NBITS * 2] = {0}; + uint8_t decdata[(NBITS + 7) / 8] = {0}; + int8_t message[12] = {0}; + + /* Results */ + char callsign[13] = {0}; + char call_loc_pow[23] = {0}; + char call[13] = {0}; + char loc[7] = {0}; + char pwr[3] = {0}; + float allfreqs[100] = {0}; + char allcalls[100][13] = {0}; + + /* Setup metric table */ + int32_t mettab[2][256]; + float bias = 0.45; + for (int i = 0; i < 256; i++) { + mettab[0][i] = roundf(10.0 * (metric_tables[2][i] - bias)); + mettab[1][i] = roundf(10.0 * (metric_tables[2][255 - i] - bias)); + } + + /* Setup/Load hash tables */ + FILE *fhash; + int nh; + char hashtab[32768 * 13] = {0}; + char loctab[32768 * 5] = {0}; + + if (options.usehashtable) { + char line[80], hcall[12], hgrid[5];; + if ((fhash = fopen("hashtable.txt", "r+"))) { + while (fgets(line, sizeof(line), fhash) != NULL) { + hgrid[0] = '\0'; + sscanf(line, "%d %s %s", &nh, hcall, hgrid); + strcpy(hashtab + nh * 13, hcall); + if (strlen(hgrid) > 0) strcpy(loctab + nh * 5, hgrid); + } + fclose(fhash); + } + } + + /* FFT buffer (512 bins) */ + fftwf_complex *fftin, *fftout; + fftin = (fftwf_complex *)fftwf_malloc(sizeof(fftwf_complex) * 512); + fftout = (fftwf_complex *)fftwf_malloc(sizeof(fftwf_complex) * 512); + PLAN = fftwf_plan_dft_1d(512, fftin, fftout, FFTW_FORWARD, PATIENCE); + + /* Recover FFTW optimization settings */ + FILE *fp_fftw_wisdom_file; + if ((fp_fftw_wisdom_file = fopen("fftw_wisdom.dat", "r"))) { // Open FFTW wisdom + fftwf_import_wisdom_from_file(fp_fftw_wisdom_file); + fclose(fp_fftw_wisdom_file); + } + + /* Hann function */ + float hann[512]; + for (int i = 0; i < 512; i++) { + hann[i] = sinf(0.006147931 * i); + } + + /* FFT output alloc */ + const int blocks = 4 * floor(samples / 512) - 1; + float ps[512][blocks]; + memset(ps, 0.0, sizeof(float) * 512 * blocks); + + /* Main loop starts here */ + for (int ipass = 0; ipass < options.npasses; ipass++) { + if (ipass == 1 && uniques == 0) + break; + if (ipass < 2) { + maxdrift = 4; + minsync2 = 0.12; + } + if (ipass == 2) { + maxdrift = 0; // no drift for smaller frequency estimator variance + minsync2 = 0.10; + } + + /* Compute FFT + * FFT over 2 symbols, stepped by half symbols + */ + for (int i = 0; i < blocks; i++) { + /* Load samples */ + for (int j = 0; j < 512; j++) { + int k = i * 128 + j; + fftin[j][0] = iqdat[k].real() * hann[j]; + fftin[j][1] = iqdat[k].imag() * hann[j]; + } + + fftwf_execute(PLAN); + + /* Recover frequencies */ + for (int j = 0; j < 512; j++) { + int k = j + 256; + if (k > 511) + k = k - 512; + ps[j][i] = fftout[k][0] * fftout[k][0] + fftout[k][1] * fftout[k][1]; + } + } + + // Compute average spectrum + float psavg[512] = {0}; + for (int i = 0; i < blocks; i++) { + for (int j = 0; j < 512; j++) { + psavg[j] += ps[j][i]; + } + } + + // Already restricted by previous FIR + // Smooth with 7-point window and limit spectrum to +/-150 Hz + int32_t window[7] = {1, 1, 1, 1, 1, 1, 1}; + float smspec[411]; + for (int i = 0; i < 411; i++) { + smspec[i] = 0.0; + for (int j = -3; j <= 3; j++) { + int k = 256 - 205 + i + j; + smspec[i] += window[j + 3] * psavg[k]; + } + } + + // Sort spectrum values, then pick off noise level as a percentile + float tmpsort[411]; + for (int j = 0; j < 411; j++) { + tmpsort[j] = smspec[j]; + } + qsort(tmpsort, 411, sizeof(float), floatcomp); + + // Noise level of spectrum is estimated as 123/411= 30'th percentile + float noise_level = tmpsort[122]; + + /* Renormalize spectrum so that (large) peaks represent an estimate of snr. + * We know from experience that threshold snr is near -7dB in wspr bandwidth, + * corresponding to -7-26.3=-33.3dB in 2500 Hz bandwidth. + * The corresponding threshold is -42.3 dB in 2500 Hz bandwidth for WSPR-15. */ + + float min_snr = powf(10.0, -8.0 / 10.0); // this is min snr in wspr bw + float snr_scaling_factor = 26.3; + + for (int j = 0; j < 411; j++) { + smspec[j] = smspec[j] / noise_level - 1.0; + if (smspec[j] < min_snr) smspec[j] = 0.1 * min_snr; + continue; + } + + // Find all local maxima in smoothed spectrum. + for (int i = 0; i < 200; i++) { + candidates[i].freq = 0.0; + candidates[i].snr = 0.0; + candidates[i].drift = 0.0; + candidates[i].shift = 0; + candidates[i].sync = 0.0; + } + + int npk = 0; + unsigned char candidate; + for (int j = 1; j < 410; j++) { + candidate = (smspec[j] > smspec[j - 1]) && + (smspec[j] > smspec[j + 1]) && + (npk < 200); + if (candidate) { + candidates[npk].freq = (j - 205) * (DF / 2.0); + candidates[npk].snr = 10.0 * log10f(smspec[j]) - snr_scaling_factor; + npk++; + } + } + + // Don't waste time on signals outside of the range [fmin,fmax]. + int i = 0; + for (int j = 0; j < npk; j++) { + if (candidates[j].freq >= fmin && candidates[j].freq <= fmax) { + candidates[i] = candidates[j]; + i++; + } + } + npk = i; + + // bubble sort on snr, bringing freq along for the ride + struct cand tmp; + for (int pass = 1; pass <= npk - 1; pass++) { + for (int k = 0; k < npk - pass; k++) { + if (candidates[k].snr < candidates[k + 1].snr) { + tmp = candidates[k]; + candidates[k] = candidates[k + 1]; + candidates[k + 1] = tmp; + } + } + } + + /* Make coarse estimates of shift (DT), freq, and drift + * Look for time offsets up to +/- 8 symbols (about +/- 5.4 s) relative + to nominal start time, which is 2 seconds into the file + * Calculates shift relative to the beginning of the file + * Negative shifts mean that signal started before start of file + * The program prints DT = shift-2 s + * Shifts that cause sync vector to fall off of either end of the data + vector are accommodated by "partial decoding", such that missing + symbols produce a soft-decision symbol value of 128 + * The frequency drift model is linear, deviation of +/- drift/2 over the + span of 162 symbols, with deviation equal to 0 at the center of the + signal vector. + */ + for (int j = 0; j < npk; j++) { // For each candidate... + float sync, sync_max = -1e30; + int if0 = candidates[j].freq / (DF / 2.0) + NSPERSYM; + for (int ifr = if0 - 1; ifr <= if0 + 1; ifr++) { // Freq search + for (int k0 = -10; k0 < 22; k0++) { // Time search + for (int idrift = -maxdrift; idrift <= maxdrift; idrift++) { // Drift search + float ss = 0.0; + float pow = 0.0; + for (int k = 0; k < NSYM; k++) { // Sum over symbols + int ifd = ifr + ((float)k - (float)NBITS) / (float)NBITS * ((float)idrift) / DF; + int kindex = k0 + 2 * k; + if (kindex < blocks) { + float p0 = sqrtf(ps[ifd - 3][kindex]); + float p1 = sqrtf(ps[ifd - 1][kindex]); + float p2 = sqrtf(ps[ifd + 1][kindex]); + float p3 = sqrtf(ps[ifd + 3][kindex]); + + ss = ss + (2 * pr3vector[k] - 1) * ((p1 + p3) - (p0 + p2)); + pow = pow + p0 + p1 + p2 + p3; + sync = ss / pow; + } + } + if (sync > sync_max) { // Save coarse parameters + sync_max = sync; + candidates[j].shift = 128 * (k0 + 1); + candidates[j].drift = idrift; + candidates[j].freq = (ifr - NSPERSYM) * (DF / 2.0); + candidates[j].sync = sync; + } + } + } + } + } + + /* + Refine the estimates of freq, shift using sync as a metric. + Sync is calculated such that it is a float taking values in the range + [0.0,1.0]. + + Function sync_and_demodulate has three modes of operation + mode is the last argument: + + 0 = no frequency or drift search. find best time lag. + 1 = no time lag or drift search. find best frequency. + 2 = no frequency or time lag search. Calculate soft-decision + symbols using passed frequency and shift. + + NB: best possibility for OpenMP may be here: several worker threads + could each work on one candidate at a time. + */ + + for (int j = 0; j < npk; j++) { + memset(callsign, 0, sizeof(char) * 13); + memset(call_loc_pow, 0, sizeof(char) * 23); + memset(call, 0, sizeof(char) * 13); + memset(loc, 0, sizeof(char) * 7); + memset(pwr, 0, sizeof(char) * 3); + + float freq = candidates[j].freq; + float drift = candidates[j].drift; + float sync = candidates[j].sync; + int shift = candidates[j].shift; + + // Search for best sync lag (mode 0) + fstep = 0.0; + ifmin = 0; + ifmax = 0; + lagmin = shift - 128; + lagmax = shift + 128; + lagstep = 8; + if (options.quickmode) + lagstep = 16; + sync_and_demodulate(iqdat, samples, symbols, &freq, ifmin, ifmax, fstep, &shift, + lagmin, lagmax, lagstep, &drift, symfac, &sync, 0); + + // Search for frequency peak (mode 1) + fstep = 0.1; + ifmin = -2; + ifmax = 2; + sync_and_demodulate(iqdat, samples, symbols, &freq, ifmin, ifmax, fstep, &shift, + lagmin, lagmax, lagstep, &drift, symfac, &sync, 1); + + candidates[j].freq = freq; + candidates[j].shift = shift; + candidates[j].drift = drift; + candidates[j].sync = sync; + + if (sync > minsync1) { + worth_a_try = 1; + } else { + worth_a_try = 0; + } + + int idt = 0, ii = 0; + int not_decoded = 1; + while (worth_a_try && not_decoded && idt <= (128 / iifac)) { + ii = (idt + 1) / 2; + if (idt % 2 == 1) ii = -ii; + ii = iifac * ii; + int jiggered_shift = shift + ii; + + // Use mode 2 to get soft-decision symbols + sync_and_demodulate(iqdat, samples, symbols, &freq, ifmin, ifmax, fstep, + &jiggered_shift, lagmin, lagmax, lagstep, &drift, symfac, + &sync, 2); + float sq = 0.0; + for (i = 0; i < NSYM; i++) { + float y = (float)symbols[i] - 128.0; + sq += y * y; + } + float rms = sqrtf(sq / (float)NSYM); + + if ((sync > minsync2) && (rms > minrms)) { + deinterleave(symbols); + not_decoded = fano(&metric, &cycles, &maxnp, decdata, symbols, NBITS, + mettab, delta, maxcycles); + } + idt++; + if (options.quickmode) + break; + } + + if (worth_a_try && !not_decoded) { + for (i = 0; i < 11; i++) { + if (decdata[i] > 127) { + message[i] = decdata[i] - 256; + } else { + message[i] = decdata[i]; + } + } + + // Unpack the decoded message, update the hashtable, apply + // sanity checks on grid and power, and return + // call_loc_pow string and also callsign (for de-duping). + int32_t noprint = unpk_(message, hashtab, loctab, call_loc_pow, call, loc, pwr, callsign); + if (options.subtraction && (ipass == 0) && !noprint) { + unsigned char channel_symbols[NSYM]; + + if (get_wspr_channel_symbols(call_loc_pow, hashtab, loctab, channel_symbols)) { + subtract_signal2(iqdat, samples, freq, shift, drift, channel_symbols); + } else { + break; + } + } + + // Avoid this incorrect pattern + if (!strcmp(loc, "A000AA")) + break; + + // Remove dupes (same callsign and freq within 3 Hz) + int32_t dupe = 0; + for (i = 0; i < uniques; i++) { + if (!strcmp(callsign, allcalls[i]) && (fabs(freq - allfreqs[i]) < 3.0)) + dupe = 1; + } + + if (!dupe) { + strcpy(allcalls[uniques], callsign); + allfreqs[uniques] = freq; + uniques++; + + double dialfreq = (double)options.freq / 1e6; + double freq_print = dialfreq + (1500.0 + freq) / 1e6; + + struct decoder_results temp; + + temp.sync = candidates[j].sync; + temp.snr = candidates[j].snr; + temp.dt = shift * DT - 2.0; + temp.freq = freq_print; + temp.drift = drift; + temp.cycles = cycles; + temp.jitter = ii; + strcpy(temp.message, call_loc_pow); + strcpy(temp.call, call); + strcpy(temp.loc, loc); + strcpy(temp.pwr, pwr); + decodes.push_back(temp); + + /*decodes[uniques - 1].sync = candidates[j].sync; + decodes[uniques - 1].snr = candidates[j].snr; + decodes[uniques - 1].dt = shift * DT - 2.0; + decodes[uniques - 1].freq = freq_print; + decodes[uniques - 1].drift = drift; + decodes[uniques - 1].cycles = cycles; + decodes[uniques - 1].jitter = ii; + strcpy(decodes[uniques - 1].message, call_loc_pow); + strcpy(decodes[uniques - 1].call, call); + strcpy(decodes[uniques - 1].loc, loc); + strcpy(decodes[uniques - 1].pwr, pwr); */ + } + } + } + } + + /* Sort the result */ + struct decoder_results temp; + for (int j = 1; j <= uniques - 1; j++) { + for (int k = 0; k < uniques - j; k++) { + if (decodes[k].snr < decodes[k + 1].snr) { + temp = decodes[k]; + decodes[k] = decodes[k + 1]; + decodes[k + 1] = temp; + } + } + } + + /* Return number of spots to the calling fct */ + //n_results = uniques; + + fftwf_free(fftin); + fftwf_free(fftout); + + if ((fp_fftw_wisdom_file = fopen("fftw_wisdom.dat", "w"))) { + fftwf_export_wisdom_to_file(fp_fftw_wisdom_file); + fclose(fp_fftw_wisdom_file); + } + + fftwf_destroy_plan(PLAN); + + if (options.usehashtable) { + fhash = fopen("hashtable.txt", "w"); + for (int i = 0; i < 32768; i++) { + if (strncmp(hashtab + i * 13, "\0", 1) != 0) { + fprintf(fhash, "%5d %s %s\n", i, hashtab + i * 13, loctab + i * 5); + } + } + fclose(fhash); + } + + return 0; +} diff --git a/wsjtx_lib/wsprd/wsprd.h b/wsjtx_lib/wsprd/wsprd.h new file mode 100644 index 0000000..c285c43 --- /dev/null +++ b/wsjtx_lib/wsprd/wsprd.h @@ -0,0 +1,80 @@ +/* + This file is part of program wsprd, a detector/demodulator/decoder + for the Weak Signal Propagation Reporter (WSPR) mode. + + File name: wsprd.c + + Copyright 2001-2015, Joe Taylor, K1JT + + Much of the present code is based on work by Steven Franke, K9AN, + which in turn was based on earlier work by K1JT. + + Copyright 2014-2015, Steven Franke, K9AN + + Minor modifications + + Copyright 2016, Guenael Jouchet, VA2GKA + + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + */ + +#pragma once +#include "../wsjtx_lib.h" +/* Option & config of decoder (Shared with the wsprd code) */ +/* +class decoder_results +{ + public: + double freq; + float sync; + float snr; + float dt; + float drift; + int jitter; + char message[23]; + char call[13]; + char loc[7]; + char pwr[3]; + int cycles; +}; + +class decoder_options +{ + public: + int freq; // Dial frequency + char rcall[13]; // Callsign of the RX station + char rloc[7]; // Locator of the RX station + int quickmode; // Decoder option & tweak + int usehashtable; // '' + int npasses; // '' + int subtraction; // '' + + decoder_options(); +}; +*/ +struct cand { + float freq; + float snr; + int shift; + float drift; + float sync; +}; + + + + + + diff --git a/wsjtx_lib/wsprd/wsprd_utils.cpp b/wsjtx_lib/wsprd/wsprd_utils.cpp new file mode 100644 index 0000000..9a63009 --- /dev/null +++ b/wsjtx_lib/wsprd/wsprd_utils.cpp @@ -0,0 +1,354 @@ +/* + This file is part of program wsprd, a detector/demodulator/decoder + for the Weak Signal Propagation Reporter (WSPR) mode. + + File name: wsprd_utils.c + + Copyright 2001-2015, Joe Taylor, K1JT + + Most of the code is based on work by Steven Franke, K9AN, which + in turn was based on earlier work by K1JT. + + Copyright 2014-2015, Steven Franke, K9AN + + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*/ + +#include +#include +#include +#include + +#include "./nhash.h" +#include "./wsprd_utils.h" + +// EVAL -- Replace strcpy & strncpy by strcpy to prevent possible buffer overflow +// #pragma GCC diagnostic ignored "-Wstringop-overflow" +// #pragma GCC diagnostic ignored "-Wstringop-truncation" + +void unpack50(signed char *dat, int32_t *n1, int32_t *n2) { + int32_t i, i4; + + i = dat[0]; + i4 = i & 255; + *n1 = i4 << 20; + + i = dat[1]; + i4 = i & 255; + *n1 = *n1 + (i4 << 12); + + i = dat[2]; + i4 = i & 255; + *n1 = *n1 + (i4 << 4); + + i = dat[3]; + i4 = i & 255; + *n1 = *n1 + ((i4 >> 4) & 15); + *n2 = (i4 & 15) << 18; + + i = dat[4]; + i4 = i & 255; + *n2 = *n2 + (i4 << 10); + + i = dat[5]; + i4 = i & 255; + *n2 = *n2 + (i4 << 2); + + i = dat[6]; + i4 = i & 255; + *n2 = *n2 + ((i4 >> 6) & 3); +} + +int unpackcall(int32_t ncall, char *call) { + char c[] = {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', + 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', + 'U', 'V', 'W', 'X', 'Y', 'Z', ' '}; + int32_t n; + int i; + char tmp[7]; + + n = ncall; + strcpy(call, "......"); + if (n < 262177560) { + i = n % 27 + 10; + tmp[5] = c[i]; + n = n / 27; + i = n % 27 + 10; + tmp[4] = c[i]; + n = n / 27; + i = n % 27 + 10; + tmp[3] = c[i]; + n = n / 27; + i = n % 10; + tmp[2] = c[i]; + n = n / 10; + i = n % 36; + tmp[1] = c[i]; + n = n / 36; + i = n; + tmp[0] = c[i]; + tmp[6] = '\0'; + // remove leading whitespace + for (i = 0; i < 5; i++) { + if (tmp[i] != c[36]) + break; + } + sprintf(call, "%-6s", &tmp[i]); + // remove trailing whitespace + for (i = 0; i < 6; i++) { + if (call[i] == c[36]) { + call[i] = '\0'; + } + } + } else { + return 0; + } + return 1; +} + +int unpackgrid(int32_t ngrid, char *grid) { + char c[] = {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', + 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', + 'U', 'V', 'W', 'X', 'Y', 'Z', ' '}; + int dlat, dlong; + + ngrid = ngrid >> 7; + if (ngrid < 32400) { + dlat = (ngrid % 180) - 90; + dlong = (ngrid / 180) * 2 - 180 + 2; + if (dlong < -180) + dlong = dlong + 360; + if (dlong > 180) + dlong = dlong + 360; + int nlong = 60.0 * (180.0 - dlong) / 5.0; + int n1 = nlong / 240; + int n2 = (nlong - 240 * n1) / 24; + grid[0] = c[10 + n1]; + grid[2] = c[n2]; + + int nlat = 60.0 * (dlat + 90) / 2.5; + n1 = nlat / 240; + n2 = (nlat - 240 * n1) / 24; + grid[1] = c[10 + n1]; + grid[3] = c[n2]; + } else { + strcpy(grid, "XXXX"); + return 0; + } + return 1; +} + +int unpackpfx(int32_t nprefix, char *call) { + char nc, pfx[4] = {'\0'}, tmpcall[7]; + int i; + int32_t n; + + strcpy(tmpcall, call); + if (nprefix < 60000) { + // add a prefix of 1 to 3 characters + n = nprefix; + for (i = 2; i >= 0; i--) { + nc = n % 37; + if ((nc >= 0) & (nc <= 9)) { + pfx[i] = nc + 48; + } else if ((nc >= 10) & (nc <= 35)) { + pfx[i] = nc + 55; + } else { + pfx[i] = ' '; + } + n = n / 37; + } + + char *p = strrchr(pfx, ' '); + strcpy(call, p ? p + 1 : pfx); + strncat(call, "/", 1); + strncat(call, tmpcall, strlen(tmpcall)); + + } else { + // add a suffix of 1 or 2 characters + nc = nprefix - 60000; + if ((nc >= 0) & (nc <= 9)) { + pfx[0] = nc + 48; + strcpy(call, tmpcall); + strncat(call, "/", 1); + strncat(call, pfx, 1); + } else if ((nc >= 10) & (nc <= 35)) { + pfx[0] = nc + 55; + strcpy(call, tmpcall); + strncat(call, "/", 1); + strncat(call, pfx, 1); + } else if ((nc >= 36) & (nc <= 125)) { + pfx[0] = (nc - 26) / 10 + 48; + pfx[1] = (nc - 26) % 10 + 48; + strcpy(call, tmpcall); + strncat(call, "/", 1); + strncat(call, pfx, 2); + } else { + return 0; + } + } + return 1; +} + +void deinterleave(unsigned char *sym) { + unsigned char tmp[162]; + unsigned char p, i, j; + + p = 0; + i = 0; + while (p < 162) { + j = ((i * 0x80200802ULL) & 0x0884422110ULL) * 0x0101010101ULL >> 32; + if (j < 162) { + tmp[p] = sym[j]; + p = p + 1; + } + i = i + 1; + } + for (i = 0; i < 162; i++) { + sym[i] = tmp[i]; + } +} + +// used by qsort +int doublecomp(const void *elem1, const void *elem2) { + if (*(const double *)elem1 < *(const double *)elem2) + return -1; + return *(const double *)elem1 > *(const double *)elem2; +} + +int floatcomp(const void *elem1, const void *elem2) { + if (*(const float *)elem1 < *(const float *)elem2) + return -1; + return *(const float *)elem1 > *(const float *)elem2; +} + +int unpk_(signed char *message, char *hashtab, char *loctab, char *call_loc_pow, char *call, char *loc, char *pwr, char *callsign) { + int n1, n2, n3, ndbm, ihash, nadd, noprint = 0; + char grid[5], grid6[7], cdbm[4]; + + unpack50(message, &n1, &n2); + if (!unpackcall(n1, callsign)) + return 1; + if (!unpackgrid(n2, grid)) + return 1; + int ntype = (n2 & 127) - 64; + callsign[12] = 0; + grid[4] = 0; + + /* + Based on the value of ntype, decide whether this is a Type 1, 2, or + 3 message. + * Type 1: 6 digit call, grid, power - ntype is positive and is a member + of the set {0,3,7,10,13,17,20...60} + * Type 2: extended callsign, power - ntype is positive but not + a member of the set of allowed powers + * Type 3: hash, 6 digit grid, power - ntype is negative. + */ + + if ((ntype >= 0) && (ntype <= 62)) { + int nu = ntype % 10; + if (nu == 0 || nu == 3 || nu == 7) { + ndbm = ntype; + memset(call_loc_pow, 0, sizeof(char) * 23); + sprintf(cdbm, "%2d", ndbm); + strncat(call_loc_pow, callsign, strlen(callsign)); + strncat(call_loc_pow, " ", 1); + strncat(call_loc_pow, grid, 4); + strncat(call_loc_pow, " ", 1); + strncat(call_loc_pow, cdbm, 2); + strncat(call_loc_pow, "\0", 1); + ihash = nhash(callsign, strlen(callsign), (uint32_t)146); + strcpy(hashtab + ihash * 13, callsign); + strcpy(loctab + ihash * 5, grid); + + memset(call, 0, sizeof(char) * strlen(callsign) + 1); + memset(loc, 0, sizeof(char) * strlen(grid) + 1); + memset(pwr, 0, sizeof(char) * 2 + 1); + strncat(call, callsign, strlen(callsign)); + strncat(call, "\0", 1); + strncat(loc, grid, strlen(grid)); + strncat(loc, "\0", 1); + strncat(pwr, cdbm, 2); + strncat(pwr, "\0", 1); + } else { + nadd = nu; + if (nu > 3) nadd = nu - 3; + if (nu > 7) nadd = nu - 7; + n3 = n2 / 128 + 32768 * (nadd - 1); + if (!unpackpfx(n3, callsign)) return 1; + ndbm = ntype - nadd; + memset(call_loc_pow, 0, sizeof(char) * 23); + sprintf(cdbm, "%2d", ndbm); + strncat(call_loc_pow, callsign, strlen(callsign)); + strncat(call_loc_pow, " ", 1); + strncat(call_loc_pow, cdbm, 2); + strncat(call_loc_pow, "\0", 1); + int nu = ndbm % 10; + if (nu == 0 || nu == 3 || nu == 7) { // make sure power is OK + ihash = nhash(callsign, strlen(callsign), (uint32_t)146); + strcpy(hashtab + ihash * 13, callsign); + } else + noprint = 1; + } + } else if (ntype < 0) { + ndbm = -(ntype + 1); + memset(grid6, 0, sizeof(char) * 7); + // size_t len=strlen(callsign); + size_t len = 6; + strncat(grid6, callsign + len - 1, 1); + strncat(grid6, callsign, len - 1); + int nu = ndbm % 10; + if ((nu != 0 && nu != 3 && nu != 7) || + !isalpha(grid6[0]) || !isalpha(grid6[1]) || + !isdigit(grid6[2]) || !isdigit(grid6[3])) { + // not testing 4'th and 5'th chars because of this case: JO33 40 + // grid is only 4 chars even though this is a hashed callsign... + // isalpha(grid6[4]) && isalpha(grid6[5]) ) ) { + noprint = 1; + } + + ihash = (n2 - ntype - 64) / 128; + if (strncmp(hashtab + ihash * 13, "\0", 1) != 0) { + sprintf(callsign, "<%s>", hashtab + ihash * 13); + } else { + sprintf(callsign, "%5s", "<...>"); + } + + memset(call_loc_pow, 0, sizeof(char) * 23); + sprintf(cdbm, "%2d", ndbm); + strncat(call_loc_pow, callsign, strlen(callsign)); + strncat(call_loc_pow, " ", 1); + strncat(call_loc_pow, grid6, strlen(grid6)); + strncat(call_loc_pow, " ", 1); + strncat(call_loc_pow, cdbm, 2); + strncat(call_loc_pow, "\0", 1); + + memset(call, 0, sizeof(char) * strlen(callsign) + 1); + memset(loc, 0, sizeof(char) * strlen(grid6) + 1); + memset(pwr, 0, sizeof(char) * 2 + 1); + strncat(call, callsign, strlen(callsign)); + strncat(call, "\0", 1); + strncat(loc, grid6, strlen(grid6)); + strncat(loc, "\0", 1); + strncat(pwr, cdbm, 2); + strncat(pwr, "\0", 1); + + // I don't know what to do with these... They show up as "A000AA" grids. + if (ntype == -64) + noprint = 1; + } + return noprint; +} diff --git a/wsjtx_lib/wsprd/wsprd_utils.h b/wsjtx_lib/wsprd/wsprd_utils.h new file mode 100644 index 0000000..31e9422 --- /dev/null +++ b/wsjtx_lib/wsprd/wsprd_utils.h @@ -0,0 +1,42 @@ +/* + This file is part of program wsprd, a detector/demodulator/decoder + for the Weak Signal Propagation Reporter (WSPR) mode. + + File name: wsprd_utils.h + + Copyright 2001-2015, Joe Taylor, K1JT + + Most of the code is based on work by Steven Franke, K9AN, which + in turn was based on earlier work by K1JT. + + Copyright 2014-2015, Steven Franke, K9AN + + License: GNU GPL v3 + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*/ + +#pragma once + +void unpack50(signed char *dat, int32_t *n1, int32_t *n2); +int unpackcall(int32_t ncall, char *call); +int unpackgrid(int32_t ngrid, char *grid); +int unpackpfx(int32_t nprefix, char *call); +void deinterleave(unsigned char *sym); + +// used by qsort +int doublecomp(const void *elem1, const void *elem2); +int floatcomp(const void *elem1, const void *elem2); + +int unpk_(signed char *message, char *hashtab, char *loctab, char *call_loc_pow, char *call, char *loc, char *pwr, char *callsign); diff --git a/wsjtx_lib/wsprd/wsprsim_utils.cpp b/wsjtx_lib/wsprd/wsprsim_utils.cpp new file mode 100644 index 0000000..5b19f13 --- /dev/null +++ b/wsjtx_lib/wsprd/wsprsim_utils.cpp @@ -0,0 +1,307 @@ +/* + Functions used by wsprsim + */ + +#include +#include +#include +#include + +#include "./wsprsim_utils.h" +#include "./wsprd_utils.h" +#include "./nhash.h" +#include "./fano.h" + +char get_locator_character_code(char ch) { + if (ch >= 48 && ch <= 57) { // 0-9 + return ch - 48; + } + if (ch == 32) { // space + return 36; + } + if (ch >= 65 && ch <= 82) { // A-Z + return ch - 65; + } + return -1; +} + +char get_callsign_character_code(char ch) { + if (ch >= 48 && ch <= 57) { // 0-9 + return ch - 48; + } + if (ch == 32) { // space + return 36; + } + if (ch >= 65 && ch <= 90) { // A-Z + return ch - 55; + } + return -1; +} + +long unsigned int pack_grid4_power(char const *grid4, int power) { + long unsigned int m; + + m = (179 - 10 * grid4[0] - grid4[2]) * 180 + 10 * grid4[1] + grid4[3]; + m = m * 128 + power + 64; + return m; +} + +long unsigned int pack_call(char const *callsign) { + unsigned int i; + long unsigned int n; + char call6[6]; + memset(call6, ' ', sizeof(call6)); + // callsign is 6 characters in length. Exactly. + size_t call_len = strlen(callsign); + if (call_len > 6) { + return 0; + } + if (isdigit(callsign[2])) { + for (i = 0; i < call_len; i++) { + call6[i] = callsign[i]; + } + } else if (isdigit(callsign[1])) { + for (i = 1; i < call_len + 1; i++) { + call6[i] = callsign[i - 1]; + } + } + for (i = 0; i < 6; i++) { + call6[i] = get_callsign_character_code(call6[i]); + } + n = call6[0]; + n = n * 36 + call6[1]; + n = n * 10 + call6[2]; + n = n * 27 + call6[3] - 10; + n = n * 27 + call6[4] - 10; + n = n * 27 + call6[5] - 10; + return n; +} + +void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd) { + size_t i; + char *call6 = (char *)calloc(7, sizeof(char)); + size_t i1 = strcspn(callsign, "/"); + + if (callsign[i1 + 2] == 0) { + // single char suffix + for (i = 0; i < i1; i++) { + call6[i] = callsign[i]; + } + call6[i] = '\0'; + *n = pack_call(call6); + *nadd = 1; + int nc = callsign[i1 + 1]; + if (nc >= 48 && nc <= 57) { + *m = nc - 48; + } else if (nc >= 65 && nc <= 90) { + *m = nc - 65 + 10; + } else { + *m = 38; + } + *m = 60000 - 32768 + *m; + } else if (callsign[i1 + 3] == 0) { + // two char suffix + for (i = 0; i < i1; i++) { + call6[i] = callsign[i]; + } + *n = pack_call(call6); + *nadd = 1; + *m = 10 * (callsign[i1 + 1] - 48) + (callsign[i1 + 2] - 48); + *m = 60000 + 26 + *m; + } else { + char const *pfx = strtok(callsign, "/"); + char const *call = strtok(NULL, " "); + *n = pack_call(call); + size_t plen = strlen(pfx); + if (plen == 1) { + *m = 36; + *m = 37 * (*m) + 36; + } else if (plen == 2) { + *m = 36; + } else { + *m = 0; + } + for (i = 0; i < plen; i++) { + int nc = callsign[i]; + if (nc >= 48 && nc <= 57) { + nc = nc - 48; + } else if (nc >= 65 && nc <= 90) { + nc = nc - 65 + 10; + } else { + nc = 36; + } + *m = 37 * (*m) + nc; + } + *nadd = 0; + if (*m > 32768) { + *m = *m - 32768; + *nadd = 1; + } + } + free(call6); +} + +void interleave(unsigned char *sym) { + unsigned char tmp[162]; + unsigned char p, i, j; + + p = 0; + i = 0; + while (p < 162) { + j = ((i * 0x80200802ULL) & 0x0884422110ULL) * 0x0101010101ULL >> 32; + if (j < 162) { + tmp[j] = sym[p]; + p = p + 1; + } + i = i + 1; + } + for (i = 0; i < 162; i++) { + sym[i] = tmp[i]; + } +} + +int get_wspr_channel_symbols(char *rawmessage, char *hashtab, char *loctab, unsigned char *symbols) { + int m = 0, ntype = 0; + long unsigned int n = 0; + int i, j, ihash; + unsigned char pr3vector[162] = { + 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 }; + + int nu[10] = {0, -1, 1, 0, -1, 2, 1, 0, -1, 1}; + char *callsign, *grid, *powstr; + char grid4[5], message[23]; + + memset(message, 0, sizeof(char) * 23); + i = 0; + while (rawmessage[i] != 0 && i < 23) { + message[i] = rawmessage[i]; + i++; + } + + size_t i1 = strcspn(message, " "); + size_t i2 = strcspn(message, "/"); + size_t i3 = strcspn(message, "<"); + size_t i4 = strcspn(message, ">"); + size_t mlen = strlen(message); + + // Use the presence and/or absence of "<" and "/" to decide what + // type of message. No sanity checks! Beware! + + if (i1 > 3 && i1 < 7 && i2 == mlen && i3 == mlen) { + // Type 1 message: K9AN EN50 33 + // xxnxxxx xxnn nn + callsign = strtok(message, " "); + grid = strtok(NULL, " "); + powstr = strtok(NULL, " "); + int power = atoi(powstr); + n = pack_call(callsign); + + for (i = 0; i < 4; i++) { + grid4[i] = get_locator_character_code(*(grid + i)); + } + m = pack_grid4_power(grid4, power); + + } else if (i3 == 0 && i4 < mlen) { + // Type 3: EN50WC 33 + // FK52UD 37 + // send hash instead of callsign to make room for 6 char grid. + // if 4-digit locator is specified, 2 spaces are added to the end. + callsign = strtok(message, "<> "); + grid = strtok(NULL, " "); + powstr = strtok(NULL, " "); + int power = atoi(powstr); + if (power < 0) power = 0; + if (power > 60) power = 60; + power = power + nu[power % 10]; + ntype = -(power + 1); + ihash = nhash(callsign, strlen(callsign), (uint32_t)146); + m = 128 * ihash + ntype + 64; + + char grid6[7]; + memset(grid6, 0, sizeof(char) * 7); + j = strlen(grid); + for (i = 0; i < j - 1; i++) { + grid6[i] = grid[i + 1]; + } + grid6[5] = grid[0]; + n = pack_call(grid6); + } else if (i2 < mlen) { // just looks for a right slash + // Type 2: PJ4/K1ABC 37 + callsign = strtok(message, " "); + if (i2 == 0 || i2 > strlen(callsign)) return 0; // guards against pathological case + powstr = strtok(NULL, " "); + int power = atoi(powstr); + if (power < 0) power = 0; + if (power > 60) power = 60; + power = power + nu[power % 10]; + int n1, ng, nadd; + pack_prefix(callsign, &n1, &ng, &nadd); + ntype = power + 1 + nadd; + m = 128 * ng + ntype + 64; + n = n1; + } else { + return 0; + } + + // pack 50 bits + 31 (0) tail bits into 11 bytes + unsigned char it, data[11]; + memset(data, 0, sizeof(char) * 11); + it = 0xFF & (n >> 20); + data[0] = it; + it = 0xFF & (n >> 12); + data[1] = it; + it = 0xFF & (n >> 4); + data[2] = it; + it = ((n & (0x0F)) << 4) + ((m >> 18) & (0x0F)); + data[3] = it; + it = 0xFF & (m >> 10); + data[4] = it; + it = 0xFF & (m >> 2); + data[5] = it; + it = (m & 0x03) << 6; + data[6] = it; + data[7] = 0; + data[8] = 0; + data[9] = 0; + data[10] = 0; + + // make sure that the 11-byte data vector is unpackable + // unpack it with the routine that the decoder will use and display + // the result. let the operator decide whether it worked. + + char *check_call_loc_pow, *check_callsign, *call, *loc, *pwr; + check_call_loc_pow = (char *)malloc(sizeof(char) * 23); + check_callsign = (char *)malloc(sizeof(char) * 13); + call = (char *)malloc(sizeof(char) * 13); + loc = (char *)malloc(sizeof(char) * 7); + pwr = (char *)malloc(sizeof(char) * 3); + signed char check_data[11]; + memcpy(check_data, data, sizeof(char) * 11); + + unpk_(check_data, hashtab, loctab, check_call_loc_pow, call, loc, pwr, check_callsign); + // printf("Will decode as: %s\n",check_call_loc_pow); + + unsigned int nbytes = 11; // The message with tail is packed into almost 11 bytes. + unsigned char channelbits[nbytes * 8 * 2]; /* 162 rounded up */ + memset(channelbits, 0, sizeof(char) * nbytes * 8 * 2); + + encode(channelbits, data, nbytes); + + interleave(channelbits); + + for (i = 0; i < 162; i++) { + symbols[i] = 2 * channelbits[i] + pr3vector[i]; + } + free(check_call_loc_pow); + free(check_callsign); + return 1; +} + diff --git a/wsjtx_lib/wsprd/wsprsim_utils.h b/wsjtx_lib/wsprd/wsprsim_utils.h new file mode 100644 index 0000000..a6d208f --- /dev/null +++ b/wsjtx_lib/wsprd/wsprsim_utils.h @@ -0,0 +1,9 @@ +#pragma once + +char get_locator_character_code(char ch); +char get_callsign_character_code(char ch); +long unsigned int pack_grid4_power(char const *grid4, int power); +long unsigned int pack_call(char const *callsign); +void pack_prefix(char *callsign, int32_t *n, int32_t *m, int32_t *nadd); +void interleave(unsigned char *sym); +int get_wspr_channel_symbols(char *rawmessage, char *hashtab, char *loctab, unsigned char *symbols);