w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-22 04:11:16 -05:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'feat-fst280' into develop

Browse Source
This commit is contained in:
Bill Somerville 2020-07-31 15:03:56 +01:00
commit f300c9afc5
No known key found for this signature in database
GPG Key ID: D864B06D1E81618F
75 changed files with 7508 additions and 1384 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

@ -11,3 +11,8 @@ jnq*
*.txt
cmake-build-debug
cmake-build-release
CMakeFiles
fnd
lib/77bit/tmp
lib/tmp
lib/ftrsd

30
CMakeLists.txt
View File

@ -359,6 +359,8 @@ endif (WIN32)
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
@ -370,6 +372,7 @@ set (wsjt_FSRCS
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
@ -396,6 +399,7 @@ set (wsjt_FSRCS
lib/badmsg.f90
lib/ft8/baseline.f90
lib/ft4/ft4_baseline.f90
lib/blanker.f90
lib/bpdecode40.f90
lib/bpdecode128_90.f90
lib/ft8/bpdecode174_91.f90
@ -545,6 +549,7 @@ set (wsjt_FSRCS
lib/qra64a.f90
lib/refspectrum.f90
lib/savec2.f90
lib/sec0.f90
lib/sec_midn.f90
lib/setup65.f90
lib/sh65.f90
@ -596,6 +601,20 @@ set (wsjt_FSRCS
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/get_crc24.f90
)
# temporary workaround for a gfortran v7.3 ICE on Fedora 27 64-bit
@ -1356,6 +1375,15 @@ target_link_libraries (ft4sim_mult wsjt_fort wsjt_cxx)
add_executable (record_time_signal Audio/tools/record_time_signal.cpp)
target_link_libraries (record_time_signal wsjt_cxx wsjt_qtmm wsjt_qt)
add_executable (fst4sim lib/fst4/fst4sim.f90 wsjtx.rc)
target_link_libraries (fst4sim wsjt_fort wsjt_cxx)
add_executable (ldpcsim240_101 lib/fst4/ldpcsim240_101.f90 wsjtx.rc)
target_link_libraries (ldpcsim240_101 wsjt_fort wsjt_cxx)
add_executable (ldpcsim240_74 lib/fst4/ldpcsim240_74.f90 wsjtx.rc)
target_link_libraries (ldpcsim240_74 wsjt_fort wsjt_cxx)
endif(WSJT_BUILD_UTILS)
# build the main application
@ -1495,7 +1523,7 @@ install (TARGETS jt9 wsprd fmtave fcal fmeasure
if(WSJT_BUILD_UTILS)
install (TARGETS ft8code jt65code qra64code qra64sim jt9code jt4code
msk144code
msk144code fst4sim
RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT runtime
BUNDLE DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT runtime
)

6
Configuration.ui
View File

@ -357,7 +357,7 @@
<item row="0" column="1">
<widget class="QCheckBox" name="enable_VHF_features_check_box">
<property name="text">
<string>Enable VHF/UHF/Microwave features</string>
<string>Enable VHF and submode features</string>
</property>
</widget>
</item>
@ -3119,9 +3119,9 @@ Right click for insert and delete options.</string>
<buttongroup name="TX_mode_button_group"/>
<buttongroup name="CAT_handshake_button_group"/>
<buttongroup name="TX_audio_source_button_group"/>
<buttongroup name="special_op_activity_button_group"/>
<buttongroup name="CAT_data_bits_button_group"/>
<buttongroup name="split_mode_button_group"/>
<buttongroup name="CAT_stop_bits_button_group"/>
<buttongroup name="CAT_data_bits_button_group"/>
<buttongroup name="special_op_activity_button_group"/>
</buttongroups>
</ui>

3
Decoder/decodedtext.pri Normal file
View File

@ -0,0 +1,3 @@
SOURCES += Decoder/decodedtext.cpp
HEADERS += Decoder/decodedtext.h

3
Detector/Detector.pri Normal file
View File

@ -0,0 +1,3 @@
SOURCES += Detector/Detector.cpp
HEADERS += Detector/Detector.hpp

75
Modulator/Modulator.cpp
View File

@ -45,11 +45,12 @@ Modulator::Modulator (unsigned frameRate, double periodLengthInSeconds,
{
}
void Modulator::start (unsigned symbolsLength, double framesPerSymbol,
void Modulator::start (QString mode, unsigned symbolsLength, double framesPerSymbol,
double frequency, double toneSpacing,
SoundOutput * stream, Channel channel,
bool synchronize, bool fastMode, double dBSNR, double TRperiod)
{
// qDebug () << "mode:" << mode << "symbolsLength:" << symbolsLength << "framesPerSymbol:" << framesPerSymbol << "frequency:" << frequency << "toneSpacing:" << toneSpacing << "channel:" << channel << "synchronize:" << synchronize << "fastMode:" << fastMode << "dBSNR:" << dBSNR << "TRperiod:" << TRperiod;
Q_ASSERT (stream);
// Time according to this computer which becomes our base time
qint64 ms0 = QDateTime::currentMSecsSinceEpoch() % 86400000;
@ -69,8 +70,8 @@ void Modulator::start (unsigned symbolsLength, double framesPerSymbol,
m_bFastMode=fastMode;
m_TRperiod=TRperiod;
unsigned delay_ms=1000;
if(m_nsps==1920) delay_ms=500; //FT8
if(m_nsps==576) delay_ms=300; //FT4
if(mode=="FT8" or (mode=="FST4" and m_nsps==720)) delay_ms=500; //FT8, FST4-15
if(mode=="FT4") delay_ms=300; //FT4
// noise generator parameters
if (m_addNoise) {
@ -79,26 +80,30 @@ void Modulator::start (unsigned symbolsLength, double framesPerSymbol,
if (m_snr > 1.0) m_fac = 3000.0 / m_snr;
}
// round up to an exact portion of a second that allows for startup delays
m_ic = (mstr / delay_ms) * m_frameRate * delay_ms / 1000;
if(m_bFastMode) m_ic=0;
m_silentFrames = 0;
// calculate number of silent frames to send, so that audio will start at
// the nominal time "delay_ms" into the Tx sequence.
if (synchronize && !m_tuning && !m_bFastMode) {
m_silentFrames = m_ic + m_frameRate / (1000 / delay_ms) - (mstr * (m_frameRate / 1000));
}
// qDebug() << "aa" << QDateTime::currentDateTimeUtc().toString("hh:mm:ss.zzz")
// << m_ic << m_silentFrames << m_silentFrames/48000.0
// << mstr << fmod(double(ms0),1000.0*m_period);
m_ic=0;
if (!m_tuning && !m_bFastMode)
{
// calculate number of silent frames to send, so that audio will
// start at the nominal time "delay_ms" into the Tx sequence.
if (synchronize)
{
if(delay_ms > mstr) m_silentFrames = (delay_ms - mstr) * m_frameRate / 1000;
}
// adjust for late starts
if(!m_silentFrames && mstr >= delay_ms)
{
m_ic = (mstr - delay_ms) * m_frameRate / 1000;
}
}
initialize (QIODevice::ReadOnly, channel);
Q_EMIT stateChanged ((m_state = (synchronize && m_silentFrames) ?
Synchronizing : Active));
// qDebug() << "delay_ms:" << delay_ms << "mstr:" << mstr << "m_silentFrames:" << m_silentFrames << "m_ic:" << m_ic << "m_state:" << m_state;
m_stream = stream;
if (m_stream) m_stream->restart (this);
}
@ -137,6 +142,8 @@ void Modulator::close ()
qint64 Modulator::readData (char * data, qint64 maxSize)
{
// qDebug () << "readData: maxSize:" << maxSize;
double toneFrequency=1500.0;
if(m_nsps==6) {
toneFrequency=1000.0;
@ -152,21 +159,28 @@ qint64 Modulator::readData (char * data, qint64 maxSize)
qint16 * end (samples + numFrames * (bytesPerFrame () / sizeof (qint16)));
qint64 framesGenerated (0);
// if(m_ic==0) qDebug() << "Modulator::readData" << 0.001*(QDateTime::currentMSecsSinceEpoch() % (1000*m_TRperiod));
// if(m_ic==0) qDebug() << "aa" << 0.001*(QDateTime::currentMSecsSinceEpoch() % qint64(1000*m_TRperiod))
// << m_state << m_TRperiod << m_silentFrames << m_ic << foxcom_.wave[m_ic];
switch (m_state)
{
case Synchronizing:
{
if (m_silentFrames) { // send silence up to first second
if (m_silentFrames) { // send silence up to end of start delay
framesGenerated = qMin (m_silentFrames, numFrames);
for ( ; samples != end; samples = load (0, samples)) { // silence
}
m_silentFrames -= framesGenerated;
return framesGenerated * bytesPerFrame ();
do
{
samples = load (0, samples); // silence
} while (--m_silentFrames && samples != end);
qDebug () << "played:" << framesGenerated << "silent frames";
if (!m_silentFrames)
{
Q_EMIT stateChanged ((m_state = Active));
}
}
Q_EMIT stateChanged ((m_state = Active));
// qDebug() << "m_silentFrames:" << m_silentFrames << "m_ic:" << m_ic << "m_state:" << m_state;
m_cwLevel = false;
m_ramp = 0; // prepare for CW wave shaping
}
@ -260,7 +274,7 @@ qint64 Modulator::readData (char * data, qint64 maxSize)
qint16 sample;
for (unsigned i = 0; i < numFrames && m_ic <= i1; ++i) {
while (samples != end && m_ic <= i1) {
isym=0;
if(!m_tuning and m_TRperiod!=3.0) isym=m_ic/(4.0*m_nsps); //Actual fsample=48000
if(m_bFastMode) isym=isym%m_symbolsLength;
@ -305,12 +319,19 @@ qint64 Modulator::readData (char * data, qint64 maxSize)
m_amp=32767.0;
sample=qRound(m_amp*foxcom_.wave[m_ic]);
}
/*
if((m_ic<1000 or (4*m_symbolsLength*m_nsps - m_ic) < 1000) and (m_ic%10)==0) {
qDebug() << "cc" << QDateTime::currentDateTimeUtc().toString("hh:mm:ss.zzz") << m_ic << sample;
}
*/
samples = load(postProcessSample(sample), samples);
++framesGenerated;
++m_ic;
}
// qDebug() << "dd" << QDateTime::currentDateTimeUtc().toString("hh:mm:ss.zzz")
// << m_ic << i1 << foxcom_.wave[m_ic] << framesGenerated;
if (m_amp == 0.0) { // TODO G4WJS: compare double with zero might not be wise
if (icw[0] == 0) {
// no CW ID to send

2
Modulator/Modulator.hpp
View File

@ -35,7 +35,7 @@ public:
void set_nsym(int n) {m_symbolsLength=n;}
void set_ms0(qint64 ms) {m_ms0=ms;}
Q_SLOT void start (unsigned symbolsLength, double framesPerSymbol, double frequency,
Q_SLOT void start (QString mode, unsigned symbolsLength, double framesPerSymbol, double frequency,
double toneSpacing, SoundOutput *, Channel = Mono,
bool synchronize = true, bool fastMode = false,
double dBSNR = 99., double TRperiod=60.0);

3
Modulator/Modulator.pri Normal file
View File

@ -0,0 +1,3 @@
SOURCES += Modulator/Modulator.cpp
HEADERS += Modulator/Mpdulator.hpp

445
Network/wsprnet.cpp
View File

@ -8,6 +8,8 @@
#include <QTimer>
#include <QFile>
#include <QRegExp>
#include <QRegularExpression>
#include <QNetworkAccessManager>
#include <QNetworkRequest>
#include <QNetworkReply>
@ -18,215 +20,314 @@
namespace
{
char const * const wsprNetUrl = "http://wsprnet.org/post?";
// char const * const wsprNetUrl = "http://127.0.0.1/post?";
char const * const wsprNetUrl = "http://wsprnet.org/post/";
//char const * const wsprNetUrl = "http://127.0.0.1:5000/post/";
//
// tested with this python REST mock of WSPRNet.org
//
/*
# Mock WSPRNet.org RESTful API
from flask import Flask, request, url_for
from flask_restful import Resource, Api
app = Flask(__name__)
@app.route ('/post/', methods=['GET', 'POST'])
def spot ():
if request.method == 'POST':
print (request.form)
return "1 spot(s) added"
with app.test_request_context ():
print (url_for ('spot'))
*/
// regexp to parse FST4W decodes
QRegularExpression fst4_re {R"(
(?<time>\d{4})
\s+(?<db>[-+]?\d+)
\s+(?<dt>[-+]?\d+\.\d+)
\s+(?<freq>\d+)
\s+`
\s+<?(?<call>[A-Z0-9/]+)>?(?:\s(?<grid>[A-R]{2}[0-9]{2}(?:[A-X]{2})?))?(?:\s+(?<dBm>\d+))?
)", QRegularExpression::ExtendedPatternSyntaxOption};
// regexp to parse wspr_spots.txt from wsprd
//
// 130223 2256 7 -21 -0.3 14.097090 DU1MGA PK04 37 0 40 0
// Date Time Sync dBm DT Freq Msg
// 1 2 3 4 5 6 -------7------ 8 9 10
QRegularExpression wspr_re(R"(^(\d+)\s+(\d+)\s+(\d+)\s+([+-]?\d+)\s+([+-]?\d+\.\d+)\s+(\d+\.\d+)\s+([^ ].*[^ ])\s+([+-]?\d+)\s+([+-]?\d+)\s+([+-]?\d+))");
};
WSPRNet::WSPRNet(QNetworkAccessManager * manager, QObject *parent)
: QObject{parent}
, networkManager {manager}
, uploadTimer {new QTimer {this}}
, m_urlQueueSize {0}
WSPRNet::WSPRNet (QNetworkAccessManager * manager, QObject *parent)
: QObject {parent}
, network_manager_ {manager}
, spots_to_send_ {0}
{
connect(networkManager, SIGNAL(finished(QNetworkReply*)), this, SLOT(networkReply(QNetworkReply*)));
connect( uploadTimer, SIGNAL(timeout()), this, SLOT(work()));
connect (network_manager_, &QNetworkAccessManager::finished, this, &WSPRNet::networkReply);
connect (&upload_timer_, &QTimer::timeout, this, &WSPRNet::work);
}
void WSPRNet::upload(QString const& call, QString const& grid, QString const& rfreq, QString const& tfreq,
QString const& mode, QString const& tpct, QString const& dbm, QString const& version,
QString const& fileName)
void WSPRNet::upload (QString const& call, QString const& grid, QString const& rfreq, QString const& tfreq,
QString const& mode, float TR_period, QString const& tpct, QString const& dbm,
QString const& version, QString const& fileName)
{
m_call = call;
m_grid = grid;
m_rfreq = rfreq;
m_tfreq = tfreq;
m_mode = mode;
m_tpct = tpct;
m_dbm = dbm;
m_vers = version;
m_file = fileName;
m_call = call;
m_grid = grid;
m_rfreq = rfreq;
m_tfreq = tfreq;
m_mode = mode;
TR_period_ = TR_period;
m_tpct = tpct;
m_dbm = dbm;
m_vers = version;
m_file = fileName;
// Open the wsprd.out file
QFile wsprdOutFile(fileName);
if (!wsprdOutFile.open(QIODevice::ReadOnly | QIODevice::Text) ||
wsprdOutFile.size() == 0) {
urlQueue.enqueue( wsprNetUrl + urlEncodeNoSpot());
m_uploadType = 1;
uploadTimer->start(200);
return;
// Open the wsprd.out file
QFile wsprdOutFile (fileName);
if (!wsprdOutFile.open (QIODevice::ReadOnly | QIODevice::Text) || !wsprdOutFile.size ())
{
spot_queue_.enqueue (urlEncodeNoSpot ());
m_uploadType = 1;
}
// Read the contents
while (!wsprdOutFile.atEnd()) {
QHash<QString,QString> query;
if ( decodeLine(wsprdOutFile.readLine(), query) ) {
// Prevent reporting data ouside of the current frequency band
float f = fabs(m_rfreq.toFloat() - query["tqrg"].toFloat());
if (f < 0.0002) {
urlQueue.enqueue( wsprNetUrl + urlEncodeSpot(query));
m_uploadType = 2;
else
{
// Read the contents
while (!wsprdOutFile.atEnd())
{
SpotQueue::value_type query;
if (decodeLine (wsprdOutFile.readLine(), query))
{
// Prevent reporting data ouside of the current frequency band
float f = fabs (m_rfreq.toFloat() - query.queryItemValue ("tqrg", QUrl::FullyDecoded).toFloat());
if (f < 0.0002)
{
spot_queue_.enqueue(urlEncodeSpot (query));
m_uploadType = 2;
}
}
}
}
}
m_urlQueueSize = urlQueue.size();
uploadTimer->start(200);
spots_to_send_ = spot_queue_.size ();
upload_timer_.start (200);
}
void WSPRNet::networkReply(QNetworkReply *reply)
void WSPRNet::post (QString const& call, QString const& grid, QString const& rfreq, QString const& tfreq,
QString const& mode, float TR_period, QString const& tpct, QString const& dbm,
QString const& version, QString const& decode_text)
{
m_call = call;
m_grid = grid;
m_rfreq = rfreq;
m_tfreq = tfreq;
m_mode = mode;
TR_period_ = TR_period;
m_tpct = tpct;
m_dbm = dbm;
m_vers = version;
if (!decode_text.size ())
{
if (!spot_queue_.size ())
{
spot_queue_.enqueue (urlEncodeNoSpot ());
m_uploadType = 1;
}
spots_to_send_ = spot_queue_.size ();
upload_timer_.start (200);
}
else
{
auto const& match = fst4_re.match (decode_text);
if (match.hasMatch ())
{
SpotQueue::value_type query;
// Prevent reporting data ouside of the current frequency band
auto tqrg = match.captured ("freq").toInt ();
if (tqrg >= 1400 && tqrg <= 1600)
{
query.addQueryItem ("function", "wspr");
// use time as at 3/4 of T/R period before current to
// ensure date is in Rx period
auto const& date = QDateTime::currentDateTimeUtc ().addSecs (-TR_period * 3. / 4.).date ();
query.addQueryItem ("date", date.toString ("yyMMdd"));
query.addQueryItem ("time", match.captured ("time"));
query.addQueryItem ("sig", match.captured ("db"));
query.addQueryItem ("dt", match.captured ("dt"));
query.addQueryItem ("tqrg", QString::number (rfreq.toDouble () + (tqrg - 1500) / 1e6, 'f', 6));
query.addQueryItem ("tcall", match.captured ("call"));
query.addQueryItem ("drift", "0");
query.addQueryItem ("tgrid", match.captured ("grid"));
query.addQueryItem ("dbm", match.captured ("dBm"));
spot_queue_.enqueue (urlEncodeSpot (query));
m_uploadType = 2;
}
}
}
}
void WSPRNet::networkReply (QNetworkReply * reply)
{
// check if request was ours
if (m_outstandingRequests.removeOne (reply)) {
if (QNetworkReply::NoError != reply->error ()) {
Q_EMIT uploadStatus (QString {"Error: %1"}.arg (reply->error ()));
// not clearing queue or halting queuing as it may be a transient
// one off request error
}
else {
QString serverResponse = reply->readAll();
if( m_uploadType == 2) {
if (!serverResponse.contains(QRegExp("spot\\(s\\) added"))) {
emit uploadStatus(QString {"Upload Failed: %1"}.arg (serverResponse));
urlQueue.clear();
uploadTimer->stop();
if (m_outstandingRequests.removeOne (reply))
{
if (QNetworkReply::NoError != reply->error ())
{
Q_EMIT uploadStatus (QString {"Error: %1"}.arg (reply->error ()));
// not clearing queue or halting queuing as it may be a
// transient one off request error
}
}
else
{
QString serverResponse = reply->readAll ();
if (m_uploadType == 2)
{
if (!serverResponse.contains(QRegExp("spot\\(s\\) added")))
{
Q_EMIT uploadStatus (QString {"Upload Failed: %1"}.arg (serverResponse));
spot_queue_.clear ();
upload_timer_.stop ();
}
}
if (urlQueue.isEmpty()) {
emit uploadStatus("done");
QFile::remove(m_file);
uploadTimer->stop();
}
if (!spot_queue_.size ())
{
Q_EMIT uploadStatus("done");
QFile f {m_file};
if (f.exists ()) f.remove ();
upload_timer_.stop ();
}
}
qDebug () << QString {"WSPRnet.org %1 outstanding requests"}.arg (m_outstandingRequests.size ());
// delete request object instance on return to the event loop otherwise it is leaked
reply->deleteLater ();
}
}
bool WSPRNet::decodeLine (QString const& line, SpotQueue::value_type& query)
{
auto const& rx_match = wspr_re.match (line);
if (rx_match.hasMatch ()) {
int msgType = 0;
QString msg = rx_match.captured (7);
QString call, grid, dbm;
QRegularExpression msgRx;
// Check for Message Type 1
msgRx.setPattern(R"(^([A-Z0-9]{3,6})\s+([A-R]{2}\d{2})\s+(\d+))");
auto match = msgRx.match (msg);
if (match.hasMatch ()) {
msgType = 1;
call = match.captured (1);
grid = match.captured (2);
dbm = match.captured (3);
}
qDebug () << QString {"WSPRnet.org %1 outstanding requests"}.arg (m_outstandingRequests.size ());
// Check for Message Type 2
msgRx.setPattern(R"(^([A-Z0-9/]+)\s+(\d+))");
match = msgRx.match (msg);
if (match.hasMatch ()) {
msgType = 2;
call = match.captured (1);
grid = "";
dbm = match.captured (2);
}
// delete request object instance on return to the event loop otherwise it is leaked
reply->deleteLater ();
// Check for Message Type 3
msgRx.setPattern(R"(^<([A-Z0-9/]+)>\s+([A-R]{2}\d{2}[A-X]{2})\s+(\d+))");
match = msgRx.match (msg);
if (match.hasMatch ()) {
msgType = 3;
call = match.captured (1);
grid = match.captured (2);
dbm = match.captured (3);
}
// Unknown message format
if (!msgType) {
return false;
}
query.addQueryItem ("function", "wspr");
query.addQueryItem ("date", rx_match.captured (1));
query.addQueryItem ("time", rx_match.captured (2));
query.addQueryItem ("sig", rx_match.captured (4));
query.addQueryItem ("dt", rx_match.captured(5));
query.addQueryItem ("drift", rx_match.captured(8));
query.addQueryItem ("tqrg", rx_match.captured(6));
query.addQueryItem ("tcall", call);
query.addQueryItem ("tgrid", grid);
query.addQueryItem ("dbm", dbm);
} else {
return false;
}
return true;
}
bool WSPRNet::decodeLine(QString const& line, QHash<QString,QString> &query)
auto WSPRNet::urlEncodeNoSpot () -> SpotQueue::value_type
{
// 130223 2256 7 -21 -0.3 14.097090 DU1MGA PK04 37 0 40 0
// Date Time Sync dBm DT Freq Msg
// 1 2 3 4 5 6 -------7------ 8 9 10
QRegExp rx("^(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+([+-]?\\d+)\\s+([+-]?\\d+\\.\\d+)\\s+(\\d+\\.\\d+)\\s+(.*)\\s+([+-]?\\d+)\\s+([+-]?\\d+)\\s+([+-]?\\d+)");
if (rx.indexIn(line) != -1) {
int msgType = 0;
QString msg = rx.cap(7);
msg.remove(QRegExp("\\s+$"));
msg.remove(QRegExp("^\\s+"));
QString call, grid, dbm;
QRegExp msgRx;
// Check for Message Type 1
msgRx.setPattern("^([A-Z0-9]{3,6})\\s+([A-Z]{2}\\d{2})\\s+(\\d+)");
if (msgRx.indexIn(msg) != -1) {
msgType = 1;
call = msgRx.cap(1);
grid = msgRx.cap(2);
dbm = msgRx.cap(3);
}
// Check for Message Type 2
msgRx.setPattern("^([A-Z0-9/]+)\\s+(\\d+)");
if (msgRx.indexIn(msg) != -1) {
msgType = 2;
call = msgRx.cap(1);
grid = "";
dbm = msgRx.cap(2);
}
// Check for Message Type 3
msgRx.setPattern("^<([A-Z0-9/]+)>\\s+([A-Z]{2}\\d{2}[A-Z]{2})\\s+(\\d+)");
if (msgRx.indexIn(msg) != -1) {
msgType = 3;
call = msgRx.cap(1);
grid = msgRx.cap(2);
dbm = msgRx.cap(3);
}
// Unknown message format
if (!msgType) {
return false;
}
query["function"] = "wspr";
query["date"] = rx.cap(1);
query["time"] = rx.cap(2);
query["sig"] = rx.cap(4);
query["dt"] = rx.cap(5);
query["drift"] = rx.cap(8);
query["tqrg"] = rx.cap(6);
query["tcall"] = call;
query["tgrid"] = grid;
query["dbm"] = dbm;
} else {
return false;
SpotQueue::value_type query;
query.addQueryItem ("function", "wsprstat");
query.addQueryItem ("rcall", m_call);
query.addQueryItem ("rgrid", m_grid);
query.addQueryItem ("rqrg", m_rfreq);
query.addQueryItem ("tpct", m_tpct);
query.addQueryItem ("tqrg", m_tfreq);
query.addQueryItem ("dbm", m_dbm);
query.addQueryItem ("version", m_vers);
if (m_mode == "WSPR") query.addQueryItem ("mode", "2");
if (m_mode == "WSPR-15") query.addQueryItem ("mode", "15");
if (m_mode == "FST4W")
{
query.addQueryItem ("mode", QString::number (static_cast<int> ((TR_period_ / 60.)+.5)));
}
return true;
return query;;
}
QString WSPRNet::urlEncodeNoSpot()
auto WSPRNet::urlEncodeSpot (SpotQueue::value_type& query) -> SpotQueue::value_type
{
QString queryString;
queryString += "function=wsprstat&";
queryString += "rcall=" + m_call + "&";
queryString += "rgrid=" + m_grid + "&";
queryString += "rqrg=" + m_rfreq + "&";
queryString += "tpct=" + m_tpct + "&";
queryString += "tqrg=" + m_tfreq + "&";
queryString += "dbm=" + m_dbm + "&";
queryString += "version=" + m_vers;
if(m_mode=="WSPR") queryString += "&mode=2";
if(m_mode=="WSPR-15") queryString += "&mode=15";
return queryString;;
}
QString WSPRNet::urlEncodeSpot(QHash<QString,QString> const& query)
{
QString queryString;
queryString += "function=" + query["function"] + "&";
queryString += "rcall=" + m_call + "&";
queryString += "rgrid=" + m_grid + "&";
queryString += "rqrg=" + m_rfreq + "&";
queryString += "date=" + query["date"] + "&";
queryString += "time=" + query["time"] + "&";
queryString += "sig=" + query["sig"] + "&";
queryString += "dt=" + query["dt"] + "&";
queryString += "drift=" + query["drift"] + "&";
queryString += "tqrg=" + query["tqrg"] + "&";
queryString += "tcall=" + query["tcall"] + "&";
queryString += "tgrid=" + query["tgrid"] + "&";
queryString += "dbm=" + query["dbm"] + "&";
queryString += "version=" + m_vers;
if(m_mode=="WSPR") queryString += "&mode=2";
if(m_mode=="WSPR-15") queryString += "&mode=15";
return queryString;
query.addQueryItem ("version", m_vers);
query.addQueryItem ("rcall", m_call);
query.addQueryItem ("rgrid", m_grid);
query.addQueryItem ("rqrg", m_rfreq);
if (m_mode == "WSPR") query.addQueryItem ("mode", "2");
if (m_mode == "WSPR-15") query.addQueryItem ("mode", "15");
if (m_mode == "FST4W")
{
query.addQueryItem ("mode", QString::number (static_cast<int> ((TR_period_ / 60.)+.5)));
}
return query;
}
void WSPRNet::work()
{
if (!urlQueue.isEmpty()) {
if (spots_to_send_ && spot_queue_.size ())
{
#if QT_VERSION < QT_VERSION_CHECK (5, 15, 0)
if (QNetworkAccessManager::Accessible != networkManager->networkAccessible ()) {
// try and recover network access for QNAM
networkManager->setNetworkAccessible (QNetworkAccessManager::Accessible);
}
if (QNetworkAccessManager::Accessible != network_manager_->networkAccessible ()) {
// try and recover network access for QNAM
network_manager_->setNetworkAccessible (QNetworkAccessManager::Accessible);
}
#endif
QUrl url(urlQueue.dequeue());
QNetworkRequest request(url);
m_outstandingRequests << networkManager->get(request);
emit uploadStatus(QString {"Uploading Spot %1/%2"}.arg (m_urlQueueSize - urlQueue.size()).arg (m_urlQueueSize));
} else {
uploadTimer->stop();
}
QNetworkRequest request (QUrl {wsprNetUrl});
request.setHeader (QNetworkRequest::ContentTypeHeader, "application/x-www-form-urlencoded");
auto const& spot = spot_queue_.dequeue ();
m_outstandingRequests << network_manager_->post (request, spot.query (QUrl::FullyEncoded).toUtf8 ());
Q_EMIT uploadStatus(QString {"Uploading Spot %1/%2"}.arg (spots_to_send_ - spot_queue_.size()).arg (spots_to_send_));
}
else
{
upload_timer_.stop ();
}
}
void WSPRNet::abortOutstandingRequests () {
urlQueue.clear ();
spot_queue_.clear ();
for (auto& request : m_outstandingRequests) {
request->abort ();
}
m_urlQueueSize = 0;
}

57
Network/wsprnet.h
View File

@ -2,45 +2,58 @@
#define WSPRNET_H
#include <QObject>
#include <QTimer>
#include <QString>
#include <QList>
#include <QHash>
#include <QUrlQuery>
#include <QQueue>
class QNetworkAccessManager;
class QTimer;
class QNetworkReply;
class WSPRNet : public QObject
{
Q_OBJECT;
Q_OBJECT
using SpotQueue = QQueue<QUrlQuery>;
public:
explicit WSPRNet(QNetworkAccessManager *, QObject *parent = nullptr);
void upload(QString const& call, QString const& grid, QString const& rfreq, QString const& tfreq,
QString const& mode, QString const& tpct, QString const& dbm, QString const& version,
QString const& fileName);
static bool decodeLine(QString const& line, QHash<QString,QString> &query);
explicit WSPRNet (QNetworkAccessManager *, QObject *parent = nullptr);
void upload (QString const& call, QString const& grid, QString const& rfreq, QString const& tfreq,
QString const& mode, float TR_peirod, QString const& tpct, QString const& dbm,
QString const& version, QString const& fileName);
void post (QString const& call, QString const& grid, QString const& rfreq, QString const& tfreq,
QString const& mode, float TR_period, QString const& tpct, QString const& dbm,
QString const& version, QString const& decode_text = QString {});
signals:
void uploadStatus(QString);
void uploadStatus (QString);
public slots:
void networkReply(QNetworkReply *);
void work();
void abortOutstandingRequests ();
void networkReply (QNetworkReply *);
void work ();
void abortOutstandingRequests ();
private:
QNetworkAccessManager *networkManager;
QList<QNetworkReply *> m_outstandingRequests;
QString m_call, m_grid, m_rfreq, m_tfreq, m_mode, m_tpct, m_dbm, m_vers, m_file;
QQueue<QString> urlQueue;
QTimer *uploadTimer;
int m_urlQueueSize;
int m_uploadType;
bool decodeLine (QString const& line, SpotQueue::value_type& query);
SpotQueue::value_type urlEncodeNoSpot ();
SpotQueue::value_type urlEncodeSpot (SpotQueue::value_type& spot);
QString urlEncodeNoSpot();
QString urlEncodeSpot(QHash<QString,QString> const& spot);
QNetworkAccessManager * network_manager_;
QList<QNetworkReply *> m_outstandingRequests;
QString m_call;
QString m_grid;;
QString m_rfreq;
QString m_tfreq;
QString m_mode;
QString m_tpct;
QString m_dbm;
QString m_vers;
QString m_file;
float TR_period_;
int spots_to_send_;
SpotQueue spot_queue_;
QTimer upload_timer_;
int m_uploadType;
};
#endif // WSPRNET_H

4
commons.h
View File

@ -2,7 +2,7 @@
#define COMMONS_H
#define NSMAX 6827
#define NTMAX 300
#define NTMAX 30*60
#define RX_SAMPLE_RATE 12000
#ifdef __cplusplus
@ -85,7 +85,7 @@ extern struct {
} echocom_;
extern struct {
float wave[606720];
float wave[(160+2)*134400*4]; /* (nsym+2)*nsps scaled up to 48kHz */
int nslots;
int nfreq;
int i3bit[5];

38
displayWidgets.txt
View File

@ -1,25 +1,26 @@
Here are the "displayWidgets()" strings for WSJT-X modes
1 2 3
012345678901234567890123456789012
0123456789012345678901234567890123
----------------------------------------------
JT4 111010000000110000110000000000000
JT4/VHF 111110010010110110111100000000000
JT9 111010000000111000010000000000001
JT9/VHF 111110101000111110010000000000000
JT9+JT65 111010000001111000010000000000001
JT65 111010000000111000010000000000001
JT65/VHF 111110010000110110101100010000000
QRA64 111110010110110110000000001000000
ISCAT 100111000000000110000000000000000
MSK144 101111110100000000010001000000000
WSPR 000000000000000001010000000000000
Echo 000000000000000000000010000000000
FCal 001101000000000000000000000001000
FT8 111010000100111000010000100110001
FT8/VHF 111010000100111000010000100110001
FT8/Fox 111010000100111000010000000000100
FT8/Hound 111010000100111000010000000000110
JT4 1110100000001100001100000000000000
JT4/VHF 1111100100101101101111000000000000
JT9 1110100000001110000100000000000010
JT9/VHF 1111101010001111100100000000000000
JT9+JT65 1110100000011110000100000000000010
JT65 1110100000001110000100000000000010
JT65/VHF 1111100100001101101011000100000000
QRA64 1111100101101101100000000010000000
ISCAT 1001110000000001100000000000000000
MSK144 1011111101000000000100010000000000
WSPR 0000000000000000010100000000000000
FST4W 0000000000000000010100000000000001
Echo 0000000000000000000000100000000000
FCal 0011010000000000000000000000010000
FT8 1110100001001110000100001001100010
FT8/VHF 1110100001001110000100001001100010
FT8/Fox 1110100001001110000100000000001000
FT8/Hound 1110100001001110000100000000001100
----------------------------------------------
1 2 3
012345678901234567890123456789012
@ -60,3 +61,4 @@ Mapping of column numbers to widgets
30. labDXped
31. cbRxAll
32. cbCQonly
33. sbTR_FST4W

8
doc/user_guide/en/controls-functions-status-bar.adoc
View File

@ -1,4 +1,4 @@
// Status=review
// Status=edited
A *Status Bar* at the bottom edge of the main window provides useful
information about operating conditions.
@ -9,15 +9,15 @@ image::status-bar-a.png[align="left",alt="Status Bar"]
Labels on the *Status Bar* display such information as the program's
current operating state, configuration name, operating mode, and the
content of your most recent transmitted message. The first label
(operating state) can be Receiving, Tx (for Transmitting), Tune, or
the name of file opened from the *File* menu; this label is
(operating state) can be Receiving, Tx (for Transmitting), Tx: Tune, or
the name of the file opened from the *File* menu. This label is
highlighted in green for Receiving, yellow for Tx, red for Tune, and
light blue for a file name. When transmitting, the Tx message is
displayed exactly as it will be decoded by receiving stations. The
second label (as shown above) will be absent if you are using the
*Default* setting on the *Configurations* menu. A progress bar shows
the elapsed fraction of a Tx or Rx sequence. Finally, if the Watchdog
(WD) timer was enabled on the *Settings | General* tab, a label in the
(WD) timer was enabled on the *Files | Settings | General* tab, a label in the
lower right-hand corner displays the number of minutes remaining
before timeout.

12
doc/user_guide/en/controls-functions-wide-graph.adoc
View File

@ -1,4 +1,4 @@
// Status=review
// Status=edited
The following controls appear at the bottom of the Wide Graph window.
Decoding occurs only in the displayed frequency range; otherwise, with
@ -29,7 +29,7 @@ slower, as desired.
- A dropdown list below the *Palette* label lets you select from a
wide range of waterfall color palettes.
- Click *Adjust* to activate a window that allows you to create a
- Click *Adjust* to activate a window that allows you to import or export a
user-defined palette.
- Check *Flatten* if you want _WSJT-X_ to compensate for a sloping or
@ -50,10 +50,10 @@ about right, depending on the input signal level, the chosen palette,
and your own preferences. Hover the mouse over a control to display a
tip reminding you of its function.
- The *Spec nn%* control may be used to set the fractional height of
- The *Spec nn%* control is used to set the fractional height of
the spectrum plotted below the waterfall.
- *Smooth* is active only when *Linear Average* has been selected.
- *Smooth* is active only when *Linear Average* is selected.
Smoothing the displayed spectrum over more than one bin can enhance
your ability to detect weak EME signals with Doppler spread more than
a few Hz.
@ -66,7 +66,7 @@ selected on the Wide Graph. Three sliders at the bottom of the Fast
Graph window can be used to optimize gain and zero-offset for the
displayed information. Hover the mouse over a control to display a
tip reminding you of its function. Clicking the *Auto Level* button
will produce reasonable settings as a starting point.
produces reasonable settings as a starting point.
image::fast-graph-controls.png[align="center",alt="Fast Graph Controls"]
@ -89,7 +89,7 @@ spectra, thereby smoothing the curves over multiple bins.
- Label *N* shows the number of echo pulses averaged.
- Click the *Colors* button to cycle through 6 possible choices of
- Click the *Colors* button to cycle through six possible choices of
color and line width for the plots.
[[CONTROLS_MISCELLANEOUS]]

6
doc/user_guide/en/cooperating-programs.adoc
View File

@ -1,3 +1,5 @@
// Status: edited
_WSJT-X_ is programmed to cooperate closely with several other useful
programs.
@ -38,10 +40,10 @@ logging applications Aether, MacLoggerDX, RUMlog or RUMlogNG. It
checks QSO and QSL status of the call and DXCC entity, as well as many
other features.
* {n1mm_logger} is a free full feature contest logging application. It
* {n1mm_logger} is a free, full-feature contest logging application. It
is only available for Windows. _WSJT-X_ can send logged QSO
information to it via a network connection.
* {writelog} is a non-free full feature contest logging
* {writelog} is a non-free, full-feature contest logging
application. It is only available for Windows. _WSJT-X_ can send
logged QSO information to it via a network connection.

43
doc/user_guide/en/decoder_notes.adoc
View File

@ -1,19 +1,21 @@
[[AP_Decoding]]
// Status: edited
=== AP Decoding
The _WSJT-X_ decoders for FT4, FT8, JT65, and QRA64 include optional
procedures that take advantage of naturally accumulating information
during a minimal QSO. This _a priori_ (AP) information increases
sensitivity of the decoder by up to 4 dB, at the cost of a slightly
higher rate of false decodes.
The _WSJT-X_ decoders for FT4, FT8, JT65, QRA64, include
procedures that use naturally accumulating information during a
minimal QSO. This _a priori_ (AP) information increases sensitivity
of the decoder by up to 4 dB, at the cost of a slightly higher rate of
false decodes. AP is optional in FT8, JT65, and QRA64, but is always
enabled for FT4.
For example: when you decide to answer a CQ, you already know your own
callsign and that of your potential QSO partner. The software
therefore "`knows`" what might be expected for at least 57 message
bits (28 for each of two callsigns, 1 or more for message type) in the
next received message. The decoder's task can thus be reduced to
bits (28 for each of two callsigns, one or more for message type) in the
next received message. The decoder's task is thus reduced to
determining the remaining 15 bits of the message and ensuring that the
resulting solution is consistent with the message's parity symbols.
resulting solution is reliable.
AP decoding starts by setting AP bits to the hypothesized values, as
if they had been received correctly. We then determine whether the
@ -21,12 +23,12 @@ remaining message and parity bits are consistent with the hypothesized
AP bits, with a specified level of confidence. Successful AP decodes
are labeled with an end-of-line indicator of the form `aP`, where `P`
is one of the single-digit AP decoding types listed in Table 1. For
example, `a2` indicates that the successful decode used *MyCall* as
example, `a2` indicates that the successful decode used MyCall as
hypothetically known information.
[[FT8_AP_INFO_TABLE]]
.FT4 and FT8 AP information types
[width="50%",cols="h10,<m20",frame=topbot,options="header"]
[width="35%",cols="h10,<m20",frame=topbot,options="header"]
|===============================================
|aP | Message components
|a1 | CQ &#160; &#160; ? &#160; &#160; ?
@ -49,7 +51,7 @@ be attempted in each state.
[[FT8_AP_DECODING_TYPES_TABLE]]
.FT4 and FT8 AP decoding types for each QSO state
[width="50%",cols="h10,<m20",frame=topbot,options="header"]
[width="35%",cols="h10,<m20",frame=topbot,options="header"]
|===========================================
|State |AP type
|CALLING STN | 2, 3
@ -60,14 +62,12 @@ be attempted in each state.
|CALLING CQ | 1, 2
|===========================================
Decoding with _a priori_ information behaves slightly differently in
JT65. Some details are provided in Tables 3 and 4. Notations such as
`a63`, use a second digit to indicate the number of Rx intervals
averaged to obtain the decode.
Decoding with _a priori_ information behaves slightly differently
in JT65. Some details are provided in Tables 3 and 4.
[[JT65_AP_INFO_TABLE]]
.JT65 AP information types
[width="50%",cols="h10,<m20",frame=topbot,options="header"]
[width="35%",cols="h10,<m20",frame=topbot,options="header"]
|===============================================
|aP | Message components
|a1 | CQ &#160; &#160; ? &#160; &#160; ?
@ -81,7 +81,7 @@ averaged to obtain the decode.
[[JT65_AP_DECODING_TYPES_TABLE]]
.JT65 AP decoding types for each QSO state
[width="50%",cols="h10,<m20",frame=topbot,options="header"]
[width="35%",cols="h10,<m20",frame=topbot,options="header"]
|===========================================
|State |AP type
|CALLING STN | 2, 3, 6, 7
@ -93,7 +93,6 @@ averaged to obtain the decode.
|===========================================
[[Decoded_Lines]]
=== Decoded Lines
Displayed information accompanying decoded messages generally includes UTC,
@ -110,7 +109,7 @@ summarized in the following Table:
[width="50%",cols="h,3*^",frame=topbot,options="header"]
|===========================================
|Mode |Mode character|Sync character|End of line information
|FT4 | + | | ? &#160; aP
|FT4 | ~ | | ? &#160; aP
|FT8 | ~ | | ? &#160; aP
|JT4 | $ | *, # | f, fN, dCN
|JT9 | @ | |
@ -126,7 +125,7 @@ Sync character::
End of line information::
`?` - Decoded with lower confidence +
`a` - Decoded with aid of some a priori (AP) information +
`a` - Decoded with aid of some _a priori_ (AP) information +
`C` - Confidence indicator [ISCAT and Deep Search; (0-9,*)] +
`d` - Deep Search algorithm +
`f` - Franke-Taylor or Fano algorithm +
@ -140,7 +139,7 @@ Table 6 below shows the meaning of the return codes R in QRA64 mode.
[[QRA64_AP_INFO_TABLE]]
.QRA64 AP return codes
[width="50%",cols="h10,<m20",frame=topbot,options="header"]
[width="35%",cols="h10,<m20",frame=topbot,options="header"]
|===============================================
|rc | Message components
|0 | ? &#160; &#160; ? &#160; &#160; ?

27
doc/user_guide/en/faq.adoc
View File

@ -1,10 +1,12 @@
// Status: edited
////
Questions:
Should be short one liners (in the .adoc file) ending with ?::
If your question is too long for one line, consider multiple questions or rephrase
Should be short one-liners (in the .adoc file) ending with ?::
If your question is too long for one line, consider multiple questions or rephrase.
Answers:
Can be bullet or paragraphs. Bullets make for easier reading.
Can be bullets or paragraphs. Bullets make for easier reading.
Bullet Usage:
* = a circle bullet single intent
@ -53,19 +55,18 @@ You need to install suitable _OpenSSL_ libraries - see <<OPENSSL,Instructions to
I occasionally get Rig Control Errors if I adjust my Icom rig's VFO. What's wrong?::
By default, most Icom transceivers have *CI-V Tranceive Mode" enabled,
this will cause unsolicited CAT traffic from the rig that disrupts CAT
By default, most Icom transceivers have *CI-V Transceive Mode" enabled. This will cause unsolicited CAT traffic from the rig that disrupts CAT
control by a PC. Disable this option in the rig's menu.
I want to control my transceiver with another application as well as _WSJT-X_, is that possible?::
This only possible to do reliably via some kind of rig control server,
that server must be able to accept both _WSJT-X_ and the other
This only possible to do reliably via some kind of rig control server.
That server must be able to accept both _WSJT-X_ and the other
application(s) as clients. Using a dumb serial port splitter like the
VSPE tool is not supported, it may work but it is not reliable due to
VSPE tool is not supported; it may work but it is not reliable due to
unmanaged CAT control collisions. Applications like the _Hamlib Rig
Control Server (rigctld)_, _{omnirig}_, and _{dxlsuite} Commander_ are
potentially suitable and _WSJT-X_ can act as a client to them all.
potentially suitable; _WSJT-X_ can act as a client to them all.
Rig control through _OmniRig_ seems to fail when I click *Test CAT*. What can I do about it?::
@ -79,7 +80,7 @@ You may see delays up to 20 seconds or so in frequency changes or
other radio commands, due to a bug in HRD. HRD folks are aware of the
problem, and are working to resolve it.
I am running _WSJT-X_ under Ubuntu. The program starts, but menu bar is missing from the top of the main window and the hot-keys don't work.::
I am running _WSJT-X_ under Ubuntu. The program starts, but the menu bar is missing from the top of the main window and the hot-keys don't work.::
Ubuntu's new "`Unity`" desktop puts the menu for the currently active
window at the top of the primary display screen. You can restore menu
@ -100,10 +101,10 @@ I am running _WSJT-X_ on Linux using a KDE desktop. Why does *Menu->Configuratio
The KDE development team have added code to Qt that tries to
automatically add shortcut accelerator keys to all buttons including
pop up menu buttons, this interferes with operation of the application
pop up menu buttons. This interferes with operation of the application
(many other Qt applications have similar issues with KDE). Until this
is fixed by the KDE team you must disable this misfeature. Edit the
file ~/.config/kdeglobals and add a section containing the following:
is fixed by the KDE team you must disable this feature. Edit the
file `~/.config/kdeglobals` and add a section containing the following:
[Development]
AutoCheckAccelerators=false

4
doc/user_guide/en/protocols.adoc
View File

@ -38,8 +38,8 @@ FN42`, it means that s/he will listen on 50.290 and respond there to
any replies.) A numerical signal report of the form `–nn` or
`R–nn` can be sent in place of a grid locator. (As originally
defined, numerical signal reports `nn` were required to fall between -01
and -30 dB. Recent program versions accommodate reports between
-50 and +49 dB.) A country prefix or portable suffix may be
and -30 dB. Program versions 2.3 and later accommodate reports between
-50 and +50 dB.) A country prefix or portable suffix may be
attached to one of the callsigns. When this feature is used the
additional information is sent in place of the grid locator or by
encoding additional information into some of the 6 million available

21
doc/user_guide/en/wspr.adoc
View File

@ -65,12 +65,18 @@ starts. This feature can be used to activate an automatic antenna
tuner (ATU) to tune a multi-band antenna to the newly selected band.
- Depending on your station and antenna setup, band changes might
require other switching besides retuning your radio. To make this
require other switching besides retuning your radio. To make this
possible in an automated way, whenever _WSJT-X_ executes a successful
band-change command to a CAT-controlled radio, it looks for a file
named `user_hardware.bat`, `user_hardware.cmd`, `user_hardware.exe`,
or `user_hardware` in the working directory. If one of these is found,
_WSJT-X_ tries to execute the command
band-change command to a CAT-controlled radio, it looks for an
executable file or script named `user_hardware`. This is done using
`CMD /C user_hardware <band>` on Windows, or `/bin/sh -c user_hardware
<band>` on other platforms, where band is described below. On Windows
the first file with any extension listed on the PATHEXT environment
variable added to the file name root `user_hardware`, and found in the
directories listed on the PATH environment variable will be executed.
On other platforms, the first executable script, or program, named
`user_hardware` found in a directory listed on the PATH environment
variable will be executed.
user_hardware nnn
@ -78,6 +84,11 @@ _WSJT-X_ tries to execute the command
meters. You must write your own program, script, or batch file to do
the necessary switching at your station.
IMPORTANT: The use of the PATH (and PATHEXT on Windows) environment
variables is a new feature. To emulate previous behavior make sure
that the location of your user_hardware script or program is on the
PATH environment variable used by _WSJT-X_.
The following screen shot is an example of WSPR operation with
band hopping enabled:

21
lib/77bit/call_to_c28.f90 Normal file
View File

@ -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

58
lib/77bit/free_text.f90 Normal file
View File

@ -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

13
lib/77bit/nonstd_to_c58.f90 Normal file
View File

@ -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

127
lib/77bit/packjt77.f90
View File

@ -124,12 +124,14 @@ subroutine pack77(msg0,i3,n3,c77)
integer ntel(3)
msg=msg0
if(i3.eq.0 .and. n3.eq.5) go to 5
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)
i3=-1
n3=-1
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)
@ -160,7 +162,7 @@ subroutine pack77(msg0,i3,n3,c77)
go to 900
endif
100 call pack77_06(nwords,w,i3,n3,c77)
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"
@ -203,7 +205,7 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
integer ntel(3)
character*77 c77
character*37 msg
character*13 call_1,call_2,call_3
character*13 call_1,call_2,call_3,call_1a
character*13 mycall13_0,dxcall13_0
character*11 c11
character*3 crpt,cntx,cpfx
@ -281,6 +283,10 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
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 <KH1/KH7Z> -11 28 28 10 5 71 DXpedition Mode
@ -346,11 +352,11 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
msg=adjustl(msg)
else if(i3.eq.0 .and. n3.eq.6) then
read(c77(50:50),'(b1)') j2a
j2b=0
if(j2a.eq.0) read(c77(49:49),'(b1)') j2b
j2=2*j2a+j2b
if(j2.eq.0) then
read(c77(49:50),'(2b1)') j2a,j2b
itype=2
if(j2b.eq.0 .and. j2a.eq.0) itype=1
if(j2b.eq.0 .and. j2a.eq.1) itype=3
if(itype.eq.1) then
! WSPR Type 1
read(c77,2010) n28,igrid4,idbm
2010 format(b28.28,b15.15,b5.5)
@ -360,24 +366,17 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
call to_grid4(igrid4,grid4)
write(crpt,'(i3)') idbm
msg=trim(call_1)//' '//grid4//' '//trim(adjustl(crpt))
call save_hash_call(call_1,n10,n12,n22) !### Is this OK here? ###
else if(j2.eq.1) then
else if(itype.eq.2) then
! WSPR Type 2
read(c77,2030) n28,igrid6
2030 format(b22.22,b25.25)
call unpack28(n28,call_1,unpk28_success)
if(.not.unpk28_success) unpk77_success=.false.
call to_grid6(igrid6,grid6)
msg=trim(call_1)//' '//grid6
else if(j2.eq.2) then
! WSPR Type 3
read(c77,2020) n28,npfx,idbm
2020 format(b28.28,b16.16,b5.5)
idbm=nint(idbm*10.0/3.0)
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
@ -387,10 +386,11 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
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
cpfx=' '
if(npfx.le.35) then
cpfx(1:1)=a2(npfx+1:npfx+1)
else if(npfx.gt.35 .and. npfx.le.1295) then
@ -405,7 +405,20 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
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)
msg=trim(call_1)//' '//grid6
endif
@ -446,7 +459,9 @@ subroutine unpack77(c77,nrx,msg,unpk77_success)
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
write(crpt,'(i3.2)') irpt-35
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
@ -897,7 +912,7 @@ subroutine pack77_03(nwords,w,i3,n3,c77)
ntx=-1
j=len(trim(w(nwords-1)))-1
read(w(nwords-1)(1:j),*,err=1) ntx !Number of transmitters
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')
@ -925,7 +940,7 @@ subroutine pack77_03(nwords,w,i3,n3,c77)
end subroutine pack77_03
subroutine pack77_06(nwords,w,i3,n3,c77)
subroutine pack77_06(nwords,w,i3,n3,c77,i3_hint,n3_hint)
character*13 w(19)
character*77 c77
@ -942,13 +957,14 @@ subroutine pack77_06(nwords,w,i3,n3,c77)
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 .and. &
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. &
grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. &
grid6(6:6).ge.'A' .and. grid6(6:6).le.'X'
(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'
@ -1020,22 +1036,32 @@ subroutine pack77_06(nwords,w,i3,n3,c77)
go to 900
endif
if(nwords.eq.2 .and. m1.ge.5 .and. m1.le.12 .and. m2.le.6) then
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)
k1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*24*24
k2=(ichar(grid6(2:2))-ichar('A'))*10*10*24*24
k3=(ichar(grid6(3:3))-ichar('0'))*10*24*24
k4=(ichar(grid6(4:4))-ichar('0'))*24*24
k5=(ichar(grid6(5:5))-ichar('A'))*24
k6=(ichar(grid6(6:6))-ichar('A'))
igrid6=k1+k2+k3+k4+k5+k6
write(c77,1030) n28,igrid6,2,0,n3,i3
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
@ -1083,10 +1109,12 @@ subroutine pack77_1(nwords,w,i3,n3,c77)
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:),*) 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
@ -1507,4 +1535,31 @@ subroutine to_grid6(n,grid6)
return
end subroutine to_grid6
subroutine to_grid(n,grid6)
! 4-, or 6-character grid
character*6 grid6
j1=n/(18*10*10*25*25)
n=n-j1*18*10*10*25*25
j2=n/(10*10*25*25)
n=n-j2*10*10*25*25
j3=n/(10*25*25)
n=n-j3*10*25*25
j4=n/(25*25)
n=n-j4*25*25
j5=n/25
j6=n-j5*25
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
return
end subroutine to_grid
end module packjt77

441
lib/C_interface_module.f90 Normal file
View File

@ -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 <string.h>
! 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 <string.h>
!=========================================================================
! 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<len(F_string)) F_string(i:) = ' '
end if
end subroutine F_string_assign_C_string
! Copy a C string, passed by pointer, to a Fortran string.
! If the C pointer is NULL, the Fortran string is blanked.
! C_string must be NUL terminated, or at least as long as F_string.
! If C_string is longer, it is truncated. Otherwise, F_string is
! blank-padded at the end.
subroutine C_F_string_ptr(C_string, F_string)
type(C_ptr), intent(in) :: C_string
character(len=*), intent(out) :: F_string
character(len=1,kind=C_char), dimension(:), 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<len(F_string)) F_string(i:) = ' '
end if
end subroutine C_F_string_ptr
! Copy a C string, passed as a char-array reference, to a Fortran string.
subroutine C_F_string_chars(C_string, F_string)
character(len=1,kind=C_char), intent(in) :: C_string(*)
character(len=*), intent(out) :: F_string
integer :: i
i=1
do while(C_string(i)/=NUL .and. i<=len(F_string))
F_string(i:i) = C_string(i)
i=i+1
end do
if (i<len(F_string)) F_string(i:) = ' '
end subroutine C_F_string_chars
! Copy a Fortran string to an allocated C string pointer.
! If the C pointer is NULL, no action is taken. (Maybe auto allocate via libc call?)
! If the length is not passed, the C string must be at least: len(F_string)+1
! If the length is passed and F_string is too long, it is truncated.
subroutine F_C_string_ptr(F_string, C_string, C_string_len)
character(len=*), intent(in) :: F_string
type(C_ptr), intent(in) :: C_string ! target = intent(out)
integer, intent(in), optional :: C_string_len ! Max string length,
! INCLUDING THE TERMINAL NUL
character(len=1,kind=C_char), dimension(:), pointer :: p_chars
integer :: i, strlen
strlen = len(F_string)
if (present(C_string_len)) then
if (C_string_len <= 0) return
strlen = min(strlen,C_string_len)
end if
if (.not. C_associated(C_string)) then
return
end if
call C_F_pointer(C_string,p_chars,[strlen+1])
forall (i=1:strlen)
p_chars(i) = F_string(i:i)
end forall
p_chars(strlen+1) = NUL
end subroutine F_C_string_ptr
pure function C_strlen_safe(s) result(length)
integer(C_size_t) :: length
type(C_char_ptr), value, intent(in) :: s
if (.not. C_associated_pure(s)) then
length = 0
else
length = C_strlen(s)
end if
end function C_strlen_safe
function C_string_value(C_string) result(F_string)
type(C_ptr), intent(in) :: C_string
character(len=C_strlen_safe(C_string)) :: F_string
character(len=1,kind=C_char), dimension(:), pointer :: p_chars
integer :: i, length
length = len(F_string)
if (length/=0) then
call C_F_pointer(C_string,p_chars,[length])
forall (i=1:length)
F_string(i:i) = p_chars(i)
end forall
end if
end function C_string_value
! Copy a Fortran string to a C string passed by char-array reference.
! If the length is not passed, the C string must be at least: len(F_string)+1
! If the length is passed and F_string is too long, it is truncated.
subroutine F_C_string_chars(F_string, C_string, C_string_len)
character(len=*), intent(in) :: F_string
character(len=1,kind=C_char), dimension(*), intent(out) :: C_string
integer, intent(in), optional :: C_string_len ! Max string length,
! INCLUDING THE TERMINAL NUL
integer :: i, strlen
strlen = len(F_string)
if (present(C_string_len)) then
if (C_string_len <= 0) return
strlen = min(strlen,C_string_len)
end if
forall (i=1:strlen)
C_string(i) = F_string(i:i)
end forall
C_string(strlen+1) = NUL
end subroutine F_C_string_chars
! NOTE: Strings allocated here must be freed by the
! C library, such as via C_free() or C_string_free(),
type(C_ptr) function F_C_string_dup(F_string,length) result(C_string)
character(len=*), intent(in) :: F_string
integer, intent(in), optional :: length
character(len=1,kind=C_char), pointer :: C_string_ptr(:)
integer :: i
integer(C_size_t) :: strlen
if (present(length)) then
strlen = length
else
strlen = len(F_string)
end if
if (strlen <= 0) then
C_string = C_NULL_ptr
else
C_string = C_malloc(strlen+1)
if (C_associated(C_string)) then
call C_F_pointer(C_string,C_string_ptr,[strlen+1])
forall (i=1:strlen)
C_string_ptr(i) = F_string(i:i)
end forall
C_string_ptr(strlen+1) = NUL
end if
end if
end function F_C_string_dup
! NOTE: Strings allocated here must be freed by the
! C library, such as via C_free() or C_string_free(),
type(C_ptr) function C_string_alloc(length) result(C_string)
integer(C_size_t), intent(in) :: length
character(len=1,kind=C_char), pointer :: C_charptr
C_string = C_malloc(length+1)
if (C_associated(C_string)) then
call C_F_pointer(C_string,C_charptr)
C_charptr = NUL
end if
end function C_string_alloc
subroutine C_string_free(string)
type(C_ptr), intent(inout) :: string
if (C_associated(string)) then
call C_free(string)
string = C_NULL_ptr
end if
end subroutine C_string_free
end module C_interface_module

48
lib/astrosub.f90
View File

@ -1,5 +1,4 @@
module astro_module
use, intrinsic :: iso_c_binding, only : c_int, c_double, c_bool, c_char, c_ptr, c_size_t, c_f_pointer
implicit none
private
@ -7,50 +6,37 @@ module astro_module
contains
subroutine astrosub(nyear,month,nday,uth8,freq8,mygrid_cp,mygrid_len, &
hisgrid_cp,hisgrid_len,AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8, &
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,AzElFileName_len,jpleph_cp,jpleph_len) &
width2,bTx,AzElFileName_cp,jpleph_file_name_cp) &
bind (C, name="astrosub")
integer, parameter :: dp = selected_real_kind(15, 50)
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, &
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), intent(in), value :: mygrid_cp, hisgrid_cp, AzElFileName_cp, jpleph_cp
integer(c_size_t), intent(in), value :: mygrid_len, hisgrid_len, AzElFileName_len, jpleph_len
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(kind=c_char, len=:), allocatable :: AzElFileName
character(len=:), allocatable :: AzElFileName
character(len=1) :: c1
integer :: ih, im, imin, is, isec, nfreq, nRx
real(dp) :: AzAux, ElAux, dbMoon8, dfdt, dfdt0, doppler, doppler00, HA8, sd8, xlst8
character*256 jpleph_file_name
common/jplcom/jpleph_file_name
block
character(kind=c_char, len=mygrid_len), pointer :: mygrid_fp
character(kind=c_char, len=hisgrid_len), pointer :: hisgrid_fp
character(kind=c_char, len=AzElFileName_len), pointer :: AzElFileName_fp
character(kind=c_char, len=jpleph_len), pointer :: jpleph_fp
call c_f_pointer(cptr=mygrid_cp, fptr=mygrid_fp)
mygrid = mygrid_fp
mygrid_fp => null()
call c_f_pointer(cptr=hisgrid_cp, fptr=hisgrid_fp)
hisgrid = hisgrid_fp
hisgrid_fp => null()
call c_f_pointer(cptr=AzElFileName_cp, fptr=AzElFileName_fp)
AzElFileName = AzElFileName_fp
AzElFileName_fp => null()
call c_f_pointer(cptr=jpleph_cp, fptr=jpleph_fp)
jpleph_file_name = jpleph_fp
jpleph_fp => null()
end block
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, &

55
lib/blanker.f90 Normal file
View File

@ -0,0 +1,55 @@
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
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
fblanked=fblanked + 0.1*(float(ndropped)/nz - fblanked)
fblanked=float(ndropped)/nz
! write(*,3001) npct,nthresh,fblanked
!3001 format(2i5,f7.3)
return
end subroutine blanker

2
lib/constants.f90
View File

@ -1,4 +1,4 @@
integer, parameter :: NTMAX=300
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

105
lib/decoder.f90
View File

@ -8,6 +8,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
use jt9_decode
use ft8_decode
use ft4_decode
use fst4_decode
include 'jt9com.f90'
include 'timer_common.inc'
@ -32,6 +33,10 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
integer :: decoded
end type counting_ft4_decoder
type, extends(fst4_decoder) :: counting_fst4_decoder
integer :: decoded
end type counting_fst4_decoder
real ss(184,NSMAX)
logical baddata,newdat65,newdat9,single_decode,bVHF,bad0,newdat,ex
integer*2 id2(NTMAX*12000)
@ -48,6 +53,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
type(counting_jt9_decoder) :: my_jt9
type(counting_ft8_decoder) :: my_ft8
type(counting_ft4_decoder) :: my_ft4
type(counting_fst4_decoder) :: my_fst4
!cast C character arrays to Fortran character strings
datetime=transfer(params%datetime, datetime)
@ -62,6 +68,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
my_jt9%decoded = 0
my_ft8%decoded = 0
my_ft4%decoded = 0
my_fst4%decoded = 0
! For testing only: return Rx messages stored in a file as decodes
inquire(file='rx_messages.txt',exist=ex)
@ -180,8 +187,37 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
go to 800
endif
rms=sqrt(dot_product(float(id2(300000:310000)), &
float(id2(300000:310000)))/10000.0)
if(params%nmode.eq.240) then
! We're in FST4 mode
ndepth=iand(params%ndepth,3)
iwspr=0
if(iand(params%ndepth,128).ne.0) iwspr=2
call timer('dec240 ',0)
call my_fst4%decode(fst4_decoded,id2,params%nutc, &
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
params%nsubmode,ndepth,params%ntr,params%nexp_decode, &
params%ntol,params%emedelay, &
logical(params%lapcqonly),mycall,hiscall,params%nfsplit,iwspr)
call timer('dec240 ',1)
go to 800
endif
if(params%nmode.eq.241) then
! We're in FST4W mode
ndepth=iand(params%ndepth,3)
iwspr=1
call timer('dec240 ',0)
call my_fst4%decode(fst4_decoded,id2,params%nutc, &
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
params%nsubmode,ndepth,params%ntr,params%nexp_decode, &
params%ntol,params%emedelay, &
logical(params%lapcqonly),mycall,hiscall,params%nfsplit,iwspr)
call timer('dec240 ',1)
go to 800
endif
rms=sqrt(dot_product(float(id2(60001:61000)), &
float(id2(60001:61000)))/1000.0)
if(rms.lt.2.0) go to 800
! Zap data at start that might come from T/R switching transient?
@ -299,7 +335,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
! JT65 is not yet producing info for nsynced, ndecoded.
800 ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded + &
my_ft8%decoded + my_ft4%decoded
my_ft8%decoded + my_ft4%decoded + my_fst4%decoded
if(params%nmode.eq.8 .and. params%nzhsym.eq.41) ndec41=ndecoded
if(params%nmode.eq.8 .and. params%nzhsym.eq.47) ndec47=ndecoded
if(params%nmode.eq.8 .and. params%nzhsym.eq.50) then
@ -660,4 +696,67 @@ contains
return
end subroutine ft4_decoded
subroutine fst4_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, &
qual,ntrperiod,lwspr,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
logical, intent(in) :: lwspr
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)
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')
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)
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')
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)
call flush(13)
select type(this)
type is (counting_fst4_decoder)
this%decoded = this%decoded + 1
end select
return
end subroutine fst4_decoded
end subroutine multimode_decoder

BIN
lib/fsk4hf/.DS_Store vendored Normal file
View File

Binary file not shown.

562
lib/fst280_decode.f90 Normal file
View File

@ -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

111
lib/fst4/bpdecode240_101.f90 Normal file
View File

@ -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

154
lib/fst4/decode240_101.f90 Normal file
View File

@ -0,0 +1,154 @@
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)
dmin=sum(nxor*abs(llr))
ntype=2
return
endif
enddo
ntype=0
nharderror=-1
dminosd=0.0
return
end subroutine decode240_101

154
lib/fst4/decode240_74.f90 Normal file
View File

@ -0,0 +1,154 @@
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
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
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
do i=1,nosd
zn=zsave(:,i)
call osd240_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)
dmin=sum(nxor*abs(llr))
ntype=2
return
endif
enddo
ntype=0
nharderror=-1
dminosd=0.0
return
end subroutine decode240_74

46
lib/fst4/encode240_101.f90 Normal file
View File

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

46
lib/fst4/encode240_74.f90 Normal file
View File

@ -0,0 +1,46 @@
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
character*24 c24
integer*1 codeword(N)
integer*1 gen(M,K)
integer*1 message(K)
integer*1 pchecks(M)
integer*4 ncrc24
include "ldpc_240_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

7
lib/fst4/fst4_params.f90 Normal file
View File

@ -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)

155
lib/fst4/fst4sim.f90 Normal file
View File

@ -0,0 +1,155 @@
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.10) then
print*,'Need 10 arguments, got ',nargs
print*,'Usage: fst4sim "message" TRsec f0 DT h fdop del nfiles snr W'
print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 1 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,*) hmod !Modulation index, h
call getarg(6,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(7,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(8,arg)
read(arg,*) nfiles !Number of files
call getarg(9,arg)
read(arg,*) snrdb !SNR_2500
call getarg(10,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,hmod,txt,snrdb
1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',i6,' 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,1x,24i1)') msgbits
endif
write(*,*)
write(*,'(a17)') 'Channel symbols: '
write(*,'(10i1)') itone
write(*,*)
! call sgran()
fsample=12000.0
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.ne.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread)
c=sig*c
wave=real(c)
if(snrdb.lt.90) then
do i=1,nmax !Add gaussian noise at specified SNR
xnoise=gran()
wave(i)=wave(i) + xnoise
enddo
endif
gain=100.0
if(snrdb.lt.90.0) then
wave=gain*wave
else
datpk=maxval(abs(wave))
fac=32766.9/datpk
wave=fac*wave
endif
if(any(abs(wave).gt.32767.0)) print*,"Warning - data will be clipped."
iwave=nint(wave(: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

91
lib/fst4/gen_fst4wave.f90 Normal file
View File

@ -0,0 +1,91 @@
subroutine gen_fst4wave(itone,nsym,nsps,nwave,fsample,hmod,f0, &
icmplx,cwave,wave)
parameter(NTAB=65536)
real wave(nwave)
complex cwave(nwave),ctab(0:NTAB-1)
real, allocatable, save :: pulse(:)
real, allocatable :: dphi(:)
integer hmod
integer itone(nsym)
logical first
data first/.true./
data nsps0/-99/
save first,twopi,dt,tsym,nsps0,ctab
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
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=0,(nsym+2)*nsps-1
k=k+1
i=phi*float(NTAB)/twopi
i=iand(i,NTAB-1)
if(icmplx.eq.0) then
wave(k)=real(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
kshift=nsps
if(icmplx.eq.0) then
wave(1:nsps)=0.0
wave(nsps+1:nsps+nsps/4)=wave(nsps+1:nsps+nsps/4) * &
(1.0-cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0
k1=nsym*nsps+3*nsps/4+1
wave((nsym+1)*nsps+1:)=0.0
wave(k1:k1+nsps/4)=wave(k1:k1+nsps/4) * &
(1.0+cos(twopi*(/(i,i=0,nsps/4)/)/real(nsps/2)))/2.0
wave=cshift(wave,kshift)
else
cwave(1:nsps)=0.0
cwave(nsps+1:nsps+nsps/4)=cwave(nsps+1:nsps+nsps/4) * &
(1.0-cos(twopi*(/(i,i=0,nsps/4-1)/)/real(nsps/2)))/2.0
k1=nsym*nsps+3*nsps/4+1
cwave((nsym+1)*nsps+1:)=0.0
cwave(k1:k1+nsps/4)=cwave(k1:k1+nsps/4) * &
(1.0+cos(twopi*(/(i,i=0,nsps/4)/)/real(nsps/2)))/2.0
cwave=cshift(cwave,kshift)
endif
return
end subroutine gen_fst4wave

111
lib/fst4/genfst4.f90 Normal file
View File

@ -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
1 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

25
lib/fst4/get_crc24.f90 Normal file
View File

@ -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

131
lib/fst4/get_fst4_bitmetrics.f90 Normal file
View File

@ -0,0 +1,131 @@
subroutine get_fst4_bitmetrics(cd,nss,hmod,nmax,nhicoh,bitmetrics,s4,badsync)
include 'fst4_params.f90'
complex cd(0:NN*nss-1)
complex cs(0:3,NN)
complex csymb(nss)
complex, allocatable, save :: c1(:,:) ! ideal waveforms, 20 samples per symbol, 4 tones
complex cp(0:3) ! accumulated phase shift over symbol types 0:3
complex csum,cterm
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)
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
cs(itone,k)=sum(csymb*conjg(c1(:,itone)))
enddo
s4(0:3,k)=abs(cs(0:3,k))
enddo
! Sync quality check
is1=0
is2=0
is3=0
is4=0
is5=0
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
bitmetrics=0.0
do nseq=1,nmax !Try coherent sequences of 1, 2, and 4 symbols
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nhicoh.eq.0) then
if(nseq.eq.3) nsym=3
if(nseq.eq.4) nsym=4
else
if(nseq.eq.3) nsym=4
if(nseq.eq.4) nsym=8
endif
nt=4**nsym
do ks=1,NN-nsym+1,nsym
s2=0
do i=0,nt-1
csum=0
cterm=1
do j=0,nsym-1
ntone=mod(i/4**(nsym-1-j),4)
csum=csum+cs(graymap(ntone),ks+j)*cterm
cterm=cterm*conjg(cp(graymap(ntone)))
enddo
s2(i)=abs(csum)
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.3) ibmax=5
if(nsym.eq.4) ibmax=7
if(nsym.eq.8) ibmax=15
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(ipt+ib.gt.2*NN) cycle
bitmetrics(ipt+ib,nseq)=bm
enddo
enddo
enddo
call normalizebmet(bitmetrics(:,1),2*NN)
call normalizebmet(bitmetrics(:,2),2*NN)
call normalizebmet(bitmetrics(:,3),2*NN)
call normalizebmet(bitmetrics(:,4),2*NN)
return
end subroutine get_fst4_bitmetrics

131
lib/fst4/get_fst4_bitmetrics2.f90 Normal file
View File

@ -0,0 +1,131 @@
subroutine get_fst4_bitmetrics2(cd,nss,hmod,nsizes,bitmetrics,s4hmod,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
complex csum,cterm
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),s4hmod(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))))
s4(itone,k,2)=abs(sum(csymb( 1:nss/2)*conjg(c1( 1:nss/2,itone)))) + &
abs(sum(csymb(nss/2+1: nss)*conjg(c1(nss/2+1: nss,itone))))
s4(itone,k,3)=abs(sum(csymb( 1: nss/4)*conjg(c1( 1: nss/4,itone)))) + &
abs(sum(csymb( nss/4+1: nss/2)*conjg(c1( nss/4+1: nss/2,itone)))) + &
abs(sum(csymb( nss/2+1:3*nss/4)*conjg(c1( nss/2+1:3*nss/4,itone)))) + &
abs(sum(csymb(3*nss/4+1: nss)*conjg(c1(3*nss/4+1: nss,itone))))
s4(itone,k,4)=abs(sum(csymb( 1: nss/8)*conjg(c1( 1: nss/8,itone)))) + &
abs(sum(csymb( nss/8+1: nss/4)*conjg(c1( nss/8+1: nss/4,itone)))) + &
abs(sum(csymb( nss/4+1:3*nss/8)*conjg(c1( nss/4+1:3*nss/8,itone)))) + &
abs(sum(csymb(3*nss/8+1: nss/2)*conjg(c1(3*nss/8+1: nss/2,itone)))) + &
abs(sum(csymb( nss/2+1:5*nss/8)*conjg(c1( nss/2+1:5*nss/8,itone)))) + &
abs(sum(csymb(5*nss/8+1:3*nss/4)*conjg(c1(5*nss/8+1:3*nss/4,itone)))) + &
abs(sum(csymb(3*nss/4+1:7*nss/8)*conjg(c1(3*nss/4+1:7*nss/8,itone)))) + &
abs(sum(csymb(7*nss/8+1: nss)*conjg(c1(7*nss/8+1: nss,itone))))
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/hmod. Will be used for SNR calculation
if(hmod.eq.1) s4hmod(:,:)=s4(:,:,1)
if(hmod.eq.2) s4hmod(:,:)=s4(:,:,2)
if(hmod.eq.4) s4hmod(:,:)=s4(:,:,3)
if(hmod.eq.8) s4hmod(:,:)=s4(:,:,4)
return
end subroutine get_fst4_bitmetrics2

142
lib/fst4/ldpc_240_101_generator.f90 Normal file
View File

@ -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"/

393
lib/fst4/ldpc_240_101_parity.f90 Normal file
View File

@ -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

170
lib/fst4/ldpc_240_74_generator.f90 Normal file
View File

@ -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"/

423
lib/fst4/ldpc_240_74_parity.f90 Normal file
View File

@ -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

137
lib/fst4/ldpcsim240_101.f90 Normal file
View File

@ -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

125
lib/fst4/ldpcsim240_74.f90 Normal file
View File

@ -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,msg
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,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_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=0
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

403
lib/fst4/osd240_101.f90 Normal file
View File

@ -0,0 +1,403 @@
subroutine osd240_101(llr,k,apmask,ndeep,message101,cw,nhardmin,dmin)
!
! An ordered-statistics decoder for the (240,101) code.
! Message payload is 77 bits. Any or all of a 24-bit CRC can be
! used for detecting incorrect codewords. The remaining CRC bits are
! cascaded with the LDPC code for the purpose of improving the
! distance spectrum of the code.
!
! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are
! to be used for bad codeword detection, then the argument k should
! be set to 77+p1.
!
! Valid values for k are in the range [77,101].
!
character*24 c24
integer, parameter:: N=240
integer*1 apmask(N),apmaskr(N)
integer*1, allocatable, save :: gen(:,:)
integer*1, allocatable :: genmrb(:,:),g2(:,:)
integer*1, allocatable :: temp(:),m0(:),me(:),mi(:),misub(:),e2sub(:),e2(:),ui(:)
integer*1, allocatable :: r2pat(:)
integer indices(N),nxor(N)
integer*1 cw(N),ce(N),c0(N),hdec(N)
integer*1, allocatable :: decoded(:)
integer*1 message101(101)
integer indx(N)
real llr(N),rx(N),absrx(N)
logical first,reset
data first/.true./
save first
allocate( genmrb(k,N), g2(N,k) )
allocate( temp(k), m0(k), me(k), mi(k), misub(k), e2sub(N-k), e2(N-k), ui(N-k) )
allocate( r2pat(N-k), decoded(k) )
if( first ) then ! fill the generator matrix
!
! Create generator matrix for partial CRC cascaded with LDPC code.
!
! Let p2=101-k and p1+p2=24.
!
! The last p2 bits of the CRC24 are cascaded with the LDPC code.
!
! The first p1=k-77 CRC24 bits will be used for error detection.
!
allocate( gen(k,N) )
gen=0
do i=1,k
message101=0
message101(i)=1
if(i.le.77) then
call get_crc24(message101,101,ncrc24)
write(c24,'(b24.24)') ncrc24
read(c24,'(24i1)') message101(78:101)
message101(78:k)=0
endif
call encode240_101(message101,cw)
gen(i,:)=cw
enddo
first=.false.
endif
rx=llr
apmaskr=apmask
! Hard decisions on the received word.
hdec=0
where(rx .ge. 0) hdec=1
! Use magnitude of received symbols as a measure of reliability.
absrx=abs(rx)
call indexx(absrx,N,indx)
! Re-order the columns of the generator matrix in order of decreasing reliability.
do i=1,N
genmrb(1:k,i)=gen(1:k,indx(N+1-i))
indices(i)=indx(N+1-i)
enddo
! Do gaussian elimination to create a generator matrix with the most reliable
! received bits in positions 1:k in order of decreasing reliability (more or less).
do id=1,k ! diagonal element indices
do icol=id,k+20 ! The 20 is ad hoc - beware
iflag=0
if( genmrb(id,icol) .eq. 1 ) then
iflag=1
if( icol .ne. id ) then ! reorder column
temp(1:k)=genmrb(1:k,id)
genmrb(1:k,id)=genmrb(1:k,icol)
genmrb(1:k,icol)=temp(1:k)
itmp=indices(id)
indices(id)=indices(icol)
indices(icol)=itmp
endif
do ii=1,k
if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then
genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N))
endif
enddo
exit
endif
enddo
enddo
g2=transpose(genmrb)
! The hard decisions for the k MRB bits define the order 0 message, m0.
! Encode m0 using the modified generator matrix to find the "order 0" codeword.
! Flip various combinations of bits in m0 and re-encode to generate a list of
! codewords. Return the member of the list that has the smallest Euclidean
! distance to the received word.
hdec=hdec(indices) ! hard decisions from received symbols
m0=hdec(1:k) ! zero'th order message
absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode101(m0,c0,g2,N,k)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
cw=c0
ntotal=0
nrejected=0
npre1=0
npre2=0
if(ndeep.eq.0) goto 998 ! norder=0
if(ndeep.gt.6) ndeep=6
if( ndeep.eq. 1) then
nord=1
npre1=0
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.2) then
nord=1
npre1=1
npre2=0
nt=40
ntheta=12
elseif(ndeep.eq.3) then
nord=1
npre1=1
npre2=1
nt=40
ntheta=12
ntau=14
elseif(ndeep.eq.4) then
nord=2
npre1=1
npre2=1
nt=40
ntheta=12
ntau=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

403
lib/fst4/osd240_74.f90 Normal file
View File

@ -0,0 +1,403 @@
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
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

915
lib/fst4_decode.f90 Normal file
View File

@ -0,0 +1,915 @@
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,lwspr,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
logical, intent(in) :: lwspr
real, intent(in) :: fmid
real, intent(in) :: w50
end subroutine fst4_decode_callback
end interface
contains
subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfqso, &
nfa,nfb,nsubmode,ndepth,ntrperiod,nexp_decode,ntol, &
emedelay,lapcqonly,mycall,hiscall,nfsplit,iwspr)
use timer_module, only: timer
use packjt77
use, intrinsic :: iso_c_binding
include 'fst4/fst4_params.f90'
parameter (MAXCAND=100)
class(fst4_decoder), intent(inout) :: this
procedure(fst4_decode_callback) :: callback
character*37 decodes(100)
character*37 msg,msgsent
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),llra(240),llrb(240),llrc(240),llrd(240)
real candidates(100,4)
real bitmetrics(320,4)
real s4(0:3,NN)
real minsync
logical lapcqonly
integer itone(NN)
integer hmod
integer*1 apmask(240),cw(240)
integer*1 hbits(320)
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,lwspr,ex
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./
save first,apbits,nappasses,naptypes,mycall0,hiscall0
this%callback => callback
dxcall13=hiscall ! initialize for use in packjt77
mycall13=mycall
fMHz=1.0
if(iwspr.ne.0.and.iwspr.ne.1) return
if(first) then
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)
call encode174_91(message77,cw)
apbits=2*cw-1
if(nohiscall) apbits(30)=99
10 continue
mycall0=mycall
hiscall0=hiscall
endif
!************************************
hmod=2**nsubmode
if(nfqso+nqsoprogress.eq.-999) return
Keff=91
nmax=15*12000
single_decode=iand(nexp_decode,32).eq.32
if(ntrperiod.eq.15) then
nsps=720
nmax=15*12000
ndown=18/hmod !nss=40,80,160,400
if(hmod.eq.4) ndown=4
if(hmod.eq.8) ndown=2
nfft1=int(nmax/ndown)*ndown
else if(ntrperiod.eq.30) then
nsps=1680
nmax=30*12000
ndown=42/hmod !nss=40,80,168,336
nfft1=359856 !nfft2=8568=2^3*3^2*7*17
if(hmod.eq.4) then
ndown=10
nfft1=nmax
endif
if(hmod.eq.8) then
ndown=5
nfft1=nmax
endif
else if(ntrperiod.eq.60) then
nsps=3888
nmax=60*12000
ndown=96/hmod !nss=36,81,162,324
if(hmod.eq.1) ndown=108
nfft1=7500*96 ! nfft2=7500=2^2*3*5^4
else if(ntrperiod.eq.120) then
nsps=8200
nmax=120*12000
ndown=200/hmod !nss=40,82,164,328
if(hmod.eq.1) ndown=205
nfft1=7200*200 ! nfft2=7200=2^5*3^2*5^2
else if(ntrperiod.eq.300) then
nsps=21504
nmax=300*12000
ndown=512/hmod !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/hmod !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/hmod !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*hmod*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) )
if(ndepth.eq.3) then
nblock=4
jittermax=2
norder=3
elseif(ndepth.eq.2) then
nblock=1
if(hmod.eq.1) nblock=3
jittermax=0
norder=3
elseif(ndepth.eq.1) then
nblock=1
jittermax=0
norder=3
endif
ndropmax=1
npct=nexp_decode/256
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
! call blank2(nfa,nfb,nfft1,c_bigfft,iwave)
if(hmod.eq.1) then
if(fMHz.lt.2.0) then
nsyncoh=8 ! Use N=8 for sync
nhicoh=1 ! Use N=1,2,4,8 for symbol estimation
else
nsyncoh=4 ! Use N=4 for sync
nhicoh=0 ! Use N=1,2,3,4 for symbol estimation
endif
else
if(hmod.eq.2) nsyncoh=1
if(hmod.eq.4) nsyncoh=-2
if(hmod.eq.8) nsyncoh=-4
endif
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(hmod.eq.1) then
if(ntrperiod.eq.15) minsync=1.15
if(ntrperiod.gt.15) minsync=1.20
elseif(hmod.gt.1) then
minsync=1.2
endif
! Get first approximation of candidate frequencies
call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb, &
minsync,ncand,candidates,base)
ndecodes=0
decodes=' '
isbest=0
fc2=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 fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2)
call timer('sync240 ',0)
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
smax=-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.smax) then
fc2=fc
isbest=istart
smax=sync
endif
enddo
enddo
fc1=fc2
is0=isbest
ishw=4*hmod
isst=1*hmod
smax=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.smax) then
fc2=fc
isbest=istart
smax=sync
endif
enddo
enddo
call timer('sync240 ',1)
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.10*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
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 fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,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+160*nss-1)
bitmetrics=0
if(hmod.eq.1) then
call get_fst4_bitmetrics(cframe,nss,hmod,nblock,nhicoh,bitmetrics,s4,badsync)
else
call get_fst4_bitmetrics2(cframe,nss,hmod,nblock,bitmetrics,s4,badsync)
endif
if(badsync) cycle
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) cycle !### Value ?? ###
scalefac=2.83
llra( 1: 60)=bitmetrics( 17: 76, 1)
llra( 61:120)=bitmetrics( 93:152, 1)
llra(121:180)=bitmetrics(169:228, 1)
llra(181:240)=bitmetrics(245:304, 1)
llra=scalefac*llra
llrb( 1: 60)=bitmetrics( 17: 76, 2)
llrb( 61:120)=bitmetrics( 93:152, 2)
llrb(121:180)=bitmetrics(169:228, 2)
llrb(181:240)=bitmetrics(245:304, 2)
llrb=scalefac*llrb
llrc( 1: 60)=bitmetrics( 17: 76, 3)
llrc( 61:120)=bitmetrics( 93:152, 3)
llrc(121:180)=bitmetrics(169:228, 3)
llrc(181:240)=bitmetrics(245:304, 3)
llrc=scalefac*llrc
llrd( 1: 60)=bitmetrics( 17: 76, 4)
llrd( 61:120)=bitmetrics( 93:152, 4)
llrd(121:180)=bitmetrics(169:228, 4)
llrd(181:240)=bitmetrics(245:304, 4)
llrd=scalefac*llrd
apmag=maxval(abs(llra))*1.1
ntmax=nblock+nappasses(nQSOProgress)
if(lapcqonly) ntmax=nblock+1
if(ndepth.eq.1) ntmax=nblock
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=llra
if(itry.eq.2.and.itry.le.nblock) llr=llrb
if(itry.eq.3.and.itry.le.nblock) llr=llrc
if(itry.eq.4.and.itry.le.nblock) llr=llrd
if(itry.le.nblock) then
apmask=0
iaptype=0
endif
if(itry.gt.nblock) then
llr=llra
if(nblock.gt.1) then
if(hmod.eq.1) llr=llrd
if(hmod.eq.2) llr=llrb
if(hmod.eq.4) llr=llrc
if(hmod.eq.8) llr=llrd
endif
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)
elseif(iwspr.eq.1) then
maxosd=2
call timer('d240_74 ',0)
Keff=64
norder=4
call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, &
ntype,nharderrors,dmin)
call timer('d240_74 ',1)
endif
if(nharderrors .ge.0) then
if(count(cw.eq.1).eq.0) then
nharderrors=-nharderrors
cycle
endif
if(iwspr.eq.0) then
write(c77,'(77i1)') mod(message101(1:77)+rvec,2)
call unpack77(c77,1,msg,unpk77_success)
else
write(c77,'(50i1)') message74(1:50)
c77(51:77)='000000000000000000000110000'
call unpack77(c77,1,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) goto 2002
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=ex)
fmid=-999.0
if(ex) then
call dopspread(itone,iwave,nsps,nmax,ndown,hmod, &
isbest,fc_synced,fmid,w50)
endif
xsig=0
do i=1,NN
xsig=xsig+s4(itone(i),i)**2
enddo
arg=600.0*(xsig/base)-1.0
if(arg.gt.0.0) then
xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0)
if(ntrperiod.eq. 15) xsnr=xsnr+2
if(ntrperiod.eq. 30) xsnr=xsnr+1
if(ntrperiod.eq. 900) xsnr=xsnr+1
if(ntrperiod.eq.1800) xsnr=xsnr+2
else
xsnr=-99.9
endif
else
cycle
endif
nsnr=nint(xsnr)
qual=0.
fsig=fc_synced - 1.5*hmod*baud
if(ex) then
write(21,3021) nutc,icand,itry,nsyncoh,iaptype, &
ijitter,ntype,nsync_qual,nharderrors,dmin, &
sync,xsnr,xdt,fsig,w50,trim(msg)
3021 format(i6.6,6i3,2i4,f6.1,f7.2,f6.1,f6.2,f7.1,f7.3,1x,a)
flush(21)
endif
call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, &
iaptype,qual,ntrperiod,lwspr,fmid,w50)
goto 2002
endif
enddo ! metrics
enddo ! istart jitter
2002 enddo !candidate list
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, &
minsync,ncand,candidates,base)
complex c_bigfft(0:nfft1/2) !Full length FFT of raw data
integer hmod !Modulation index (submode)
integer im(1) !For maxloc
real candidates(100,4) !Candidate list
real, allocatable :: s(:) !Low resolution power spectrum
real, allocatable :: s2(:) !CCF of s() with 4 tones
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
signal_bw=4*(12000.0/nsps)*hmod
analysis_bw=min(4800.0,fb)-max(100.0,fa)
xnoise_bw=10.0*signal_bw !Is this a good compromise?
if(analysis_bw.gt.xnoise_bw) then
ina=ia
inb=ib
else
fcenter=(fa+fb)/2.0 !If noise_bw > analysis_bw,
fl = max(100.0,fcenter-xnoise_bw/2.)/df2 !we'll search over noise_bw
fh = min(4800.0,fcenter+xnoise_bw/2.)/df2
ina=nint(fl)
inb=nint(fh)
endif
nnw=nint(48000.*nsps*2./fs)
allocate (s(nnw))
s=0. !Compute low-resloution 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))
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
call pctile(s2(ina+hmod*3:inb-hmod*3),inb-ina+1-hmod*6,30,base)
s2=s2/base !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.100)
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
enddo
return
end subroutine get_candidates_fst4
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)
real,allocatable,save :: ssavg(:) !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

27
lib/ft8/foxgen.f90
View File

@ -15,7 +15,8 @@ subroutine foxgen()
! common block.
parameter (NN=79,ND=58,NSPS=4*1920)
parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2)
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)
@ -60,34 +61,10 @@ subroutine foxgen()
peak1=maxval(abs(wave))
wave=wave/peak1
! call plotspec(1,wave) !Plot the spectrum
! Apply compression
! rms=sqrt(dot_product(wave,wave)/kz)
! wave=wave/rms
! do i=1,NWAVE
! wave(i)=h1(wave(i))
! enddo
! peak2=maxval(abs(wave))
! wave=wave/peak2
! call plotspec(2,wave) !Plot the spectrum
width=50.0
call foxfilt(nslots,nfreq,width,wave)
peak3=maxval(abs(wave))
wave=wave/peak3
! nadd=1000
! j=0
! do i=1,NWAVE,nadd
! sx=dot_product(wave(i:i+nadd-1),wave(i:i+nadd-1))
! j=j+1
! write(30,3001) j,sx/nadd
!3001 format(i8,f12.6)
! enddo
! call plotspec(3,wave) !Plot the spectrum
return
end subroutine foxgen

2
lib/ft8/foxgen_wrap.f90
View File

@ -1,7 +1,7 @@
subroutine foxgen_wrap(msg40,msgbits,itone)
parameter (NN=79,ND=58,KK=77,NSPS=4*1920)
parameter (NWAVE=NN*NSPS)
parameter (NWAVE=(160+2)*134400) !the biggest waveform we generate (FST4-1800)
character*40 msg40,cmsg
character*12 mycall12

92
lib/jt9.f90
View File

@ -17,19 +17,20 @@ program jt9
integer(C_INT) iret
type(wav_header) wav
real*4 s(NSMAX)
real*8 TRperiod
character c
character(len=500) optarg, infile
character wisfile*80
!### ndepth was defined as 60001. Why???
integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700, &
fhigh=4000,nrxfreq=1500,ntrperiod=1,ndepth=1,nexp_decode=0
fhigh=4000,nrxfreq=1500,ndepth=1,nexp_decode=0,nQSOProg=0
logical :: read_files = .true., tx9 = .false., display_help = .false., &
bLowSidelobes = .false.
type (option) :: long_options(26) = [ &
type (option) :: long_options(29) = [ &
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 MINUTES=1', &
'MINUTES'), &
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'), &
@ -52,13 +53,17 @@ program jt9
'THREADS'), &
option ('jt4', .false., '4', 'JT4 mode', ''), &
option ('ft4', .false., '5', 'FT4 mode', ''), &
option ('jt65', .false.,'6', 'JT65 mode', ''), &
option ('jt65', .false.,'6', 'JT65 mode', ''), &
option ('fst4', .false., '7', 'FST4 mode', ''), &
option ('fst4w', .false., 'W', 'FST4W mode', ''), &
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', &
'JT9 decoding depth (1-3), default DEPTH=1', 'DEPTH'), &
'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'), &
@ -74,12 +79,14 @@ program jt9
character(len=6) :: mygrid='', hisgrid='EN37'
common/patience/npatience,nthreads
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
data npatience/1/,nthreads/1/
data npatience/1/,nthreads/1/,wisfile/' '/
iwspr=0
nsubmode = 0
TRperiod=60.d0
do
call getopt('hs:e:a:b:r:m:p:d:f:w:t:98654qTL:S:H:c:G:x:g:X:', &
call getopt('hs:e:a:b:r:m:p:d:f:w:t:987654WqTL:S:H:c:G:x:g:X:Q:', &
long_options,c,optarg,arglen,stat,offset,remain,.true.)
if (stat .ne. 0) then
exit
@ -101,7 +108,7 @@ program jt9
case ('m')
read (optarg(:arglen), *) nthreads
case ('p')
read (optarg(:arglen), *) ntrperiod
read (optarg(:arglen), *) TRperiod
case ('d')
read (optarg(:arglen), *) ndepth
case ('f')
@ -114,20 +121,28 @@ program jt9
read (optarg(:arglen), *) fhigh
case ('q')
mode = 164
case ('Q')
read (optarg(:arglen), *) nQSOProg
case ('4')
mode = 4
case ('5')
mode = 5
case ('6')
if (mode.lt.65) mode = mode + 65
case ('9')
if (mode.lt.9.or.mode.eq.65) mode = mode + 9
case ('7')
mode = 240
iwspr=0
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
iwspr=1
case ('c')
read (optarg(:arglen), *) mycall
case ('G')
@ -182,7 +197,6 @@ program jt9
allocate(shared_data)
nflatten=0
do iarg = offset + 1, offset + remain
call get_command_argument (iarg, optarg, arglen)
infile = optarg(:arglen)
@ -197,34 +211,16 @@ program jt9
endif
go to 2
1 nutc=0
2 nsps=0
if(ntrperiod.eq.1) then
nsps=6912
shared_data%params%nzhsym=181
else if(ntrperiod.eq.2) then
nsps=15360
shared_data%params%nzhsym=178
else if(ntrperiod.eq.5) then
nsps=40960
shared_data%params%nzhsym=172
else if(ntrperiod.eq.10) then
nsps=82944
shared_data%params%nzhsym=171
else if(ntrperiod.eq.30) then
nsps=252000
shared_data%params%nzhsym=167
endif
if(nsps.eq.0) stop 'Error: bad TRperiod'
2 nsps=6912
npts=TRperiod*12000.d0
kstep=nsps/2
k=0
nhsym=0
nhsym0=-999
npts=(60*ntrperiod-6)*12000
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
do iblk=1,npts/kstep
@ -244,18 +240,18 @@ program jt9
ingain=0
call timer('symspec ',0)
nminw=1
call symspec(shared_data,k,ntrperiod,nsps,ingain,bLowSidelobes,nminw,pxdb, &
s,df3,ihsym,npts8,pxdbmax)
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) exit
if(nhsym.ge.181 .and. mode.ne.240 .and. mode.ne.241) exit
endif
enddo
close(unit=wav%lun)
shared_data%params%nutc=nutc
shared_data%params%ndiskdat=.true.
shared_data%params%ntr=60
shared_data%params%ntr=TRperiod
shared_data%params%nfqso=nrxfreq
shared_data%params%newdat=.true.
shared_data%params%npts8=74736
@ -264,23 +260,18 @@ program jt9
shared_data%params%nfb=fhigh
shared_data%params%ntol=20
shared_data%params%kin=64800
shared_data%params%nzhsym=181
if(mode.eq.240) shared_data%params%kin=720000 !### 60 s periods ###
shared_data%params%nzhsym=nhsym
if(mode.eq.240 .and. iwspr.eq.1) ndepth=ior(ndepth,128)
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.
! shared_data%params%minsync=0 !### TEST ONLY
! shared_data%params%nfqso=1500 !### TEST ONLY
! mycall="G3WDG " !### TEST ONLY
! hiscall="VK7MO " !### TEST ONLY
! hisgrid="QE37 " !### TEST ONLY
if(mode.eq.164 .and. nsubmode.lt.100) nsubmode=nsubmode+100
shared_data%params%naggressive=0
shared_data%params%n2pass=2
! shared_data%params%nranera=8 !### ntrials=10000
shared_data%params%nQSOprogress=nQSOProg
shared_data%params%nranera=6 !### ntrials=3000
shared_data%params%nrobust=.false.
shared_data%params%nexp_decode=nexp_decode
@ -334,13 +325,8 @@ program jt9
999 continue
! Output decoder statistics
call fini_timer ()
! open (unit=12, file=trim(data_dir)//'/timer.out', status='unknown', position='append')
! write(12,1100) n65a,ntry65a,n65b,ntry65b,numfano,num9
!1100 format(58('-')/' JT65_1 Tries_1 JT65_2 Tries_2 JT9 Tries'/ &
! 58('-')/6i8)
! Save wisdom and free memory
iret=fftwf_export_wisdom_to_filename(wisfile)
! 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()

21
lib/sec0.f90 Normal file
View File

@ -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

16
lib/symspec.f90
View File

@ -1,14 +1,12 @@
subroutine symspec(shared_data,k,ntrperiod,nsps,ingain,bLowSidelobes, &
nminw,pxdb,s,df3,ihsym,npts8,pxdbmax)
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
! ntrperiod T/R sequence length, minutes
! 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
! nb 0/1 status of noise blanker (off/on)
! nbslider NB setting, 0-100
! Output:
! pxdb raw power (0-90 dB)
@ -23,6 +21,7 @@ subroutine symspec(shared_data,k,ntrperiod,nsps,ingain,bLowSidelobes, &
include 'jt9com.f90'
type(dec_data) :: shared_data
real*8 TRperiod
real*4 w3(MAXFFT3)
real*4 s(NSMAX)
real*4 ssum(NSMAX)
@ -38,7 +37,7 @@ subroutine symspec(shared_data,k,ntrperiod,nsps,ingain,bLowSidelobes, &
equivalence (xc,cx)
save
if(ntrperiod.eq.-999) stop !Silence compiler warning
if(TRperiod.lt.0.d0) 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
@ -64,6 +63,11 @@ subroutine symspec(shared_data,k,ntrperiod,nsps,ingain,bLowSidelobes, &
gain=10.0**(0.1*ingain)
sq=0.
pxmax=0.;
! dwell_time=0.0001
! if(k.gt.k0 .and. npct.gt.0) call blanker(shared_data%id2(k0+1:k), &
! k-k0,dwell_time,npct)
do i=k0+1,k
x1=shared_data%id2(i)
if (abs(x1).gt.pxmax) pxmax = abs(x1);

56
lib/t6.f90
View File

@ -1,56 +0,0 @@
program t6
parameter (MAXFFT=1404)
complex c(0:MAXFFT-1)
real s(0:MAXFFT-1)
m1=45
m2=67
m3=89
nsym=3*11 + m1 + m2 + m3
nfft=6*nsym
nh=nfft/2
best=9999.
! do m1=22,67
! do m2=37,97
do m1=30,67
do m2=26,100
m3=201-m2-m1
if(m3.lt.13) cycle
c=0.
n1=6*(11+m1)
n2=n1+6*(11+m2)
c(1:66)=1.
c(1+n1:66+n1)=1.
c(1+n2:66+n2)=1.
call four2a(c,nfft,1,-1,1) !c2c FFT
df=12000.0/nfft
smax=0.
do i=0,nfft-1
s(i)=real(c(i))**2 + aimag(c(i))**2
if(i.ne.0) smax=max(s(i),smax)
enddo
sidelobe=db(smax/s(0))
if(sidelobe.lt.best) then
write(*,1000) m1,m2,m3,sidelobe
1000 format(3i5,f8.2)
best=sidelobe
s=s/s(0)
rewind 13
do j=0,nfft-1
i=mod(j+nh,nfft)
f=i*df
if(i.gt.nh) f=f-12000.0
write(13,1020) f,s(i)
1020 format(2f12.4)
enddo
endif
enddo
enddo
end program t6

10
lib/types.f90 Normal file
View File

@ -0,0 +1,10 @@
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
end module types

3
main.cpp
View File

@ -373,13 +373,14 @@ int main(int argc, char *argv[])
}
if (!mem_jt9.attach ())
{
if (!mem_jt9.create (sizeof (struct dec_data)))
if (!mem_jt9.create (sizeof (dec_data)))
{
splash.hide ();
MessageBox::critical_message (nullptr, a.translate ("main", "Shared memory error"),
a.translate ("main", "Unable to create shared memory segment"));
throw std::runtime_error {"Shared memory error"};
}
qDebug () << "shmem size:" << mem_jt9.size ();
}
else
{

33
models/FrequencyList.cpp
View File

@ -46,16 +46,22 @@ namespace
{20000000, Modes::FreqCal, IARURegions::ALL},
{136000, Modes::WSPR, IARURegions::ALL},
{136200, Modes::FST4W, IARURegions::ALL},
{136130, Modes::JT65, IARURegions::ALL},
{136130, Modes::JT9, IARURegions::ALL},
{136130, Modes::FST4, IARURegions::ALL},
{474200, Modes::JT65, IARURegions::ALL},
{474200, Modes::JT9, IARURegions::ALL},
{474200, Modes::FST4, IARURegions::ALL},
{474200, Modes::WSPR, IARURegions::ALL},
{474400, Modes::FST4W, IARURegions::ALL},
{1836600, Modes::WSPR, IARURegions::ALL},
{1836800, Modes::FST4W, IARURegions::ALL},
{1838000, Modes::JT65, IARURegions::ALL}, // squeezed allocations
{1839000, Modes::JT9, IARURegions::ALL},
{1839000, Modes::FST4, IARURegions::ALL},
{1840000, Modes::FT8, IARURegions::ALL},
// Band plans (all USB dial unless stated otherwise)
@ -87,8 +93,10 @@ namespace
//
{3570000, Modes::JT65, IARURegions::ALL}, // JA compatible
{3572000, Modes::JT9, IARURegions::ALL},
{3572000, Modes::FST4, IARURegions::ALL},
{3573000, Modes::FT8, IARURegions::ALL}, // above as below JT65 is out of DM allocation
{3568600, Modes::WSPR, IARURegions::ALL}, // needs guard marker and lock out
{3568800, Modes::FST4W, IARURegions::ALL},
{3575000, Modes::FT4, IARURegions::ALL}, // provisional
{3568000, Modes::FT4, IARURegions::R3}, // provisional
@ -124,9 +132,11 @@ namespace
// 7110 LSB EMCOMM
//
{7038600, Modes::WSPR, IARURegions::ALL},
{7038800, Modes::FST4W, IARURegions::ALL},
{7074000, Modes::FT8, IARURegions::ALL},
{7076000, Modes::JT65, IARURegions::ALL},
{7078000, Modes::JT9, IARURegions::ALL},
{7078000, Modes::FST4, IARURegions::ALL},
{7047500, Modes::FT4, IARURegions::ALL}, // provisional - moved
// up 500Hz to clear
// W1AW code practice QRG
@ -160,7 +170,9 @@ namespace
{10136000, Modes::FT8, IARURegions::ALL},
{10138000, Modes::JT65, IARURegions::ALL},
{10138700, Modes::WSPR, IARURegions::ALL},
{10138900, Modes::FST4W, IARURegions::ALL},
{10140000, Modes::JT9, IARURegions::ALL},
{10140000, Modes::FST4, IARURegions::ALL},
{10140000, Modes::FT4, IARURegions::ALL}, // provisional
// Band plans (all USB dial unless stated otherwise)
@ -201,9 +213,11 @@ namespace
// 14106.5 OLIVIA 1000 (main QRG)
//
{14095600, Modes::WSPR, IARURegions::ALL},
{14095800, Modes::FST4W, IARURegions::ALL},
{14074000, Modes::FT8, IARURegions::ALL},
{14076000, Modes::JT65, IARURegions::ALL},
{14078000, Modes::JT9, IARURegions::ALL},
{14078000, Modes::FST4, IARURegions::ALL},
{14080000, Modes::FT4, IARURegions::ALL}, // provisional
// Band plans (all USB dial unless stated otherwise)
@ -236,25 +250,33 @@ namespace
{18100000, Modes::FT8, IARURegions::ALL},
{18102000, Modes::JT65, IARURegions::ALL},
{18104000, Modes::JT9, IARURegions::ALL},
{18104000, Modes::FST4, IARURegions::ALL},
{18104000, Modes::FT4, IARURegions::ALL}, // provisional
{18104600, Modes::WSPR, IARURegions::ALL},
{18104800, Modes::FST4W, IARURegions::ALL},
{21074000, Modes::FT8, IARURegions::ALL},
{21076000, Modes::JT65, IARURegions::ALL},
{21078000, Modes::JT9, IARURegions::ALL},
{21078000, Modes::FST4, IARURegions::ALL},
{21094600, Modes::WSPR, IARURegions::ALL},
{21094800, Modes::FST4W, IARURegions::ALL},
{21140000, Modes::FT4, IARURegions::ALL},
{24915000, Modes::FT8, IARURegions::ALL},
{24917000, Modes::JT65, IARURegions::ALL},
{24919000, Modes::JT9, IARURegions::ALL},
{24919000, Modes::FST4, IARURegions::ALL},
{24919000, Modes::FT4, IARURegions::ALL}, // provisional
{24924600, Modes::WSPR, IARURegions::ALL},
{24924800, Modes::FST4W, IARURegions::ALL},
{28074000, Modes::FT8, IARURegions::ALL},
{28076000, Modes::JT65, IARURegions::ALL},
{28078000, Modes::JT9, IARURegions::ALL},
{28078000, Modes::FST4, IARURegions::ALL},
{28124600, Modes::WSPR, IARURegions::ALL},
{28124800, Modes::FST4W, IARURegions::ALL},
{28180000, Modes::FT4, IARURegions::ALL},
{50200000, Modes::Echo, IARURegions::ALL},
@ -265,8 +287,11 @@ namespace
{50260000, Modes::MSK144, IARURegions::R3},
{50293000, Modes::WSPR, IARURegions::R2},
{50293000, Modes::WSPR, IARURegions::R3},
{50293200, Modes::FST4W, IARURegions::R2},
{50293200, Modes::FST4W, IARURegions::R3},
{50310000, Modes::JT65, IARURegions::ALL},
{50312000, Modes::JT9, IARURegions::ALL},
{50312000, Modes::FST4, IARURegions::ALL},
{50313000, Modes::FT8, IARURegions::ALL},
{50318000, Modes::FT4, IARURegions::ALL}, // provisional
{50323000, Modes::FT8, IARURegions::ALL},
@ -275,6 +300,7 @@ namespace
{70102000, Modes::JT65, IARURegions::R1},
{70104000, Modes::JT9, IARURegions::R1},
{70091000, Modes::WSPR, IARURegions::R1},
{70091200, Modes::FST4W, IARURegions::R2},
{70230000, Modes::MSK144, IARURegions::R1},
{144120000, Modes::JT65, IARURegions::ALL},
@ -284,6 +310,7 @@ namespace
{144360000, Modes::MSK144, IARURegions::R1},
{144150000, Modes::MSK144, IARURegions::R2},
{144489000, Modes::WSPR, IARURegions::ALL},
{144489200, Modes::FST4W, IARURegions::R2},
{144120000, Modes::QRA64, IARURegions::ALL},
{222065000, Modes::Echo, IARURegions::R2},

4
models/Modes.cpp
View File

@ -24,7 +24,9 @@ namespace
"QRA64",
"FreqCal",
"FT8",
"FT4"
"FT4",
"FST4",
"FST4W"
};
std::size_t constexpr mode_names_size = sizeof (mode_names) / sizeof (mode_names[0]);
}

2
models/Modes.hpp
View File

@ -50,6 +50,8 @@ public:
FreqCal,
FT8,
FT4,
FST4,
FST4W,
MODES_END_SENTINAL_AND_COUNT // this must be last
};
Q_ENUM (Mode)

13
qt_helpers.cpp
View File

@ -5,6 +5,7 @@
#include <QWidget>
#include <QStyle>
#include <QVariant>
#include <QDateTime>
QString font_as_stylesheet (QFont const& font)
{
@ -35,3 +36,15 @@ void update_dynamic_property (QWidget * widget, char const * property, QVariant
widget->style ()->polish (widget);
widget->update ();
}
QDateTime qt_round_date_time_to (QDateTime dt, int seconds)
{
dt.setSecsSinceEpoch (dt.addSecs (seconds - 1).toSecsSinceEpoch () / seconds * seconds);
return dt;
}
QDateTime qt_truncate_date_time_to (QDateTime dt, int seconds)
{
dt.setSecsSinceEpoch (dt.toSecsSinceEpoch () / seconds * seconds);
return dt;
}

6
qt_helpers.hpp
View File

@ -69,6 +69,12 @@ QString font_as_stylesheet (QFont const&);
// conditional style sheet updates
void update_dynamic_property (QWidget *, char const * property, QVariant const& value);
// round a QDateTime instance to an interval
QDateTime qt_round_date_time_to (QDateTime dt, int seconds);
// truncate a QDateTime to an interval
QDateTime qt_truncate_date_time_to (QDateTime dt, int seconds);
template <class T>
class VPtr
{

24
widgets/astro.cpp
View File

@ -25,13 +25,13 @@
extern "C" {
void astrosub(int nyear, int month, int nday, double uth, double freqMoon,
const char * mygrid, size_t mygrid_len, const char * hisgrid,
size_t hisgrid_len, double * azsun, double * elsun, double * azmoon,
const char * mygrid, const char * hisgrid,
double * azsun, double * elsun, double * azmoon,
double * elmoon, double * azmoondx, double * elmoondx, int * ntsky,
int * ndop, int * ndop00, double * ramoon, double * decmoon, double * dgrd,
double * poloffset, double * xnr, double * techo, double * width1,
double * width2, bool bTx, const char * AzElFileName, size_t AzElFileName_len,
const char * jpleph, size_t jpleph_len);
double * width2, bool bTx, const char * AzElFileName,
const char * jpleph);
}
Astro::Astro(QSettings * settings, Configuration const * configuration, QWidget * parent)
@ -112,14 +112,14 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
auto const& jpleph = configuration_->data_dir ().absoluteFilePath ("JPLEPH");
astrosub(nyear, month, nday, uth, static_cast<double> (freq_moon),
mygrid.toLatin1 ().constData (), mygrid.size (),
hisgrid.toLatin1().constData(), hisgrid.size (),
mygrid.toLatin1 ().data (),
hisgrid.toLatin1().data(),
&azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &m_dop, &m_dop00, &ramoon, &decmoon,
&dgrd, &poloffset, &xnr, &techo, &width1, &width2,
bTx,
AzElFileName.toLatin1().constData(), AzElFileName.size (),
jpleph.toLatin1().constData(), jpleph.size ());
AzElFileName.toLatin1().data(),
jpleph.toLatin1().data());
if(!hisgrid.size ()) {
azmoondx=0.0;
@ -224,14 +224,14 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
double sec {target_date_time.time().second() + 0.001*target_date_time.time().msec()};
double uth {nhr + nmin/60.0 + sec/3600.0};
astrosub(nyear, month, nday, uth, static_cast<double> (freq_moon),
mygrid.toLatin1 ().constData (), mygrid.size (),
hisgrid.toLatin1().constData(), hisgrid.size (),
mygrid.toLatin1 ().data (),
hisgrid.toLatin1().data(),
&azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &m_dop, &m_dop00, &ramoon, &decmoon,
&dgrd, &poloffset, &xnr, &techo, &width1, &width2,
bTx,
AzElFileName.toLatin1().constData(), AzElFileName.size (),
jpleph.toLatin1().constData(), jpleph.size ());
nullptr, // don't overwrite azel.dat
jpleph.toLatin1().data());
FrequencyDelta offset {0};
switch (m_DopplerMethod)
{

72
widgets/displaytext.cpp
View File

@ -241,10 +241,9 @@ void DisplayText::new_period ()
QString DisplayText::appendWorkedB4 (QString message, QString call, QString const& grid,
QColor * bg, QColor * fg, LogBook const& logBook,
QString const& currentBand, QString const& currentMode)
QString const& currentBand, QString const& currentMode,
QString extra)
{
// allow for seconds
int padding {message.indexOf (" ") > 4 ? 2 : 0};
QString countryName;
bool callB4;
bool callB4onBand;
@ -278,7 +277,6 @@ QString DisplayText::appendWorkedB4 (QString message, QString call, QString cons
}
message = message.trimmed ();
QString appendage;
highlight_types types;
// no shortcuts here as some types may be disabled
@ -329,20 +327,20 @@ QString DisplayText::appendWorkedB4 (QString message, QString call, QString cons
{
case Highlight::Continent:
case Highlight::ContinentBand:
appendage = AD1CCty::continent (looked_up.continent);
extra += AD1CCty::continent (looked_up.continent);
break;
case Highlight::CQZone:
case Highlight::CQZoneBand:
appendage = QString {"CQ Zone %1"}.arg (looked_up.CQ_zone);
extra += QString {"CQ Zone %1"}.arg (looked_up.CQ_zone);
break;
case Highlight::ITUZone:
case Highlight::ITUZoneBand:
appendage = QString {"ITU Zone %1"}.arg (looked_up.ITU_zone);
extra += QString {"ITU Zone %1"}.arg (looked_up.ITU_zone);
break;
default:
if (m_bPrincipalPrefix)
{
appendage = looked_up.primary_prefix;
extra += looked_up.primary_prefix;
}
else
{
@ -368,26 +366,38 @@ QString DisplayText::appendWorkedB4 (QString message, QString call, QString cons
countryName.replace ("European", "EU");
countryName.replace ("African", "AF");
appendage += countryName;
extra += countryName;
}
}
m_CQPriority=DecodeHighlightingModel::highlight_name(top_highlight);
// use a nbsp to save the start of appended text so we can find
// it again later, align appended data at a fixed column if
// there is space otherwise let it float to the right
int space_count {40 + padding - message.size ()};
if (space_count > 0) {
message += QString {space_count, QChar {' '}};
}
message += QChar::Nbsp + appendage;
return leftJustifyAppendage (message, extra);
}
QString DisplayText::leftJustifyAppendage (QString message, QString const& appendage) const
{
if (appendage.size ())
{
// allow for seconds
int padding {message.indexOf (" ") > 4 ? 2 : 0};
// use a nbsp to save the start of appended text so we can find
// it again later, align appended data at a fixed column if
// there is space otherwise let it float to the right
int space_count {40 + padding - message.size ()};
if (space_count > 0) {
message += QString {space_count, QChar {' '}};
}
message += QChar::Nbsp + appendage;
}
return message;
}
void DisplayText::displayDecodedText(DecodedText const& decodedText, QString const& myCall,
QString const& mode,
bool displayDXCCEntity, LogBook const& logBook,
QString const& currentBand, bool ppfx, bool bCQonly)
QString const& currentBand, bool ppfx, bool bCQonly,
bool haveFSpread, float fSpread)
{
m_bPrincipalPrefix=ppfx;
QColor bg;
@ -420,7 +430,18 @@ void DisplayText::displayDecodedText(DecodedText const& decodedText, QString con
decodedText.deCallAndGrid (/*out*/ dxCall, dxGrid);
QRegularExpression grid_regexp {"\\A(?![Rr]{2}73)[A-Ra-r]{2}[0-9]{2}([A-Xa-x]{2}){0,1}\\z"};
if(!dxGrid.contains(grid_regexp)) dxGrid="";
message = message.left (message.indexOf (QChar::Nbsp)); // strip appended info
message = message.left (message.indexOf (QChar::Nbsp)).trimmed (); // strip appended info
QString extra;
if (haveFSpread)
{
extra += QString {"%1"}.arg (fSpread, 5, 'f', fSpread < 0.95 ? 3 : 2) + QChar {' '};
}
auto ap_pos = message.lastIndexOf (QRegularExpression {R"((?:\?\s)?a[0-9]$)"});
if (ap_pos >= 0)
{
extra += message.mid (ap_pos) + QChar {' '};
message = message.left (ap_pos).trimmed ();
}
m_CQPriority="";
if (CQcall)
{
@ -434,10 +455,11 @@ void DisplayText::displayDecodedText(DecodedText const& decodedText, QString con
currentMode = decodedText.isJT65 () ? "JT65" : "JT9";
}
message = appendWorkedB4 (message, decodedText.CQersCall(), dxGrid, &bg, &fg
, logBook, currentBand, currentMode);
, logBook, currentBand, currentMode, extra);
}
else
{
message = leftJustifyAppendage (message, extra);
highlight_types types {Highlight::CQ};
if (m_config && m_config->lotw_users ().user (decodedText.CQersCall()))
{
@ -446,12 +468,17 @@ void DisplayText::displayDecodedText(DecodedText const& decodedText, QString con
set_colours (m_config, &bg, &fg, types);
}
}
else
{
message = leftJustifyAppendage (message, extra);
}
appendText (message.trimmed (), bg, fg, decodedText.call (), dxCall);
}
void DisplayText::displayTransmittedText(QString text, QString modeTx, qint32 txFreq,bool bFastMode)
void DisplayText::displayTransmittedText(QString text, QString modeTx, qint32 txFreq,
bool bFastMode, double TRperiod)
{
QString t1=" @ ";
if(modeTx=="FT4") t1=" + ";
@ -459,10 +486,11 @@ void DisplayText::displayTransmittedText(QString text, QString modeTx, qint32 tx
if(modeTx=="JT4") t1=" $ ";
if(modeTx=="JT65") t1=" # ";
if(modeTx=="MSK144") t1=" & ";
if(modeTx=="FST4") t1=" ` ";
QString t2;
t2 = t2.asprintf("%4d",txFreq);
QString t;
if(bFastMode or modeTx=="FT8" or modeTx=="FT4") {
if(bFastMode or modeTx=="FT8" or modeTx=="FT4" or (TRperiod<60)) {
t = QDateTime::currentDateTimeUtc().toString("hhmmss") + \
" Tx " + t2 + t1 + text;
} else if(modeTx.mid(0,6)=="FT8fox") {

8
widgets/displaytext.h
View File

@ -30,8 +30,9 @@ public:
void insertLineSpacer(QString const&);
void displayDecodedText(DecodedText const& decodedText, QString const& myCall, QString const& mode,
bool displayDXCCEntity, LogBook const& logBook,
QString const& currentBand=QString {}, bool ppfx=false, bool bCQonly=false);
void displayTransmittedText(QString text, QString modeTx, qint32 txFreq, bool bFastMode);
QString const& currentBand=QString {}, bool ppfx=false, bool bCQonly=false,
bool haveFSpread = false, float fSpread = 0.);
void displayTransmittedText(QString text, QString modeTx, qint32 txFreq, bool bFastMode, double TRperiod);
void displayQSY(QString text);
void displayFoxToBeCalled(QString t, QColor bg = QColor {}, QColor fg = QColor {});
void new_period ();
@ -46,6 +47,7 @@ public:
Q_SLOT void highlight_callsign (QString const& callsign, QColor const& bg, QColor const& fg, bool last_period_only);
private:
QString leftJustifyAppendage (QString message, QString const& appendage) const;
void mouseDoubleClickEvent (QMouseEvent *) override;
void extend_vertical_scrollbar (int min, int max);
@ -56,7 +58,7 @@ private:
QString appendWorkedB4(QString message, QString callsign
, QString const& grid, QColor * bg, QColor * fg
, LogBook const& logBook, QString const& currentBand
, QString const& currentMode);
, QString const& currentMode, QString extra);
QFont char_font_;
QAction * erase_action_;
QHash<QString, QPair<QColor, QColor>> highlighted_calls_;

818
widgets/mainwindow.cpp
View File

File diff suppressed because it is too large Load Diff

23
widgets/mainwindow.h
View File

@ -45,15 +45,14 @@
#define NUM_JT65_SYMBOLS 126 //63 data + 63 sync
#define NUM_JT9_SYMBOLS 85 //69 data + 16 sync
#define NUM_WSPR_SYMBOLS 162 //(50+31)*2, embedded sync
#define NUM_WSPR_LF_SYMBOLS 412 //300 data + 109 sync + 3 ramp
#define NUM_ISCAT_SYMBOLS 1291 //30*11025/256
#define NUM_MSK144_SYMBOLS 144 //s8 + d48 + s8 + d80
#define NUM_QRA64_SYMBOLS 84 //63 data + 21 sync
#define NUM_FT8_SYMBOLS 79
#define NUM_FT4_SYMBOLS 105
#define NUM_FST4_SYMBOLS 160 //240/2 data + 5*8 sync
#define NUM_CW_SYMBOLS 250
#define TX_SAMPLE_RATE 48000
#define N_WIDGETS 33
#define NRING 3456000
extern int volatile itone[NUM_ISCAT_SYMBOLS]; //Audio tones for all Tx symbols
@ -206,6 +205,8 @@ private slots:
void on_actionJT4_triggered();
void on_actionFT4_triggered();
void on_actionFT8_triggered();
void on_actionFST4_triggered();
void on_actionFST4W_triggered();
void on_TxFreqSpinBox_valueChanged(int arg1);
void on_actionSave_decoded_triggered();
void on_actionQuickDecode_toggled (bool);
@ -278,13 +279,12 @@ private slots:
void networkError (QString const&);
void on_ClrAvgButton_clicked();
void on_actionWSPR_triggered();
void on_actionWSPR_LF_triggered();
void on_syncSpinBox_valueChanged(int n);
void on_TxPowerComboBox_currentIndexChanged(int);
void on_sbTxPercent_valueChanged(int n);
void on_cbUploadWSPR_Spots_toggled(bool b);
void WSPR_config(bool b);
void uploadSpots();
void uploadWSPRSpots (bool direct_post = false, QString const& decode_text = QString {});
void TxAgain();
void uploadResponse(QString response);
void on_WSPRfreqSpinBox_valueChanged(int n);
@ -298,6 +298,7 @@ private slots:
void on_actionErase_reference_spectrum_triggered();
void on_actionMeasure_phase_response_triggered();
void on_sbTR_valueChanged (int);
void on_sbTR_FST4W_valueChanged (int);
void on_sbFtol_valueChanged (int);
void on_cbFast9_clicked(bool b);
void on_sbCQTxFreq_valueChanged(int n);
@ -315,6 +316,7 @@ private slots:
void not_GA_warning_message ();
void checkMSK144ContestType();
void on_pbBestSP_clicked();
void on_RoundRobin_currentTextChanged(QString text);
int setTxMsg(int n);
bool stdCall(QString const& w);
void remote_configure (QString const& mode, quint32 frequency_tolerance, QString const& submode
@ -337,8 +339,8 @@ private:
Q_SIGNAL void transmitFrequency (double) const;
Q_SIGNAL void endTransmitMessage (bool quick = false) const;
Q_SIGNAL void tune (bool = true) const;
Q_SIGNAL void sendMessage (unsigned symbolsLength, double framesPerSymbol,
double frequency, double toneSpacing,
Q_SIGNAL void sendMessage (QString mode, unsigned symbolsLength,
double framesPerSymbol, double frequency, double toneSpacing,
SoundOutput *, AudioDevice::Channel = AudioDevice::Mono,
bool synchronize = true, bool fastMode = false, double dBSNR = 99.,
int TRperiod=60) const;
@ -500,7 +502,7 @@ private:
QString m_tBlankLine;
bool m_bShMsgs;
bool m_bSWL;
bool m_uploadSpots;
bool m_uploadWSPRSpots;
bool m_uploading;
bool m_txNext;
bool m_grid6;
@ -677,7 +679,6 @@ private:
bool m_tx_watchdog; // true when watchdog triggered
bool m_block_pwr_tooltip;
bool m_PwrBandSetOK;
bool m_bVHFwarned;
bool m_bDisplayedOnce;
Frequency m_lastMonitoredFrequency;
double m_toneSpacing;
@ -716,7 +717,7 @@ private:
void pskPost(DecodedText const& decodedtext);
void displayDialFrequency ();
void transmitDisplay (bool);
void processMessage(DecodedText const&, Qt::KeyboardModifiers = Qt::NoModifier);
void processMessage(DecodedText const& message, Qt::KeyboardModifiers = Qt::NoModifier);
void replyToCQ (QTime, qint32 snr, float delta_time, quint32 delta_frequency, QString const& mode, QString const& message_text, bool low_confidence, quint8 modifiers);
void locationChange(QString const& location);
void replayDecodes ();
@ -728,7 +729,8 @@ private:
void freqCalStep();
void setRig (Frequency = 0); // zero frequency means no change
void WSPR_history(Frequency dialFreq, int ndecodes);
QString WSPR_hhmm(int n);
QString beacon_start_time (int n = 0);
QString WSPR_message();
void fast_config(bool b);
void CQTxFreq();
void useNextCall();
@ -762,7 +764,6 @@ private:
void tx_watchdog (bool triggered);
qint64 nWidgets(QString t);
void displayWidgets(qint64 n);
void vhfWarning();
QChar current_submode () const; // returns QChar {0} if submode is not appropriate
void write_transmit_entry (QString const& file_name);
void selectHound(QString t);

1098
widgets/mainwindow.ui
View File

File diff suppressed because it is too large Load Diff

53
widgets/plotter.cpp
View File

@ -56,6 +56,7 @@ CPlotter::CPlotter(QWidget *parent) : //CPlotter Constructor
setAutoFillBackground(false);
setAttribute(Qt::WA_OpaquePaintEvent, false);
setAttribute(Qt::WA_NoSystemBackground, true);
setMouseTracking(true);
m_bReplot=false;
// contextual pop up menu
@ -184,7 +185,6 @@ void CPlotter::draw(float swide[], bool bScroll, bool bRed)
if (swide[i]<1.e29) painter1.setPen(g_ColorTbl[y1]);
painter1.drawPoint(i,m_j);
}
m_line++;
float y2min=1.e30;
@ -211,7 +211,7 @@ void CPlotter::draw(float swide[], bool bScroll, bool bRed)
for(int k=0; k<m_binsPerPixel; k++) {
sum+=spectra_.syellow[j++];
}
y2=gain2d*sum/m_binsPerPixel + m_plot2dZero;
y2=2.0*gain2d*sum/m_binsPerPixel + m_plot2dZero;
}
if(m_bReference) { //Reference (red)
@ -330,7 +330,6 @@ void CPlotter::DrawOverlay() //DrawOverlay()
double df = m_binsPerPixel*m_fftBinWidth;
QPen penOrange(QColor(255,165,0),3);
// QPen penGreen(Qt::green, 3); //Mark Tol range with green line
QPen penGreen(QColor(15,153,105), 3); //Mark Tol range or BW with dark green line
QPen penRed(Qt::red, 3); //Mark Tx freq with red
QPainter painter(&m_OverlayPixmap);
@ -415,7 +414,18 @@ void CPlotter::DrawOverlay() //DrawOverlay()
float bw=9.0*12000.0/m_nsps; //JT9
if(m_mode=="FT4") bw=3*12000.0/576.0; //FT4 ### (3x, or 4x???) ###
if(m_mode=="FT8") bw=7*12000.0/1920.0; //FT8
if(m_mode.startsWith("FST4")) {
int h=int(pow(2.0,m_nSubMode));
int nsps=800;
if(m_TRperiod==30) nsps=1680;
if(m_TRperiod==60) nsps=4000;
if(m_TRperiod==120) nsps=8400;
if(m_TRperiod==300) nsps=21504;
if(m_TRperiod==900) nsps=66560;
if(m_TRperiod==1800) nsps=134400;
float baud=12000.0/nsps;
bw=3.0*h*baud;
}
if(m_mode=="JT4") { //JT4
bw=3*11025.0/2520.0; //Max tone spacing (3/4 of actual BW)
if(m_nSubMode==1) bw=2*bw;
@ -471,13 +481,13 @@ void CPlotter::DrawOverlay() //DrawOverlay()
if(m_mode=="WSPR") {
x1=XfromFreq(1400);
x2=XfromFreq(1600);
painter0.drawLine(x1,29,x2,29);
painter0.drawLine(x1,26,x2,26);
}
if(m_mode=="WSPR-LF") {
x1=XfromFreq(1600);
x2=XfromFreq(1700);
painter0.drawLine(x1,29,x2,29);
if(m_mode=="FST4W") {
x1=XfromFreq(2600);
x2=XfromFreq(2700);
painter0.drawLine(x1,26,x2,26);
}
if(m_mode=="FreqCal") { //FreqCal
@ -492,7 +502,8 @@ void CPlotter::DrawOverlay() //DrawOverlay()
int yTxTop=12;
int yRxBottom=yTxTop + 2*yh + 4;
if(m_mode=="JT9" or m_mode=="JT65" or m_mode=="JT9+JT65"
or m_mode=="QRA64" or m_mode=="FT8" or m_mode=="FT4") {
or m_mode=="QRA64" or m_mode=="FT8" or m_mode=="FT4"
or m_mode.startsWith("FST4")) {
if(m_mode=="QRA64" or (m_mode=="JT65" and m_bVHF)) {
painter0.setPen(penGreen);
@ -523,13 +534,17 @@ void CPlotter::DrawOverlay() //DrawOverlay()
painter0.drawLine(x1,yRxBottom-yh,x1,yRxBottom);
painter0.drawLine(x1,yRxBottom,x2,yRxBottom);
painter0.drawLine(x2,yRxBottom-yh,x2,yRxBottom);
if(m_mode.startsWith("FST4")) {
x1=XfromFreq(m_rxFreq-m_tol);
x2=XfromFreq(m_rxFreq+m_tol);
painter0.drawLine(x1,26,x2,26); // Mark the Tol range
}
}
}
if(m_mode=="JT9" or m_mode=="JT65" or m_mode=="JT9+JT65" or
m_mode.mid(0,4)=="WSPR" or m_mode=="QRA64" or m_mode=="FT8"
or m_mode=="FT4") {
or m_mode=="FT4" or m_mode.startsWith("FST4")) {
painter0.setPen(penRed);
x1=XfromFreq(m_txFreq);
x2=XfromFreq(m_txFreq+bw);
@ -538,11 +553,6 @@ void CPlotter::DrawOverlay() //DrawOverlay()
x1=XfromFreq(m_txFreq-0.5*bw);
x2=XfromFreq(m_txFreq+0.5*bw);
}
if(m_mode=="WSPR-LF") {
bw=3*12000.0/8640.0; //WSPR-LF
x1=XfromFreq(m_txFreq-0.5*bw);
x2=XfromFreq(m_txFreq+0.5*bw);
}
// Draw the red "goal post"
painter0.drawLine(x1,yTxTop,x1,yTxTop+yh);
painter0.drawLine(x1,yTxTop,x2,yTxTop);
@ -688,9 +698,16 @@ void CPlotter::setRxFreq (int x) //setRxFreq
int CPlotter::rxFreq() {return m_rxFreq;} //rxFreq
void CPlotter::mouseMoveEvent (QMouseEvent * event)
{
int x=event->x();
QToolTip::showText(event->globalPos(),QString::number(int(FreqfromX(x))));
QWidget::mouseMoveEvent(event);
}
void CPlotter::mouseReleaseEvent (QMouseEvent * event)
{
if (Qt::LeftButton == event->button ()) {
if (Qt::LeftButton == event->button () and m_mode!="FST4W") {
int x=event->x();
if(x<0) x=0;
if(x>m_Size.width()) x=m_Size.width();

2
widgets/plotter.h
View File

@ -13,6 +13,7 @@
#include <QImage>
#include <QVector>
#include <QColor>
#include <QToolTip>
#define VERT_DIVS 7 //specify grid screen divisions
#define HORZ_DIVS 20
@ -91,6 +92,7 @@ protected:
//re-implemented widget event handlers
void paintEvent(QPaintEvent *event) override;
void resizeEvent(QResizeEvent* event) override;
void mouseMoveEvent(QMouseEvent * event) override;
void mouseReleaseEvent (QMouseEvent * event) override;
void mouseDoubleClickEvent (QMouseEvent * event) override;

4
widgets/widegraph.cpp
View File

@ -294,7 +294,7 @@ void WideGraph::setTxFreq(int n) //setTxFreq
void WideGraph::setMode(QString mode) //setMode
{
m_mode=mode;
ui->fSplitSpinBox->setEnabled(m_mode=="JT9+JT65");
ui->fSplitSpinBox->setEnabled(m_mode=="JT9+JT65" or m_mode.startsWith("FST4"));
ui->widePlot->setMode(mode);
ui->widePlot->DrawOverlay();
ui->widePlot->update();
@ -368,7 +368,7 @@ void WideGraph::setRxBand (QString const& band)
else
{
ui->fSplitSpinBox->setValue (m_fMinPerBand.value (band, 2500).toUInt ());
ui->fSplitSpinBox->setEnabled (m_mode=="JT9+JT65");
ui->fSplitSpinBox->setEnabled (m_mode=="JT9+JT65" or m_mode.startsWith("FST4"));
}
ui->widePlot->setRxBand(band);
setRxRange ();

6
widgets/widegraph.ui
View File

@ -362,10 +362,10 @@
<string>&lt;html&gt;&lt;head/&gt;&lt;body&gt;&lt;p&gt;Decode JT9 only above this frequency&lt;/p&gt;&lt;/body&gt;&lt;/html&gt;</string>
</property>
<property name="suffix">
<string> JT9</string>
<string> Hz</string>
</property>
<property name="prefix">
<string>JT65 </string>
<string>Split </string>
</property>
<property name="minimum">
<number>0</number>
@ -393,7 +393,7 @@
<number>1</number>
</property>
<property name="maximum">
<number>50</number>
<number>500</number>
</property>
</widget>
</item>

2
wsjtx.pro
View File

@ -53,6 +53,8 @@ include(item_delegates/item_delegates.pri)
include(logbook/logbook.pri)
include(widgets/widgets.pri)
include(Decoder/decodedtext.pri)
include(Detector/Detector.pri)
include(Modulator/Modulator.pri)
SOURCES += \
Radio.cpp NetworkServerLookup.cpp revision_utils.cpp \