diff --git a/CMakeLists.txt b/CMakeLists.txt index 87fea0c..b27c3e5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -231,7 +231,6 @@ set (wsjtx_CXXSRCS about.cpp astro.cpp messageaveraging.cpp - WsprTxScheduler.cpp varicode.cpp jsc.cpp jsc_list.cpp @@ -247,8 +246,6 @@ set (wsjtx_CXXSRCS mainwindow.cpp Configuration.cpp main.cpp - wsprnet.cpp - WSPRBandHopping.cpp TransmitTextEdit.cpp WaveUtils.cpp WaveFile.cpp @@ -286,11 +283,6 @@ set (wsjt_FSRCS lib/fftw3mod.f90 lib/hashing.f90 lib/iso_c_utilities.f90 - lib/jt4.f90 - lib/jt4_decode.f90 - lib/jt65_decode.f90 - lib/jt65_mod.f90 - lib/jt9_decode.f90 lib/options.f90 lib/packjt.f90 lib/readwav.f90 @@ -310,10 +302,7 @@ set (wsjt_FSRCS lib/js8i_decode.f90 # remaining non-module sources - lib/addit.f90 - lib/afc65b.f90 lib/afc9.f90 - lib/ana64.f90 lib/ana932.f90 lib/analytic.f90 lib/astro.f90 @@ -322,52 +311,31 @@ set (wsjt_FSRCS lib/averms.f90 lib/azdist.f90 lib/badmsg.f90 - lib/bpdecode40.f90 - lib/bpdecode144.f90 lib/ft8/bpdecode174.f90 lib/baddata.f90 lib/calibrate.f90 lib/ccf2.f90 - lib/ccf65.f90 lib/ft8/chkcrc12a.f90 lib/chkcall.f90 lib/chkhist.f90 lib/chkmsg.f90 - lib/chkss2.f90 lib/ft8/compress.f90 lib/coord.f90 lib/db.f90 - lib/decode4.f90 - lib/decode65a.f90 - lib/decode65b.f90 - lib/decode9w.f90 lib/decoder.f90 lib/deep4.f90 lib/deg2grid.f90 lib/degrade_snr.f90 - lib/demod64a.f90 lib/determ.f90 - lib/downsam9.f90 - lib/encode232.f90 - lib/encode4.f90 - lib/encode_msk40.f90 - lib/encode_msk144.f90 lib/ft8/encode174.f90 lib/entail.f90 lib/ephem.f90 - lib/extract.f90 - lib/extract4.f90 - lib/extractmessage144.f90 lib/ft8/extractmessage174.f90 lib/fano232.f90 - lib/fast9.f90 - lib/fchisq.f90 lib/fchisq0.f90 - lib/fchisq65.f90 lib/fil3.f90 lib/fil3c.f90 lib/fil4.f90 - lib/fil6521.f90 lib/filbig.f90 lib/ft8/filt8.f90 lib/fitcal.f90 @@ -376,9 +344,7 @@ set (wsjt_FSRCS lib/flat1b.f90 lib/flat2.f90 lib/flat4.f90 - lib/flat65.f90 lib/fmtmsg.f90 - lib/foldspec9f.f90 lib/four2a.f90 lib/ft8/foxfilt.f90 lib/ft8/foxgen.f90 @@ -390,28 +356,18 @@ set (wsjt_FSRCS lib/getlags.f90 lib/getmet4.f90 lib/graycode.f90 - lib/graycode65.f90 - lib/grayline.f90 lib/grid2deg.f90 lib/ft8/h1.f90 lib/hash.f90 - lib/hint65.f90 lib/indexx.f90 lib/init_random_seed.f90 - lib/interleave4.f90 - lib/interleave63.f90 - lib/interleave9.f90 - lib/inter_wspr.f90 - lib/iscat.f90 lib/jplsubs.f - lib/jt9fano.f90 lib/jtmsg.f90 lib/js8/ldpcsim174js8a.f90 lib/js8/ldpcsim174js8b.f90 lib/js8/ldpcsim174js8c.f90 lib/js8/ldpcsim174js8e.f90 lib/js8/ldpcsim174js8i.f90 - lib/ldpcsim40.f90 lib/libration.f90 lib/lorentzian.f90 lib/lpf1.f90 @@ -422,50 +378,27 @@ set (wsjt_FSRCS lib/move.f90 lib/ft8/osd174.f90 lib/pctile.f90 - lib/peakdt9.f90 lib/peakup.f90 lib/plotsave.f90 lib/polyfit.f90 lib/prog_args.f90 lib/ps4.f90 - lib/qra64a.f90 lib/refspectrum.f90 lib/savec2.f90 lib/sec_midn.f90 - lib/setup65.f90 - lib/sh65.f90 - lib/sh65snr.f90 lib/slasubs.f lib/sleep_msec.f90 lib/slope.f90 lib/smo.f90 lib/smo121.f90 - lib/softsym.f90 - lib/softsym9f.f90 - lib/softsym9w.f90 lib/shell.f90 - lib/spec64.f90 - lib/spec9f.f90 lib/stdmsg.f90 - lib/subtract65.f90 lib/sun.f90 lib/symspec.f90 - lib/symspec2.f90 - lib/symspec65.f90 - lib/sync4.f90 - lib/sync64.f90 - lib/sync65.f90 - lib/sync9.f90 - lib/sync9f.f90 - lib/sync9w.f90 - lib/synciscat.f90 lib/timf2.f90 - lib/to_contest_msg.f90 lib/tweak1.f90 lib/twkfreq.f90 lib/ft8/twkfreq1.f90 - lib/twkfreq65.f90 - lib/unpackmsg144.f90 lib/update_recent_calls.f90 lib/update_hasharray.f90 lib/wav11.f90 @@ -474,8 +407,6 @@ set (wsjt_FSRCS lib/xcor4.f90 lib/wqdecode.f90 lib/wqencode.f90 - lib/wspr_downsample.f90 - lib/zplot9.f90 ) # temporary workaround for a gfortran v7.3 ICE on Fedora 27 64-bit diff --git a/WSPRBandHopping.cpp b/WSPRBandHopping.cpp deleted file mode 100644 index bae3c4d..0000000 --- a/WSPRBandHopping.cpp +++ /dev/null @@ -1,490 +0,0 @@ -#include "WSPRBandHopping.hpp" - -#include - -#include -#include -#include -#include -#include -#include - -#include "SettingsGroup.hpp" -#include "Configuration.hpp" -#include "Bands.hpp" -#include "FrequencyList.hpp" -#include "WsprTxScheduler.h" -#include "DriftingDateTime.h" - -#include "pimpl_impl.hpp" -#include "moc_WSPRBandHopping.cpp" - -extern "C" -{ -#ifndef CMAKE_BUILD -#define FC_grayline grayline_ -#else -#include "FC.h" - void FC_grayline (int const * year, int const * month, int const * nday, float const * uth, char const * my_grid - , int const * nduration, int * isun - , int my_grid_len); -#endif -}; - -namespace -{ - char const * const title = "WSPR Band Hopping"; - char const * const periods[] = {"Sunrise grayline", "Day", "Sunset grayline", "Night", "Tune", "Rx only"}; - size_t constexpr num_periods {sizeof (periods) / sizeof (periods[0])}; - // These 10 bands are globally coordinated - QList const coordinated_bands = {"160m", "80m", "60m", "40m", "30m", "20m", "17m", "15m", "12m", "10m"}; -} - -// -// Dialog - maintenance of band hopping options -// -class Dialog - : public QDialog -{ -public: - using BandList = QList; - - Dialog (QSettings *, Configuration const *, BandList const * WSPT_bands, QBitArray * bands - , int * gray_line_duration, QWidget * parent = nullptr); - ~Dialog (); - - Q_SLOT void frequencies_changed (); - void resize_to_maximum (); - -private: - void closeEvent (QCloseEvent *) override; - void save_window_state (); - - QSettings * settings_; - Configuration const * configuration_; - BandList const * WSPR_bands_; - QBitArray * bands_; - int * gray_line_duration_; - QPointer bands_table_; - QBrush coord_background_brush_; - QPointer gray_line_width_spin_box_; - static int constexpr band_index_role {Qt::UserRole}; -}; - -Dialog::Dialog (QSettings * settings, Configuration const * configuration, BandList const * WSPR_bands - , QBitArray * bands, int * gray_line_duration, QWidget * parent) - : QDialog {parent, Qt::Window | Qt::WindowTitleHint | Qt::WindowCloseButtonHint | Qt::WindowMinimizeButtonHint} - , settings_ {settings} - , configuration_ {configuration} - , WSPR_bands_ {WSPR_bands} - , bands_ {bands} - , gray_line_duration_ {gray_line_duration} - , bands_table_ {new QTableWidget {this}} - , coord_background_brush_ {Qt::yellow} - , gray_line_width_spin_box_ {new QSpinBox {this}} -{ - setWindowTitle (windowTitle () + ' ' + tr (title)); - { - SettingsGroup g {settings_, title}; - restoreGeometry (settings_->value ("geometry", saveGeometry ()).toByteArray ()); - } - - QVBoxLayout * main_layout {new QVBoxLayout}; - - bands_table_->setRowCount (num_periods); - bands_table_->setVerticalScrollBarPolicy (Qt::ScrollBarAlwaysOff); - bands_table_->setHorizontalScrollBarPolicy (Qt::ScrollBarAlwaysOff); - bands_table_->setSizePolicy (QSizePolicy::Expanding, QSizePolicy::Expanding); - frequencies_changed (); - main_layout->addWidget (bands_table_); - // recalculate table when frequencies change - connect (configuration_->frequencies (), &QAbstractItemModel::layoutChanged - , this, &Dialog::frequencies_changed); - // handle changes by updating the underlying flags - connect (bands_table_.data (), &QTableWidget::itemChanged, [this] (QTableWidgetItem * item) { - auto band_number = item->data (band_index_role).toInt (); - bands_[item->row ()].setBit (band_number, Qt::Checked == item->checkState ()); - }); - - // set up the gray line duration spin box - gray_line_width_spin_box_->setRange (1, 60 * 2); - gray_line_width_spin_box_->setSuffix ("min"); - gray_line_width_spin_box_->setValue (*gray_line_duration_); - QFormLayout * form_layout = new QFormLayout; - form_layout->addRow (tr ("Gray time:"), gray_line_width_spin_box_); - connect (gray_line_width_spin_box_.data () - , static_cast (&QSpinBox::valueChanged) - , [this] (int new_value) {*gray_line_duration_ = new_value;}); - - QHBoxLayout * bottom_layout = new QHBoxLayout; - bottom_layout->addStretch (); - bottom_layout->addLayout (form_layout); - main_layout->addLayout (bottom_layout); - - setLayout (main_layout); -} - -Dialog::~Dialog () -{ - // do this here too because ESC or parent shutdown closing this - // window doesn't queue a close event - save_window_state (); -} - -void Dialog::closeEvent (QCloseEvent * e) -{ - save_window_state (); - QDialog::closeEvent (e); -} - -void Dialog::save_window_state () -{ - SettingsGroup g {settings_, title}; - settings_->setValue ("geometry", saveGeometry ()); -} - -void Dialog::frequencies_changed () -{ - bands_table_->setColumnCount (WSPR_bands_->size ()); - // set up and load the table of check boxes - for (auto row = 0u; row < num_periods; ++row) - { - auto vertical_header = new QTableWidgetItem {periods[row]}; - vertical_header->setTextAlignment (Qt::AlignRight | Qt::AlignVCenter); - bands_table_->setVerticalHeaderItem (row, vertical_header); - int column {0}; - int band_number {0}; - for (auto const& band : *configuration_->bands ()) - { - if (WSPR_bands_->contains (band)) - { - if (0 == row) - { - auto horizontal_header = new QTableWidgetItem {band}; - bands_table_->setHorizontalHeaderItem (column, horizontal_header); - } - auto item = new QTableWidgetItem; - item->setFlags (Qt::ItemIsUserCheckable | Qt::ItemIsEnabled); - item->setCheckState (bands_[row].testBit (band_number) ? Qt::Checked : Qt::Unchecked); - item->setData (band_index_role, band_number); - if (coordinated_bands.contains (band)) - { - item->setBackground (coord_background_brush_); - } - bands_table_->setItem (row, column, item); - ++column; - } - ++band_number; - } - } - bands_table_->resizeColumnsToContents (); - auto is_visible = isVisible (); - show (); - resize_to_maximum (); - adjustSize (); // fix the size - if (!is_visible) - { - hide (); - } -} - -// to get the dialog window exactly the right size to contain the -// widgets without needing scroll bars we need to measure the size of -// the table widget and set its minimum size to the measured size -void Dialog::resize_to_maximum () -{ - bands_table_->setMinimumSize ({ - bands_table_->horizontalHeader ()->length () - + bands_table_->verticalHeader ()->width () - + 2 * bands_table_->frameWidth () - , bands_table_->verticalHeader ()->length () - + bands_table_->horizontalHeader ()->height () - + 2 * bands_table_->frameWidth () - }); - bands_table_->setMaximumSize (bands_table_->minimumSize ()); -} - -class WSPRBandHopping::impl -{ -public: - using BandList = Dialog::BandList; - - impl (QSettings * settings, Configuration const * configuration, QWidget * parent_widget) - : settings_ {settings} - , configuration_ {configuration} - , tx_percent_ {0} - , parent_widget_ {parent_widget} - , last_was_tx_ {false} - , carry_ {false} - , seed_ {{rand (), rand (), rand (), rand (), rand (), rand (), rand (), rand ()}} - , gen_ {seed_} - , dist_ {1, 100} - { - auto num_bands = configuration_->bands ()->rowCount (); - for (auto& flags : bands_) - { - flags.resize (num_bands); - } - } - - bool simple_scheduler (); - - QSettings * settings_; - Configuration const * configuration_; - int tx_percent_; - BandList WSPR_bands_; - BandList rx_permutation_; - BandList tx_permutation_; - QWidget * parent_widget_; - - // 5 x 10 bit flags representing each hopping band in each period - // and tune - QBitArray bands_[num_periods]; - - int gray_line_duration_; - QPointer dialog_; - bool last_was_tx_; - bool carry_; - std::seed_seq seed_; - std::mt19937 gen_; - std::uniform_int_distribution dist_; -}; - -bool WSPRBandHopping::impl::simple_scheduler () -{ - auto tx = carry_ || tx_percent_ > dist_ (gen_); - if (carry_) - { - carry_ = false; - } - else if (tx_percent_ < 40 && last_was_tx_ && tx) - { - // if percentage is less than 40 then avoid consecutive tx but - // always catch up on the next round - tx = false; - carry_ = true; - } - last_was_tx_ = tx; - return tx; -} - -WSPRBandHopping::WSPRBandHopping (QSettings * settings, Configuration const * configuration, QWidget * parent_widget) - : m_ {settings, configuration, parent_widget} -{ -#if INCLUDE_ALL_MODES - // detect changes to the working frequencies model - m_->WSPR_bands_ = m_->configuration_->frequencies ()->all_bands (m_->configuration_->region (), Modes::WSPR).toList (); - connect (m_->configuration_->frequencies (), &QAbstractItemModel::layoutChanged - , [this] () { - m_->WSPR_bands_ = m_->configuration_->frequencies ()->all_bands (m_->configuration_->region (), Modes::WSPR).toList (); - }); -#endif - - // load settings - SettingsGroup g {m_->settings_, title}; - size_t size = m_->settings_->beginReadArray ("phases"); - for (auto i = 0u; i < size; ++i) - { - if (i < num_periods) - { - m_->settings_->setArrayIndex (i); - m_->bands_[i] = m_->settings_->value ("bands").toBitArray (); - } - } - m_->settings_->endArray (); - m_->gray_line_duration_ = m_->settings_->value ("GrayLineDuration", 60).toUInt (); -} - -WSPRBandHopping::~WSPRBandHopping () -{ - // save settings - SettingsGroup g {m_->settings_, title}; - m_->settings_->beginWriteArray ("phases"); - for (auto i = 0u; i < num_periods; ++i) - { - m_->settings_->setArrayIndex (i); - m_->settings_->setValue ("bands", m_->bands_[i]); - } - m_->settings_->endArray (); - m_->settings_->setValue ("GrayLineDuration", m_->gray_line_duration_); -} - -// pop up the maintenance dialog window -void WSPRBandHopping::show_dialog (bool /* checked */) -{ - if (!m_->dialog_) - { - m_->dialog_ = new Dialog {m_->settings_, m_->configuration_, &m_->WSPR_bands_, m_->bands_ - , &m_->gray_line_duration_, m_->parent_widget_}; - } - m_->dialog_->show (); - m_->dialog_->raise (); - m_->dialog_->activateWindow (); -} - -int WSPRBandHopping::tx_percent () const -{ - return m_->tx_percent_; -} - -void WSPRBandHopping::set_tx_percent (int new_value) -{ - m_->tx_percent_ = new_value; -} - -// determine the parameters of the hop, if any -auto WSPRBandHopping::next_hop (bool tx_enabled) -> Hop -{ - auto const& now = DriftingDateTime::currentDateTimeUtc (); - auto const& date = now.date (); - auto year = date.year (); - auto month = date.month (); - auto day = date.day (); - auto const& time = now.time (); - float uth = time.hour () + time.minute () / 60. - + (time.second () + .001 * time.msec ()) / 3600.; - auto my_grid = m_->configuration_->my_grid (); - int period_index; - int band_index; - int tx_next; - - my_grid = (my_grid + " ").left (6); // hopping doesn't like - // short grids - - // look up the period for this time - FC_grayline (&year, &month, &day, &uth, my_grid.toLatin1 ().constData () - , &m_->gray_line_duration_, &period_index - , my_grid.size ()); - - band_index = next_hopping_band(); - - tx_next = next_is_tx () && tx_enabled; - - int frequencies_index {-1}; - auto const& frequencies = m_->configuration_->frequencies (); - auto const& bands = m_->configuration_->bands (); - auto band_name = bands->data (bands->index (band_index + 3, 0)).toString (); - if (m_->bands_[period_index].testBit (band_index + 3) // +3 for - // coordinated bands - && m_->WSPR_bands_.contains (band_name)) - { - // here we have a band that has been enabled in the hopping - // matrix so check it it has a configured working frequency - frequencies_index = frequencies->best_working_frequency (band_name); - } - - // if we do not have a configured working frequency on the selected - // coordinated hopping band we next pick from a random permutation - // of the other enabled bands in the hopping bands matrix - if (frequencies_index < 0) - { - // build sets of available rx and tx bands - auto target_rx_bands = m_->WSPR_bands_.toSet (); - auto target_tx_bands = target_rx_bands; - for (auto i = 0; i < m_->bands_[period_index].size (); ++i) - { - auto const& band = bands->data (bands->index (i, 0)).toString (); - // remove bands that are not enabled for hopping in this phase - if (!m_->bands_[period_index].testBit (i)) - { - target_rx_bands.remove (band); - target_tx_bands.remove (band); - } - // remove rx only bands from transmit list and vice versa - if (m_->bands_[5].testBit (i)) - { - target_tx_bands.remove (band); - } - else - { - target_rx_bands.remove (band); - } - } - // if we have some bands to permute - if (target_rx_bands.size () + target_tx_bands.size ()) - { - if (!(m_->rx_permutation_.size () + m_->tx_permutation_.size ()) // all used up - // or rx list contains a band no longer scheduled - || !target_rx_bands.contains (m_->rx_permutation_.toSet ()) - // or tx list contains a band no longer scheduled for tx - || !target_tx_bands.contains (m_->tx_permutation_.toSet ())) - { - // build new random permutations - m_->rx_permutation_ = target_rx_bands.toList (); - std::random_shuffle (std::begin (m_->rx_permutation_), std::end (m_->rx_permutation_)); - m_->tx_permutation_ = target_tx_bands.toList (); - std::random_shuffle (std::begin (m_->tx_permutation_), std::end (m_->tx_permutation_)); - // qDebug () << "New random Rx permutation:" << m_->rx_permutation_ - // << "random Tx permutation:" << m_->tx_permutation_; - } - if ((tx_next && m_->tx_permutation_.size ()) || !m_->rx_permutation_.size ()) - { - Q_ASSERT (m_->tx_permutation_.size ()); - // use one from the current random tx permutation - band_name = m_->tx_permutation_.takeFirst (); - } - else - { - Q_ASSERT (m_->rx_permutation_.size ()); - // use one from the current random rx permutation - band_name = m_->rx_permutation_.takeFirst (); - } - // find the first WSPR working frequency for the chosen band - frequencies_index = frequencies->best_working_frequency (band_name); - if (frequencies_index >= 0) // should be a redundant check, - // but to be safe - { - // we can use the random choice - // qDebug () << "random:" << frequencies->data (frequencies->index (frequencies_index, FrequencyList_v2::frequency_column)).toString (); - band_index = bands->find (band_name); - if (band_index < 0) // this shouldn't happen - { - Q_ASSERT (band_index >= 0); - frequencies_index = -1; - } - } - } - } - else - { - band_index += 3; - // qDebug () << "scheduled:" << frequencies->data (frequencies->index (frequencies_index, FrequencyList_v2::frequency_column)).toString (); - // remove from random permutations to stop the coordinated bands - // getting too high a weighting - not perfect but surely helps - m_->rx_permutation_.removeOne (band_name); - m_->tx_permutation_.removeOne (band_name); - } - - return { - periods[period_index] - - , frequencies_index - - , frequencies_index >= 0 // new band - && tx_enabled // transmit is allowed - && !tx_next // not going to Tx anyway - && m_->bands_[4].testBit (band_index) // tune up required - && !m_->bands_[5].testBit (band_index) // not an Rx only band - - , frequencies_index >= 0 // new band - && tx_next // Tx scheduled - && !m_->bands_[5].testBit (band_index) // not an Rx only band - }; -} - -bool WSPRBandHopping::next_is_tx (bool simple_schedule) -{ - if (simple_schedule) - { - return m_->simple_scheduler (); - } - if (100 == m_->tx_percent_) - { - return true; - } - else - { - // consult scheduler to determine if next period should be a tx interval - return next_tx_state(m_->tx_percent_); - } -} diff --git a/WSPRBandHopping.hpp b/WSPRBandHopping.hpp deleted file mode 100644 index 7ee62ba..0000000 --- a/WSPRBandHopping.hpp +++ /dev/null @@ -1,84 +0,0 @@ -#ifndef WSPR_BAND_HOPPING_HPP__ -#define WSPR_BAND_HOPPING_HPP__ - -#include - -#include "pimpl_h.hpp" - -class QSettings; -class Configuration; -class QWidget; - -// -// WSPR Band Hopping Control -// -// WSPR specifies a globally coordinated band hopping schedule and -// this class implements that. -// -// Responsibilities -// -// Provides a maintenance dialog allowing the user to define which -// bands are allowed from the band hopping schedule as defined here: -// -// http://physics.princeton.edu/pulsar/K1JT/doc/wspr/wspr-main.html -// -// Along with selecting bands a flag indicating that a short tune up -// signal is required for specified bands before they are used for -// receive. -// -// Provides a Qt property that holds the Tx percentage which is used -// to generate a semi-randomized schedule of period to transmit. This -// schedule is random but adjusted to limit the number of consecutive -// transmission periods, it also adjusts the schedule to ensure that -// the overall number of transmission periods in any two hour hopping -// schedule reflects the percentage provided. -// -// Collaborations -// -// Settings including the selected bands with periods, the tune up -// flags and the gray line duration are maintained in persistent -// storage using the provided QSettings object instance. -// -// A passed in Configuration object instance is used to query the -// FrequencyList_v2 model to determine working frequencies for each -// band. The row index of this model is returned by this classes -// hopping scheduling method so it may be conveniently used to select -// a new working frequency by a client. -// -class WSPRBandHopping - : public QObject -{ - Q_OBJECT; - Q_PROPERTY (int tx_percent READ tx_percent WRITE set_tx_percent); - -public: - WSPRBandHopping (QSettings *, Configuration const *, QWidget * parent = nullptr); - ~WSPRBandHopping (); - - // display the band hopping maintenance dialog - Q_SLOT void show_dialog (bool); - - // Property tx_percent implementation - int tx_percent () const; - Q_SLOT void set_tx_percent (int); - - // structure that defines the results of the next_hop() method - struct Hop - { - QString period_name_; - int frequencies_index_; // may be -1 indicating no change - bool tune_required_; - bool tx_next_; - }; - // return the next band parameters - Hop next_hop (bool tx_enabled); - // determine if the next period should be a transmit period - bool next_is_tx (bool simple_schedule = false); - -private: - // implementation hidden from public interface - class impl; - pimpl m_; -}; - -#endif diff --git a/WsprTxScheduler.cpp b/WsprTxScheduler.cpp deleted file mode 100644 index 73469e8..0000000 --- a/WsprTxScheduler.cpp +++ /dev/null @@ -1,228 +0,0 @@ -#include -#include -#include -#include -#include - -namespace -{ - char tx[6][10]; - int tx_table_2hr_slot=-1, tx_table_pctx=0; -}; - -int tx_band_sum(char bsum[10]) -{ - int i,j; - - for (j=0; j<10; j++) { - bsum[j]=0; - for (i=0; i<6; i++) { - bsum[j]=bsum[j]+tx[i][j]; - } - } - return 1; -} - -int tx_add_to_band(int band) -{ - // add tx cycle to a band without regard to ntxlim - int i,islot; - for ( i=0; i<10; i++) { - islot=rand()%6; - if( tx[islot][band] != 1 ) { - tx[islot][band]=1; - return 1; - } - } - return 0; -} - -int tx_sum() -{ - int i,j,sum=0; - for (i=0; i<6; i++) { - for (j=0; j<10; j++) { - sum=sum+tx[i][j]; - } - } - return sum; -} - -int tx_add_one(char* tx) -{ - int i, j, txflag, ngap; - // adds one tx slot to an existing array without - // creating successive tx slots. - // try to fill largest gaps first - // try gap sizes of 13, 11, 9, 7, 5, and finally 3 - for (ngap=13; ngap>=3; ngap=ngap-2) { - for (i=0; i< 60-ngap; i++) { - txflag=0; - for (j=0; j ntxlim ) { - tx[i]=0; - nrun=0; - } - } else { - nrun=0; - } - } - sum=0; - for (i=0; i<60; i++) { - sum=sum+tx[i]; - } - return sum; -} - -void tx_print() -{ - int i,j; - for (i=0; i<6; i++) { - for (j=0; j<10; j++) { - if( (i*10+j)%10 == 0 && i>=0 ) printf("\n"); - printf("%d ",tx[i][j]); - } - } - printf("\n"); - fflush(stdout); -} - -int create_tx_schedule(int pctx) -{ - char bsum[10]; - int i, j, k, sum, ntxlim, ntxbandmin, needed; - int iflag, nrx; - float rxavg,x; - - needed=60*(pctx/100.0)+0.5; - - memset(tx,0,sizeof(char)*60); - - if( pctx == 0 ) return 0; - - if( pctx <= 25 ) { // Use K1JT's algorithm in this regime - rxavg=100.0/pctx-1.0; - i=0; - while(1) { - x=(rand()%100)/100.0; - nrx=(rxavg+3.0*x-1.0); //2-5 for 25% - i=i+nrx+1; - if( i < 60 ) { - tx[i/10][i%10]=1; - } else { - break; - } - } - return 0; - } else if( pctx > 25 && pctx < 33 ) { - ntxlim=1; - ntxbandmin=1; - } else if( pctx >= 33 && pctx < 50 ) { - ntxlim=1; - ntxbandmin=2; - } else if( pctx >= 50 && pctx < 60 ) { - ntxlim=2; - ntxbandmin=3; - } else { - ntxlim=3; - ntxbandmin=4; - } - - // when txpct>25% create a table that guarantees that all - // bands will be visited 1, 2, or 3 times, as appropriate. - // - // start by filling each band slot with ntxbandmin tx's - for (i=0; itm_hour; - int minute = ltm->tm_min; - - int tx_2hr_slot = hour/2; - int tx_20min_slot = (hour-tx_2hr_slot*2)*3 + minute/20; - int tx_2min_slot = (minute%20)/2; - - if( (tx_2hr_slot != tx_table_2hr_slot) || (tx_table_pctx != pctx) ) { - create_tx_schedule(pctx); - tx_table_2hr_slot = tx_2hr_slot; - tx_table_pctx = pctx; - } - -// tx_print(); - return tx[tx_20min_slot][tx_2min_slot]; -} - -int next_hopping_band() -{ - time_t now=time(0)+30; - tm *ltm = gmtime(&now); - int minute = ltm->tm_min; - int tx_2min_slot = (minute%20)/2; - return tx_2min_slot; -} diff --git a/WsprTxScheduler.h b/WsprTxScheduler.h deleted file mode 100644 index ccafd22..0000000 --- a/WsprTxScheduler.h +++ /dev/null @@ -1,7 +0,0 @@ -#ifndef WSPR_TX_SCHEDULER_H_ -#define WSPR_TX_SCHEDULER_H_ - -int next_tx_state (int pctx); -int next_hopping_band(); - -#endif diff --git a/js8call.pro b/js8call.pro index 727d2dc..5ff5b3e 100644 --- a/js8call.pro +++ b/js8call.pro @@ -61,10 +61,10 @@ SOURCES += \ Configuration.cpp psk_reporter.cpp AudioDevice.cpp \ Modulator.cpp Detector.cpp logqso.cpp displaytext.cpp \ getfile.cpp soundout.cpp soundin.cpp meterwidget.cpp signalmeter.cpp \ - WFPalette.cpp plotter.cpp widegraph.cpp about.cpp WsprTxScheduler.cpp mainwindow.cpp \ - main.cpp decodedtext.cpp wsprnet.cpp messageaveraging.cpp \ + WFPalette.cpp plotter.cpp widegraph.cpp about.cpp mainwindow.cpp \ + main.cpp decodedtext.cpp messageaveraging.cpp \ Modes.cpp \ - WSPRBandHopping.cpp MessageAggregator.cpp qt_helpers.cpp\ + MessageAggregator.cpp qt_helpers.cpp\ MultiSettings.cpp PhaseEqualizationDialog.cpp IARURegions.cpp MessageBox.cpp \ EqualizationToolsDialog.cpp \ varicode.cpp \ @@ -105,10 +105,10 @@ HEADERS += qt_helpers.hpp \ FrequencyLineEdit.hpp AudioDevice.hpp Detector.hpp Modulator.hpp psk_reporter.h \ Transceiver.hpp TransceiverBase.hpp TransceiverFactory.hpp PollingTransceiver.hpp \ EmulateSplitTransceiver.hpp DXLabSuiteCommanderTransceiver.hpp HamlibTransceiver.hpp \ - Configuration.hpp wsprnet.h signalmeter.h meterwidget.h \ + Configuration.hpp signalmeter.h meterwidget.h \ logbook/logbook.h logbook/countrydat.h logbook/countriesworked.h logbook/adif.h \ - messageaveraging.h Modes.hpp WSPRBandHopping.hpp \ - WsprTxScheduler.h MultiSettings.hpp PhaseEqualizationDialog.hpp \ + messageaveraging.h Modes.hpp \ + MultiSettings.hpp PhaseEqualizationDialog.hpp \ IARURegions.hpp MessageBox.hpp EqualizationToolsDialog.hpp \ qorderedmap.h \ varicode.h \ diff --git a/lib/addit.f90 b/lib/addit.f90 deleted file mode 100644 index 4808283..0000000 --- a/lib/addit.f90 +++ /dev/null @@ -1,83 +0,0 @@ -subroutine addit(itone,nfsample,nsym,nsps,ifreq,sig,dat) - - integer itone(nsym) - real dat(60*12000) - real*8 f,dt,twopi,phi,dphi,baud,fsample,freq,tsym,t - - tsym=nsps*1.d0/nfsample !Symbol duration - baud=1.d0/tsym - fsample=12000.d0 !Sample rate (Hz) - dt=1.d0/fsample !Sample interval (s) - twopi=8.d0*atan(1.d0) - dphi=0. - - iters=1 - if(nsym.eq.79) iters=2 - do iter=1,iters - f=ifreq - phi=0. - ntot=nsym*tsym/dt - k=12000 !Start audio at t = 1.0 s - t=0. - if(nsym.eq.79) k=12000 + (iter-1)*12000*30 !Special case for FT8 - isym0=-1 - do i=1,ntot - t=t+dt - isym=nint(t/tsym) + 1 - if(isym.ne.isym0) then - freq=f + itone(isym)*baud - dphi=twopi*freq*dt - isym0=isym - endif - phi=phi + dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - k=k+1 - dat(k)=dat(k) + sig*sin(xphi) - enddo - enddo - - return -end subroutine addit - -subroutine addcw(icw,ncw,ifreq,sig,dat) - - integer icw(ncw) - real dat(60*12000) - real s(60*12000) - real x(60*12000) - real y(60*12000) - real*8 dt,twopi,phi,dphi,fsample,tdit,t - - wpm=25.0 - nspd=nint(1.2*12000.0/wpm) - fsample=12000.d0 !Sample rate (Hz) - dt=1.d0/fsample !Sample interval (s) - tdit=nspd*dt - twopi=8.d0*atan(1.d0) - dphi=twopi*ifreq*dt - phi=0. - k=12000 !Start audio at t = 1.0 s - t=0. - npts=60*12000 - x=0. - do i=1,npts - t=t+dt - j=nint(t/tdit) + 1 - j=mod(j-1,ncw) + 1 - phi=phi + dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - k=k+1 - x(k)=icw(j) - s(k)=sin(xphi) - if(t.ge.59.5) exit - enddo - - nadd=0.004/dt - call smo(x,npts,y,nadd) - y=y/nadd - dat=dat + sig*y*s - - return -end subroutine addcw diff --git a/lib/afc65b.f90 b/lib/afc65b.f90 deleted file mode 100644 index 9599b68..0000000 --- a/lib/afc65b.f90 +++ /dev/null @@ -1,92 +0,0 @@ -subroutine afc65b(cx,npts,fsample,nflip,mode65,a,ccfbest,dtbest) - -! Find delta f, f1, f2 ==> a(1:3) - - complex cx(npts) - real a(5),deltaa(5) - - a=0. - i2=8*mode65 - i1=-i2 - j2=8*mode65 - j1=-j2 - ccfmax=0. - istep=2*mode65 - do iter=1,2 - do i=i1,i2,istep - a(1)=i - do j=j1,j2,istep - a(2)=j - chisq=fchisq65(cx,npts,fsample,nflip,a,ccf,dtmax) - if(ccf.gt.ccfmax) then - a1=a(1) - a2=a(2) - ccfmax=ccf - endif -! write(81,3081) istep,i1,i2,j1,j2,i,j,ccf,ccfmax,dtmax,a1,a2 -!3081 format(7i4,5f8.2) - enddo - enddo - i1=a1-istep - i2=a1+istep - j1=a2-istep - j2=a2+istep - istep=1 - enddo - -! a(1)=0. -! a(2)=0. - a(1)=a1 - a(2)=a2 - a(3)=0. - a(4)=0. - deltaa(1)=2.0*mode65 - deltaa(2)=2.0*mode65 - deltaa(3)=1.0 - nterms=2 !Maybe 2 is enough? - -! Start the iteration - chisqr=0. - chisqr0=1.e6 - do iter=1,100 !How many iters is enough? - do j=1,nterms - chisq1=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) - fn=0. - delta=deltaa(j) -10 a(j)=a(j)+delta - chisq2=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) - if(chisq2.eq.chisq1) go to 10 - if(chisq2.gt.chisq1) then - delta=-delta !Reverse direction - a(j)=a(j)+delta - tmp=chisq1 - chisq1=chisq2 - chisq2=tmp - endif -20 fn=fn+1.0 - a(j)=a(j)+delta - chisq3=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) - if(chisq3.lt.chisq2) then - chisq1=chisq2 - chisq2=chisq3 - go to 20 - endif - -! Find minimum of parabola defined by last three points - delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5) - a(j)=a(j)-delta - deltaa(j)=deltaa(j)*fn/3. -! write(*,4000) iter,j,a(1:2),-chisq2 -!4000 format(2i2,4f9.4) - enddo - chisqr=fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) - fdiff=chisqr/chisqr0-1.0 -! write(*,4000) 0,0,a(1:2),-chisqr,fdiff - if(abs(fdiff).lt.0.0001) exit - chisqr0=chisqr - enddo - ccfbest=ccfmax * (1378.125/fsample)**2 - dtbest=dtmax - - return -end subroutine afc65b diff --git a/lib/ana64.f90 b/lib/ana64.f90 deleted file mode 100644 index 5681ee1..0000000 --- a/lib/ana64.f90 +++ /dev/null @@ -1,24 +0,0 @@ -subroutine ana64(dd,npts,c0) - - use timer_module, only: timer - - parameter (NMAX=60*12000) !Max size of raw data at 12000 Hz - parameter (NSPS=3456) !Samples per symbol at 6000 Hz - parameter (NSPC=7*NSPS) !Samples per Costas array - real dd(NMAX) !Raw data - complex c0(0:720000) !Complex spectrum of dd() - save - - nfft1=672000 - nfft2=nfft1/2 - df1=12000.0/nfft1 - fac=2.0/nfft1 - c0(0:npts-1)=fac*dd(1:npts) - c0(npts:nfft1)=0. - call four2a(c0,nfft1,1,-1,1) !Forward c2c FFT - c0(nfft2/2+1:nfft2)=0. - c0(0)=0.5*c0(0) - call four2a(c0,nfft2,1,1,1) !Inverse c2c FFT; c0 is analytic sig - - return -end subroutine ana64 diff --git a/lib/avg4.f90 b/lib/avg4.f90 deleted file mode 100644 index fc37ec0..0000000 --- a/lib/avg4.f90 +++ /dev/null @@ -1,2 +0,0 @@ - ! The contents of this file have been migrated to lib/jt4_decode.f90 - diff --git a/lib/bpdecode144.f90 b/lib/bpdecode144.f90 deleted file mode 100644 index 8cbf912..0000000 --- a/lib/bpdecode144.f90 +++ /dev/null @@ -1,348 +0,0 @@ -subroutine pltanh(x,y) - isign=+1 - z=x - if( x.lt.0 ) then - isign=-1 - z=abs(x) - endif - if( z.le. 0.8 ) then - y=0.83*x - return - elseif( z.le. 1.6 ) then - y=isign*(0.322*z+0.4064) - return - elseif( z.le. 3.0 ) then - y=isign*(0.0524*z+0.8378) - return - elseif( z.lt. 7.0 ) then - y=isign*(0.0012*z+0.9914) - return - else - y=isign*0.9998 - return - endif -end subroutine pltanh - -subroutine platanh(x,y) - isign=+1 - z=x - if( x.lt.0 ) then - isign=-1 - z=abs(x) - endif - if( z.le. 0.664 ) then - y=x/0.83 - return - elseif( z.le. 0.9217 ) then - y=isign*(z-0.4064)/0.322 - return - elseif( z.le. 0.9951 ) then - y=isign*(z-0.8378)/0.0524 - return - elseif( z.le. 0.9998 ) then - y=isign*(z-0.9914)/0.0012 - return - else - y=isign*7.0 - return - endif -end subroutine platanh - -subroutine bpdecode144(llr,maxiterations,decoded,niterations) -! -! A log-domain belief propagation decoder for the msk144 code. -! The code is a regular (128,80) code with column weight 3 and row weight 8. -! k9an August, 2016 -! -integer, parameter:: N=128, K=80, M=N-K -integer*1 codeword(N),cw(N) -integer*1 colorder(N) -integer*1 decoded(K) -integer Nm(8,M) ! 8 bits per check -integer Mn(3,N) ! 3 checks per bit -integer synd(M) -real tov(3,N) ! single precision seems to be adequate in log-domain -real toc(8,M) -real tanhtoc(8,M) -real zn(N) -real llr(N) -real Tmn - -data colorder/0,1,2,3,4,5,6,7,8,9, & - 10,11,12,13,14,15,24,26,29,30, & - 32,43,44,47,60,77,79,97,101,111, & - 96,38,64,53,93,34,59,94,74,90, & - 108,123,85,57,70,25,69,62,48,49, & - 50,51,52,33,54,55,56,21,58,36, & - 16,61,23,63,20,65,66,67,68,46, & - 22,71,72,73,31,75,76,45,78,17, & - 80,81,82,83,84,42,86,87,88,89, & - 39,91,92,35,37,95,19,27,98,99, & - 100,28,102,103,104,105,106,107,40,109, & - 110,18,112,113,114,115,116,117,118,119, & - 120,121,122,41,124,125,126,127/ - -data Mn/ & - 1, 14, 38, & - 2, 4, 41, & - 3, 19, 39, & - 5, 29, 34, & - 6, 35, 40, & - 7, 20, 45, & - 8, 28, 48, & - 9, 22, 25, & - 10, 24, 36, & - 11, 12, 37, & - 13, 43, 44, & - 15, 18, 46, & - 16, 17, 47, & - 21, 32, 33, & - 23, 30, 31, & - 26, 27, 42, & - 1, 12, 46, & - 2, 36, 38, & - 3, 5, 10, & - 4, 9, 23, & - 6, 13, 39, & - 7, 15, 17, & - 8, 18, 27, & - 11, 33, 40, & - 14, 28, 44, & - 16, 29, 31, & - 19, 20, 22, & - 21, 30, 42, & - 24, 26, 47, & - 25, 37, 48, & - 32, 34, 45, & - 8, 35, 41, & - 12, 31, 43, & - 1, 19, 21, & - 2, 43, 45, & - 3, 4, 11, & - 5, 18, 33, & - 6, 25, 47, & - 7, 28, 30, & - 9, 14, 34, & - 10, 35, 42, & - 13, 15, 22, & - 16, 37, 38, & - 17, 41, 44, & - 20, 24, 29, & - 18, 23, 39, & - 12, 26, 32, & - 27, 38, 40, & - 15, 36, 48, & - 2, 30, 46, & - 1, 4, 13, & - 3, 28, 32, & - 5, 43, 47, & - 6, 34, 46, & - 7, 9, 40, & - 8, 11, 45, & - 10, 17, 23, & - 14, 31, 35, & - 16, 22, 42, & - 19, 37, 44, & - 20, 33, 48, & - 21, 24, 41, & - 25, 27, 29, & - 26, 39, 48, & - 19, 31, 36, & - 1, 5, 7, & - 2, 29, 39, & - 3, 16, 46, & - 4, 26, 37, & - 6, 28, 45, & - 8, 22, 33, & - 9, 21, 43, & - 10, 25, 38, & - 11, 14, 24, & - 12, 17, 40, & - 13, 27, 30, & - 15, 32, 35, & - 18, 44, 47, & - 20, 23, 36, & - 34, 41, 42, & - 1, 32, 48, & - 2, 3, 33, & - 4, 29, 42, & - 5, 14, 37, & - 6, 7, 36, & - 8, 9, 39, & - 10, 13, 19, & - 11, 18, 30, & - 12, 16, 20, & - 15, 29, 44, & - 17, 34, 38, & - 6, 21, 22, & - 23, 32, 40, & - 24, 27, 46, & - 25, 41, 45, & - 7, 26, 43, & - 28, 31, 47, & - 20, 35, 38, & - 1, 33, 41, & - 2, 42, 44, & - 3, 23, 48, & - 4, 31, 45, & - 5, 8, 30, & - 9, 16, 36, & - 10, 40, 47, & - 11, 17, 46, & - 12, 21, 34, & - 13, 24, 28, & - 14, 18, 43, & - 15, 25, 26, & - 19, 27, 35, & - 22, 37, 39, & - 1, 16, 18, & - 2, 6, 20, & - 3, 30, 43, & - 4, 28, 33, & - 5, 22, 23, & - 7, 39, 42, & - 8, 12, 38, & - 9, 35, 46, & - 10, 27, 32, & - 11, 15, 34, & - 13, 36, 37, & - 14, 41, 47, & - 17, 21, 25, & - 19, 29, 45, & - 24, 31, 48, & - 26, 40, 44/ - -data Nm/ & - 1, 17, 34, 51, 66, 81, 99, 113, & - 2, 18, 35, 50, 67, 82, 100, 114, & - 3, 19, 36, 52, 68, 82, 101, 115, & - 2, 20, 36, 51, 69, 83, 102, 116, & - 4, 19, 37, 53, 66, 84, 103, 117, & - 5, 21, 38, 54, 70, 85, 92, 114, & - 6, 22, 39, 55, 66, 85, 96, 118, & - 7, 23, 32, 56, 71, 86, 103, 119, & - 8, 20, 40, 55, 72, 86, 104, 120, & - 9, 19, 41, 57, 73, 87, 105, 121, & - 10, 24, 36, 56, 74, 88, 106, 122, & - 10, 17, 33, 47, 75, 89, 107, 119, & - 11, 21, 42, 51, 76, 87, 108, 123, & - 1, 25, 40, 58, 74, 84, 109, 124, & - 12, 22, 42, 49, 77, 90, 110, 122, & - 13, 26, 43, 59, 68, 89, 104, 113, & - 13, 22, 44, 57, 75, 91, 106, 125, & - 12, 23, 37, 46, 78, 88, 109, 113, & - 3, 27, 34, 60, 65, 87, 111, 126, & - 6, 27, 45, 61, 79, 89, 98, 114, & - 14, 28, 34, 62, 72, 92, 107, 125, & - 8, 27, 42, 59, 71, 92, 112, 117, & - 15, 20, 46, 57, 79, 93, 101, 117, & - 9, 29, 45, 62, 74, 94, 108, 127, & - 8, 30, 38, 63, 73, 95, 110, 125, & - 16, 29, 47, 64, 69, 96, 110, 128, & - 16, 23, 48, 63, 76, 94, 111, 121, & - 7, 25, 39, 52, 70, 97, 108, 116, & - 4, 26, 45, 63, 67, 83, 90, 126, & - 15, 28, 39, 50, 76, 88, 103, 115, & - 15, 26, 33, 58, 65, 97, 102, 127, & - 14, 31, 47, 52, 77, 81, 93, 121, & - 14, 24, 37, 61, 71, 82, 99, 116, & - 4, 31, 40, 54, 80, 91, 107, 122, & - 5, 32, 41, 58, 77, 98, 111, 120, & - 9, 18, 49, 65, 79, 85, 104, 123, & - 10, 30, 43, 60, 69, 84, 112, 123, & - 1, 18, 43, 48, 73, 91, 98, 119, & - 3, 21, 46, 64, 67, 86, 112, 118, & - 5, 24, 48, 55, 75, 93, 105, 128, & - 2, 32, 44, 62, 80, 95, 99, 124, & - 16, 28, 41, 59, 80, 83, 100, 118, & - 11, 33, 35, 53, 72, 96, 109, 115, & - 11, 25, 44, 60, 78, 90, 100, 128, & - 6, 31, 35, 56, 70, 95, 102, 126, & - 12, 17, 50, 54, 68, 94, 106, 120, & - 13, 29, 38, 53, 78, 97, 105, 124, & - 7, 30, 49, 61, 64, 81, 101, 127/ - -nrw=8 -ncw=3 - -toc=0 -tov=0 -tanhtoc=0 - -! initial messages to checks -do j=1,M - do i=1,nrw - toc(i,j)=llr((Nm(i,j))) - enddo -enddo - -ncnt=0 - -do iter=0,maxiterations - -! Update bit log likelihood ratios - do i=1,N - zn(i)=llr(i)+sum(tov(1:ncw,i)) - enddo - -! Check to see if we have a codeword - cw=0 - where( zn .gt. 0. ) cw=1 - ncheck=0 - do i=1,M - synd(i)=sum(cw(Nm(:,i))) - if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 - enddo - - if( ncheck .eq. 0 ) then ! we have a codeword - niterations=iter - codeword=cw(colorder+1) - decoded=codeword(M+1:N) - return - endif - - if( iter.gt.0 ) then ! this code block implements an early stopping criterion - nd=ncheck-nclast - if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased - ncnt=0 ! reset counter - else - ncnt=ncnt+1 - endif -! write(*,*) iter,ncheck,nd,ncnt - if( ncnt .ge. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) then - niterations=-1 - return - endif - endif - nclast=ncheck - -! Send messages from bits to check nodes - do j=1,M - do i=1,nrw - ibj=Nm(i,j) - toc(i,j)=zn(ibj) - do kk=1,ncw ! subtract off what the bit had received from the check - if( Mn(kk,ibj) .eq. j ) then ! Mn(3,128) - toc(i,j)=toc(i,j)-tov(kk,ibj) - endif - enddo - enddo - enddo - -! send messages from check nodes to variable nodes - do i=1,M - tanhtoc(1:nrw,i)=tanh(-toc(1:nrw,i)/2) - enddo - - do j=1,N - do i=1,ncw - ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j - Tmn=product(tanhtoc(:,ichk),mask=Nm(:,ichk).ne.j) - call platanh(-Tmn,y) - tov(i,j)=2*y - enddo - enddo - -enddo -niterations=-1 -end subroutine bpdecode144 diff --git a/lib/bpdecode40.f90 b/lib/bpdecode40.f90 deleted file mode 100644 index 3a35bab..0000000 --- a/lib/bpdecode40.f90 +++ /dev/null @@ -1,148 +0,0 @@ -subroutine bpdecode40(llr,maxiterations,decoded,niterations) -! -! A log-domain belief propagation decoder for the msk40 code. -! The code is a regular (32,16) code with column weight 3, row weights 5,6,7. -! k9an August, 2016 -! -integer, parameter:: N=32, K=16, M=N-K -integer*1 codeword(N),cw(N) -integer*1 colorder(N) -integer*1 decoded(K) -integer Nm(7,M) ! 5,6 or 7 bits per check -integer Mn(3,N) ! 3 checks per bit -integer synd(M) -real tov(3,N) -real toc(7,M) -real tanhtoc(7,M) -real zn(N) -real llr(N) -real Tmn -integer nrw(M) - -data colorder/ & - 4, 1, 2, 3, 0, 8, 6, 10, & - 13, 28, 20, 23, 17, 15, 27, 25, & - 16, 12, 18, 19, 7, 21, 22, 11, & - 24, 5, 26, 14, 9, 29, 30, 31/ - -data Mn/ & - 1, 6, 13, & - 2, 3, 14, & - 4, 8, 15, & - 5, 11, 12, & - 7, 10, 16, & - 6, 9, 15, & - 1, 11, 16, & - 2, 4, 5, & - 3, 7, 9, & - 8, 10, 12, & - 8, 13, 14, & - 1, 4, 12, & - 2, 6, 10, & - 3, 11, 15, & - 5, 9, 14, & - 7, 13, 15, & - 12, 14, 16, & - 1, 2, 8, & - 3, 5, 6, & - 4, 9, 11, & - 1, 7, 14, & - 5, 10, 13, & - 3, 4, 16, & - 2, 15, 16, & - 6, 7, 12, & - 7, 8, 11, & - 1, 9, 10, & - 2, 11, 13, & - 3, 12, 13, & - 4, 6, 14, & - 1, 5, 15, & - 8, 9, 16/ - -data Nm/ & -1, 7, 12, 18, 21, 27, 31, & -2, 8, 13, 18, 24, 28, 0, & -2, 9, 14, 19, 23, 29, 0, & -3, 8, 12, 20, 23, 30, 0, & -4, 8, 15, 19, 22, 31, 0, & -1, 6, 13, 19, 25, 30, 0, & -5, 9, 16, 21, 25, 26, 0, & -3, 10, 11, 18, 26, 32, 0, & -6, 9, 15, 20, 27, 32, 0,& -5, 10, 13, 22, 27, 0, 0, & -4, 7, 14, 20, 26, 28, 0, & -4, 10, 12, 17, 25, 29, 0, & -1, 11, 16, 22, 28, 29, 0, & -2, 11, 15, 17, 21, 30, 0, & -3, 6, 14, 16, 24, 31, 0, & -5, 7, 17, 23, 24, 32, 0/ - -data nrw/7,6,6,6,6,6,6,6,6,5,6,6,6,6,6,6/ - -ncw=3 - -toc=0 -tov=0 -tanhtoc=0 - -! initialize messages to checks -do j=1,M - do i=1,nrw(j) - toc(i,j)=llr((Nm(i,j))) - enddo -enddo - -do iter=0,maxiterations - -! Update bit log likelihood ratios (tov=0 in iteration 0). - do i=1,N - zn(i)=llr(i)+sum(tov(1:ncw,i)) - enddo - -! Check to see if we have a codeword (check before we do any iteration). - cw=0 - where( zn .gt. 0. ) cw=1 - ncheck=0 - do i=1,M - synd(i)=sum(cw(Nm(1:nrw(i),i))) - if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 - enddo - - if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it - niterations=iter - codeword=cw(colorder+1) - decoded=codeword(M+1:N) - return - endif - -! Send messages from bits to check nodes - do j=1,M - do i=1,nrw(j) - ibj=Nm(i,j) - toc(i,j)=zn(ibj) - do kk=1,ncw ! subtract off what the bit had received from the check - if( Mn(kk,ibj) .eq. j ) then - toc(i,j)=toc(i,j)-tov(kk,ibj) - endif - enddo - enddo - enddo - -! send messages from check nodes to variable nodes - do i=1,M - tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2) - enddo - - do j=1,N - do i=1,ncw - ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j - Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j) - call platanh(-Tmn,y) - tov(i,j)=2*y - enddo - enddo - -enddo -niterations=-1 -return -end subroutine bpdecode40 diff --git a/lib/ccf65.f90 b/lib/ccf65.f90 deleted file mode 100644 index 9e667df..0000000 --- a/lib/ccf65.f90 +++ /dev/null @@ -1,117 +0,0 @@ -subroutine ccf65(ss,nhsym,ssmax,sync1,dt1,flipk,syncshort,snr2,dt2) - - parameter (NFFT=512,NH=NFFT/2) - real ss(322) !Input: half-symbol normalized powers - real s(NFFT) !CCF = ss*pr - complex cs(0:NH) !Complex FT of s - real s2(NFFT) !CCF = ss*pr2 - complex cs2(0:NH) !Complex FT of s2 - real pr(NFFT) !JT65 pseudo-random sync pattern - complex cpr(0:NH) !Complex FT of pr - real pr2(NFFT) !JT65 shorthand pattern - complex cpr2(0:NH) !Complex FT of pr2 - real tmp1(322) - real ccf(-11:54) - logical first - integer npr(126) - data first/.true./ - equivalence (s,cs),(pr,cpr),(s2,cs2),(pr2,cpr2) - save - -! The JT65 pseudo-random sync pattern: - data npr/ & - 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & - 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & - 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & - 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & - 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & - 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & - 1,1,1,1,1,1/ - - if(first) then -! Initialize pr, pr2; compute cpr, cpr2. - fac=1.0/NFFT - do i=1,NFFT - pr(i)=0. - pr2(i)=0. - k=2*mod((i-1)/8,2)-1 - if(i.le.NH) pr2(i)=fac*k - enddo - do i=1,126 - j=2*i - pr(j)=fac*(2*npr(i)-1) -! Not sure why, but it works significantly better without the following line: -! pr(j-1)=pr(j) - enddo - call four2a(cpr,NFFT,1,-1,0) - call four2a(cpr2,NFFT,1,-1,0) - first=.false. - endif - -! Look for JT65 sync pattern and shorthand square-wave pattern. - ccfbest=0. - ccfbest2=0. - do i=1,nhsym-1 - s(i)=min(ssmax,ss(i)+ss(i+1)) -! s(i)=ss(i)+ss(i+1) - enddo - - call pctile(s,nhsym-1,50,base) - s(1:nhsym-1)=s(1:nhsym-1)-base - s(nhsym:NFFT)=0. - call four2a(cs,NFFT,1,-1,0) !Real-to-complex FFT - do i=0,NH -! cs2(i)=cs(i)*conjg(cpr2(i)) !Mult by complex FFT of pr2 - cs(i)=cs(i)*conjg(cpr(i)) !Mult by complex FFT of pr - enddo - call four2a(cs,NFFT,1,1,-1) !Complex-to-real inv-FFT -! call four2a(cs2,NFFT,1,1,-1) !Complex-to-real inv-FFT - - do lag=-11,54 !Check for best JT65 sync - j=lag - if(j.lt.1) j=j+NFFT - ccf(lag)=s(j) -! if(abs(ccf(lag)).gt.ccfbest) then - if(ccf(lag).gt.ccfbest) then !No inverted sync for use at HF -! ccfbest=abs(ccf(lag)) - ccfbest=ccf(lag) - lagpk=lag - flipk=1.0 -! if(ccf(lag).lt.0.0) flipk=-1.0 - endif - enddo - -! do lag=-11,54 !Check for best shorthand -! ccf2=s2(lag+28) -! if(ccf2.gt.ccfbest2) then -! ccfbest2=ccf2 -! lagpk2=lag -! endif -! enddo - -! Find rms level on baseline of "ccfblue", for normalization. - sum=0. - do lag=-11,54 - if(abs(lag-lagpk).gt.1) sum=sum + ccf(lag) - enddo - base=sum/50.0 - sq=0. - do lag=-11,54 - if(abs(lag-lagpk).gt.1) sq=sq + (ccf(lag)-base)**2 - enddo - rms=sqrt(sq/49.0) - sync1=ccfbest/rms - 4.0 - dt1=lagpk*(2048.0/11025.0) - 2.5 - -! Find base level for normalizing snr2. - do i=1,nhsym - tmp1(i)=ss(i) - enddo - call pctile(tmp1,nhsym,40,base) - snr2=0.398107*ccfbest2/base !### empirical - syncshort=0.5*ccfbest2/rms - 4.0 !### better normalizer than rms? -! dt2=(2.5 + lagpk2*(2048.0/11025.0)) - dt2=0. - - return -end subroutine ccf65 diff --git a/lib/chkss2.f90 b/lib/chkss2.f90 deleted file mode 100644 index ad52c66..0000000 --- a/lib/chkss2.f90 +++ /dev/null @@ -1,20 +0,0 @@ -subroutine chkss2(ss2,freq,drift,schk) - - real ss2(0:8,85) - real s(0:8,85) - include 'jt9sync.f90' - - ave=sum(ss2)/(9*85) - if(freq+drift.eq.-999999.0) ave=0. !To silence compiler warning - s=ss2/ave-1.0 - - s1=0. - do i=1,16 - j=ii(i) - if(j.le.85) s1=s1 + s(0,j) - enddo - schk=s1/16.0 - - return -end subroutine chkss2 - diff --git a/lib/contest72.f90 b/lib/contest72.f90 deleted file mode 100644 index 4b8df25..0000000 --- a/lib/contest72.f90 +++ /dev/null @@ -1,89 +0,0 @@ -program contest72 - - use packjt - integer dat(12) - logical text,bcontest,ok - character*22 msg,msg0,msg1 - character*72 ct1,ct2 - character*12 callsign1,callsign2 - character*1 c0 - character*42 c - character*6 mygrid - data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/ - data bcontest/.true./ - data mygrid/"EM48 "/ - -! itype Message Type -!-------------------- -! 1 Standardd message -! 2 Type 1 prefix -! 3 Type 1 suffix -! 4 Type 2 prefix -! 5 Type 2 suffix -! 6 Free text -! -1 Does not decode correctly - - nargs=iargc() - if(nargs.eq.0) open(10,file='contest_msgs.txt',status='old') - - nn=0 - do imsg=1,9999 - if(nargs.eq.1) then - if(imsg.gt.1) exit - call getarg(1,msg0) - else - read(10,1001,end=999) msg0 -1001 format(a22) - endif - msg=msg0 - call packmsg(msg,dat,itype,bcontest) - call unpackmsg(dat,msg1,bcontest,mygrid) - ok=msg1.eq.msg0 - if(msg0.eq.' ') then - write(*,1002) - else - if(jt_c2(1:1).eq.'W') msg0=' '//msg0(1:20) - nn=nn+1 - write(*,1002) nn,msg0,ok,jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2 -1002 format(i1,'. ',a22,L2,i2,2i10,i6,2i8) - if(index(msg1,' 73 ').gt.4) nn=0 - endif - if(.not.ok) print*,msg0,msg1 - if(itype.lt.0 .or. itype.eq.6) cycle - - if(msg(1:3).eq.'CQ ') then - m=2 - write(ct1,1010) dat -1010 format(12b6.6) -! write(*,1014) ct1 -!1014 format(a72) - cycle - endif - - i1=index(msg,'<') - if(i1.eq.1) then - m=0 - cycle - endif - - if(i.ge.5) then - m=3 - cycle - endif - - if(msg(1:6).eq.'73 CQ ') then - m=4 - cycle - endif - - call packmsg(msg,dat,itype,.false.) - write(ct1,1010) dat - call packtext(msg,nc1,nc2,ng,.false.,'') -! write(ct2,1012) nc1,nc2,ng+32768 -!1012 format(2b28.28,b16.16) -! write(*,1014) ct1 -! write(*,1014) ct2 -! write(*,1014) - enddo - -999 end program contest72 diff --git a/lib/decode4.f90 b/lib/decode4.f90 deleted file mode 100644 index e0596ed..0000000 --- a/lib/decode4.f90 +++ /dev/null @@ -1,112 +0,0 @@ -subroutine decode4(dat,npts,dtx,nfreq,flip,mode4,ndepth,neme,minw, & - mycall,hiscall,hisgrid,decoded,nfano,deepbest,qbest,ichbest) - -! Decodes JT4 data, assuming that DT and DF have already been determined. -! Input dat(npts) has already been downsampled by 2: rate = 11025/2. -! ### NB: this initial downsampling should be removed in WSJT-X, since -! it restricts the useful bandwidth to < 2.7 kHz. - - use jt4 - real dat(npts) !Raw data - character decoded*22,deepmsg*22,deepbest*22 - character*12 mycall,hiscall - character*6 hisgrid - real*8 dt,df,phi,f0,dphi,twopi,phi1,dphi1 - complex*16 cz,cz1,c0,c1 - real*4 sym(207) - - twopi=8*atan(1.d0) - dt=2.d0/11025 !Sample interval (2x downsampled data) - df=11025.d0/2520.d0 !Tone separation for JT4A mode - nsym=206 - amp=15.0 - istart=nint((dtx+0.8)/dt) !Start index for synced FFTs - if(istart.lt.0) istart=0 - nchips=0 - qbest=0. - qtop=0. - deepmsg=' ' - ichbest=-1 - c0=0. - k=istart - phi=0.d0 - phi1=0.d0 - - ich1=minw+1 - do ich=1,7 - if(nch(ich).le.mode4) ich2=ich - enddo - - do ich=ich1,ich2 - nchips=min(nch(ich),70) - nspchip=1260/nchips - k=istart - phi=0.d0 - phi1=0.d0 - fac2=1.e-8 * sqrt(float(mode4)) - do j=1,nsym+1 - if(flip.gt.0.0) then - f0=nfreq + (npr(j))*mode4*df - f1=nfreq + (2+npr(j))*mode4*df - else - f0=nfreq + (1-npr(j))*mode4*df - f1=nfreq + (3-npr(j))*mode4*df - endif - dphi=twopi*dt*f0 - dphi1=twopi*dt*f1 - sq0=0. - sq1=0. - do nc=1,nchips - phi=0.d0 - phi1=0.d0 - c0=0. - c1=0. - do i=1,nspchip - k=k+1 - phi=phi+dphi - phi1=phi1+dphi1 - cz=dcmplx(cos(phi),-sin(phi)) - cz1=dcmplx(cos(phi1),-sin(phi1)) - if(k.le.npts) then - c0=c0 + dat(k)*cz - c1=c1 + dat(k)*cz1 - endif - enddo - sq0=sq0 + real(c0)**2 + aimag(c0)**2 - sq1=sq1 + real(c1)**2 + aimag(c1)**2 - enddo - sq0=fac2*sq0 - sq1=fac2*sq1 - rsym=amp*(sq1-sq0) - if(j.ge.1) then - rsymbol(j,ich)=rsym - sym(j)=rsym - endif - enddo - - call extract4(sym,ncount,decoded) !Do the convolutional decode - nfano=0 - if(ncount.ge.0) then - nfano=1 - ichbest=ich - exit - endif - - qual=0. !Now try deep search -! if(ndepth.ge.1) then - if(iand(ndepth,32).eq.32) then - call deep4(sym(2),neme,flip,mycall,hiscall,hisgrid,deepmsg,qual) - if(qual.gt.qbest) then - qbest=qual - deepbest=deepmsg - ichbest=ich - endif - endif - enddo - if(qbest.gt.qtop) then - qtop=qbest - endif - qual=qbest - - return -end subroutine decode4 diff --git a/lib/decode65a.f90 b/lib/decode65a.f90 deleted file mode 100644 index c41136a..0000000 --- a/lib/decode65a.f90 +++ /dev/null @@ -1,160 +0,0 @@ -subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,ntrials, & - naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, & - ljt65apon, nexp_decode, & - bVHF,sync2,a,dt,nft,nspecial,qual,nhist,nsmo,decoded) - -! Apply AFC corrections to a candidate JT65 signal, then decode it. - - use jt65_mod - use timer_module, only: timer - - parameter (NMAX=60*12000) !Samples per 60 s - real*4 dd(NMAX) !92 MB: raw data from Linrad timf2 - complex cx(NMAX/8) !Data at 1378.125 sps - complex cx1(NMAX/8) !Data at 1378.125 sps, offset by 355.3 Hz - complex c5x(NMAX/32) !Data at 344.53125 Hz - complex c5a(512) - real s2(66,126) - real a(5) - logical bVHF,first,ljt65apon - character decoded*22,decoded_best*22 - character mycall*12,hiscall*12,hisgrid*6 - character*27 cr - data first/.true./,jjjmin/1000/,jjjmax/-1000/,cr/'(C) 2016, Joe Taylor - K1JT'/ - save - -! Mix sync tone to baseband, low-pass filter, downsample to 1378.125 Hz - call timer('filbig ',0) - call filbig(dd,npts,f0,newdat,cx,n5,sq0) - if(mode65.eq.4) call filbig(dd,npts,f0+355.297852,newdat,cx1,n5,sq0) - call timer('filbig ',1) -! NB: cx has sample rate 12000*77125/672000 = 1378.125 Hz - -! Check for a shorthand message - if(bVHF .and. mode65.ne.101) then - call sh65(cx,n5,mode65,ntol,xdf,nspecial,sync2) - if(nspecial.gt.0) then - a=0. - a(1)=xdf - nflip=0 - endif - endif - if(nflip.eq.0) go to 900 - -! Find best DF, drift, curvature, and DT. Start by downsampling to 344.53125 Hz - call timer('fil6521 ',0) - call fil6521(cx,n5,c5x,n6) - call timer('fil6521 ',1) - - fsample=1378.125/4. - - call timer('afc65b ',0) -! Best fit for DF, drift, and dt. fsample = 344.53125 S/s - dtbest=dt - call afc65b(c5x,n6,fsample,nflip,mode65,a,ccfbest,dtbest) - call timer('afc65b ',1) - dtbest=dtbest+0.003628 !Remove decimation filter and coh. integrator delay - dt=dtbest !Return new, improved estimate of dt - sync2=3.7e-4*ccfbest/sq0 !Constant is empirical - if(mode65.eq.4) cx=cx1 - -! Apply AFC corrections to the time-domain signal -! Now we are back to using the 1378.125 Hz sample rate, enough to -! accommodate the full JT65C bandwidth. - a(3)=0 - call timer('twkfreq ',0) - call twkfreq65(cx,n5,a) - call timer('twkfreq ',1) - -! Compute spectrum for each symbol. - nsym=126 - nfft=512 - df=1378.125/nfft - j=int(dtbest*1378.125) - - call timer('sh_ffts ',0) - c5a=cmplx(0.0,0.0) - do k=1,nsym - do i=1,nfft - j=j+1 - if(j.ge.1 .and. j.le.NMAX/8) then - c5a(i)=cx(j) - else - c5a(i)=0. - endif - enddo - call four2a(c5a,nfft,1,1,1) - do i=1,512 - jj=i - if(i.gt.256) jj=i-512 - s1(jj,k)=real(c5a(i))**2 + aimag(c5a(i))**2 - enddo - enddo - call timer('sh_ffts ',1) - - call timer('dec65b ',0) - qualbest=0. - qual0=-1.e30 - minsmo=0 - maxsmo=0 - if(mode65.ge.2 .and. mode65.ne.101) then - minsmo=nint(width/df)-1 - maxsmo=2*nint(width/df) - endif - nn=0 - do ismo=minsmo,maxsmo - if(ismo.gt.0) then - do j=1,126 - call smo121(s1(-255,j),512) - if(j.eq.1) nn=nn+1 - if(nn.ge.4) then - call smo121(s1(-255,j),512) - if(j.eq.1) nn=nn+1 - endif - enddo - endif - - do i=1,66 - jj=i - if(mode65.eq.2) jj=2*i-1 - if(mode65.eq.4) then - ff=4*(i-1)*df - 355.297852 - jj=nint(ff/df)+1 - endif - s2(i,1:126)=s1(jj,1:126) - enddo - nadd=ismo !### ??? ### - call decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, & - mycall,hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode, & - nqd,nft,qual, & - nhist,decoded) - - if(nft.eq.1) then - nsmo=ismo - param(9)=nsmo - nsum=1 - exit - else if(nft.eq.2) then - if(qual.gt.qualbest) then - decoded_best=decoded - qualbest=qual - nnbest=nn - nsmobest=ismo - endif - endif - if(qual.lt.qual0) exit - qual0=qual - enddo - - if(nft.eq.2) then - decoded=decoded_best - qual=qualbest - nsmo=nsmobest - param(9)=nsmo - nn=nnbest - endif - - call timer('dec65b ',1) - -900 return -end subroutine decode65a diff --git a/lib/decode65b.f90 b/lib/decode65b.f90 deleted file mode 100644 index 215b6ba..0000000 --- a/lib/decode65b.f90 +++ /dev/null @@ -1,37 +0,0 @@ -subroutine decode65b(s2,nflip,nadd,mode65,ntrials,naggressive,ndepth, & - mycall,hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode,nqd, & - nft,qual, & - nhist,decoded) - - use jt65_mod - real s2(66,126) - real s3(64,63) - logical ltext,ljt65apon - character decoded*22 - character mycall*12,hiscall*12,hisgrid*6 - save - - if(nqd.eq.-99) stop !Silence compiler warning - do j=1,63 - k=mdat(j) !Points to data symbol - if(nflip.lt.0) k=mdat2(j) - do i=1,64 - s3(i,j)=s2(i+2,k) - enddo - enddo - - call extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, & - hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode,ncount, & - nhist,decoded,ltext,nft,qual) - -! Suppress "birdie messages" and other garbage decodes: - if(decoded(1:7).eq.'000AAA ') ncount=-1 - if(decoded(1:7).eq.'0L6MWK ') ncount=-1 - if(nflip.lt.0 .and. ltext) ncount=-1 - if(ncount.lt.0) then - nft=0 - decoded=' ' - endif - - return -end subroutine decode65b diff --git a/lib/decode9w.f90 b/lib/decode9w.f90 deleted file mode 100644 index 2c043c7..0000000 --- a/lib/decode9w.f90 +++ /dev/null @@ -1,67 +0,0 @@ -subroutine decode9w(nfqso,ntol,nsubmode,ss,id2,sync,nsnr,xdt1,f0,decoded) - -! Decode a weak signal in a wide/slow JT9 submode. - - parameter (NSMAX=6827,NZMAX=60*12000) - real ss(184,NSMAX) !Symbol spectra at 1/2-symbol steps - real ccfred(NSMAX) !Best sync vs frequency - real ccfblue(-9:18) !Sync vs time at best frequency - real a(5) !Fitted Lorentzian params - integer*2 id2(NZMAX) !Raw 16-bit data - integer*1 i1SoftSymbols(207) !Binary soft symbols - character*22 decoded !Decoded message - - df=12000.0/16384.0 !Bin spacing in ss() - nsps=6912 !Samples per 9-FSK symbol - tstep=nsps*0.5/12000.0 !Half-symbol duration - npts=52*12000 - limit=10000 !Fano timeout parameter - - ia=max(1,nint((nfqso-ntol)/df)) !Start frequency bin - ib=min(NSMAX,nint((nfqso+ntol)/df)) !End frequency bin - lag1=-int(2.5/tstep + 0.9999) !Start lag - lag2=int(5.0/tstep + 0.9999) !End lag - nhsym=184 !Number of half-symbols - -! First sync pass finds approximate Doppler spread; second pass does a -! good Lorentzian fit to determine frequency f0. - do iter=1,2 - nadd=3 - if(iter.eq.2) nadd=2*nint(0.375*a(4)) + 1 - call sync9w(ss,nhsym,lag1,lag2,ia,ib,ccfred,ccfblue,ipk,lagpk,nadd) - s=0. - sq=0. - ns=0 - do i=-9,18 - if(abs(i-lagpk).gt.3) then - s=s+ccfblue(i) - sq=sq+ccfblue(i)**2 - ns=ns+1 - endif - enddo - base=s/ns - rms=sqrt(sq/ns - base**2) - sync=(ccfblue(lagpk)-base)/rms - xdt0=lagpk*tstep - call lorentzian(ccfred(ia),ib-ia+1,a) - f0=(ia+a(3))*df - enddo - ccfblue=(ccfblue-base)/rms - - call softsym9w(id2,npts,xdt0,f0,a(4)*df,nsubmode,xdt1-1.05,snrdb,i1softsymbols) - nsnr=nint(snrdb) - call jt9fano(i1softsymbols,limit,nlim,decoded) - -!### -! do i=-9,18 -! write(81,3081) i,ccfblue(i) -!3081 format(i3,f10.3) -! enddo -! do i=1,NSMAX -! write(82,3082) i*df,ccfred(i) -!3082 format(f10.1,e12.3) -! enddo -!### - - return -end subroutine decode9w diff --git a/lib/demod64a.f90 b/lib/demod64a.f90 deleted file mode 100644 index b1176ef..0000000 --- a/lib/demod64a.f90 +++ /dev/null @@ -1,61 +0,0 @@ -subroutine demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) - -! Demodulate the 64-bin spectra for each of 63 symbols in a frame. - -! Parameters -! nadd number of spectra already summed -! mrsym most reliable symbol value -! mr2sym second most likely symbol value -! mrprob probability that mrsym was the transmitted value -! mr2prob probability that mr2sym was the transmitted value - - implicit real*8 (a-h,o-z) - real*4 s3(64,63),afac1 - integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63) - - if(nadd.eq.-999) return - afac=afac1 * float(nadd)**0.64 - scale=255.999 - -! Compute average spectral value - ave=sum(s3)/(64.*63.) - i1=1 !Silence warning - i2=1 - -! Compute probabilities for most reliable symbol values - do j=1,63 - s1=-1.e30 - psum=0. - do i=1,64 - x=min(afac*s3(i,j)/ave,50.d0) - psum=psum+s3(i,j) - if(s3(i,j).gt.s1) then - s1=s3(i,j) - i1=i !Most reliable - endif - enddo - if(psum.eq.0.0) psum=1.e-6 - - s2=-1.e30 - do i=1,64 - if(i.ne.i1 .and. s3(i,j).gt.s2) then - s2=s3(i,j) - i2=i !Second most reliable - endif - enddo - p1=s1/psum !Symbol metrics for ftrsd - p2=s2/psum - mrsym(j)=i1-1 - mr2sym(j)=i2-1 - mrprob(j)=scale*p1 - mr2prob(j)=scale*p2 - enddo - - nlow=0 - do j=1,63 - if(mrprob(j).le.5) nlow=nlow+1 - enddo - ntest=sum(mrprob) - - return -end subroutine demod64a diff --git a/lib/downsam9.f90 b/lib/downsam9.f90 deleted file mode 100644 index 7cd1962..0000000 --- a/lib/downsam9.f90 +++ /dev/null @@ -1,88 +0,0 @@ -subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2) - -!Downsample from id2() into c2() so as to yield nspsd samples per symbol, -!mixing from fpk down to zero frequency. The downsample factor is 432. - - use, intrinsic :: iso_c_binding - use FFTW3 - use timer_module, only: timer - - include 'constants.f90' - integer(C_SIZE_T) NMAX1 - parameter (NMAX1=653184) - parameter (NFFT1=653184,NFFT2=1512) - type(C_PTR) :: plan !Pointers plan for big FFT - integer*2 id2(0:8*npts8-1) - logical, intent(inout) :: newdat - real*4, pointer :: x1(:) - complex c1(0:NFFT1/2) - complex c2(0:NFFT2-1) - real s(5000) - logical first - common/patience/npatience,nthreads - data first/.true./ - save plan,first,c1,s,x1 - - df1=12000.0/NFFT1 - npts=8*npts8 - if(npts.gt.NFFT1) npts=NFFT1 !### Fix! ### - - if(first) then - nflags=FFTW_ESTIMATE - if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT - if(npatience.eq.2) nflags=FFTW_MEASURE - if(npatience.eq.3) nflags=FFTW_PATIENT - if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE -! Plan the FFTs just once - - !$omp critical(fftw) ! serialize non thread-safe FFTW3 calls - plan=fftwf_alloc_real(NMAX1) - call c_f_pointer(plan,x1,[NMAX1]) - x1(0:NMAX1-1) => x1 !remap bounds - call fftwf_plan_with_nthreads(nthreads) - plan=fftwf_plan_dft_r2c_1d(NFFT1,x1,c1,nflags) - call fftwf_plan_with_nthreads(1) - !$omp end critical(fftw) - - first=.false. - endif - - if(newdat) then - x1(0:npts-1)=id2(0:npts-1) - x1(npts:NFFT1-1)=0. !Zero the rest of x1 - call timer('FFTbig9 ',0) - call fftwf_execute_dft_r2c(plan,x1,c1) - call timer('FFTbig9 ',1) - - nadd=int(1.0/df1) - s=0. - do i=1,5000 - j=int((i-1)/df1) - do n=1,nadd - j=j+1 - s(i)=s(i)+real(c1(j))**2 + aimag(c1(j))**2 - enddo - enddo - newdat=.false. - endif - - ndown=8*nsps8/nspsd !Downsample factor = 432 - nh2=NFFT2/2 - nf=nint(fpk) - i0=int(fpk/df1) - - nw=100 - ia=max(1,nf-nw) - ib=min(5000,nf+nw) - call pctile(s(ia),ib-ia+1,40,avenoise) - - fac=sqrt(1.0/avenoise) - do i=0,NFFT2-1 - j=i0+i - if(i.gt.nh2) j=j-NFFT2 - c2(i)=fac*c1(j) - enddo - call four2a(c2,NFFT2,1,1,1) !FFT back to time domain - - return -end subroutine downsam9 diff --git a/lib/encode232.f90 b/lib/encode232.f90 deleted file mode 100644 index 491f204..0000000 --- a/lib/encode232.f90 +++ /dev/null @@ -1,33 +0,0 @@ -subroutine encode232(dat,nsym,symbol) - -! Convolutional encoder for a K=32, r=1/2 code. - - integer*1 dat(13) !User data, packed 8 bits per byte - integer*1 symbol(206) !Channel symbols, one bit per byte - integer*1 i1 - include 'conv232.f90' - - nstate=0 - k=0 - do j=1,nsym - do i=7,0,-1 - i1=dat(j) - i4=i1 - if (i4.lt.0) i4=i4+256 - nstate=ior(ishft(nstate,1),iand(ishft(i4,-i),1)) - n=iand(nstate,npoly1) - n=ieor(n,ishft(n,-16)) - k=k+1 - symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255)) - n=iand(nstate,npoly2) - n=ieor(n,ishft(n,-16)) - k=k+1 - symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255)) - if(k.ge.nsym) go to 100 - enddo - enddo - -100 continue - - return -end subroutine encode232 diff --git a/lib/encode4.f90 b/lib/encode4.f90 deleted file mode 100644 index 4e73699..0000000 --- a/lib/encode4.f90 +++ /dev/null @@ -1,20 +0,0 @@ -subroutine encode4(message,ncode) - - use packjt - parameter (MAXCALLS=7000,MAXRPT=63) - integer ncode(206) - character*22 message !Message to be generated - character*3 cok !' ' or 'OOO' - integer dgen(13) - integer*1 data0(13),symbol(216) - - call chkmsg(message,cok,nspecial,flip) - call packmsg(message,dgen,itype,.false.) !Pack 72-bit message into 12 six-bit symbols - call entail(dgen,data0) - call encode232(data0,206,symbol) !Convolutional encoding - call interleave4(symbol,1) !Apply JT4 interleaving - do i=1,206 - ncode(i)=symbol(i) - enddo - -end subroutine encode4 diff --git a/lib/encode_msk144.f90 b/lib/encode_msk144.f90 deleted file mode 100644 index 4e4d896..0000000 --- a/lib/encode_msk144.f90 +++ /dev/null @@ -1,111 +0,0 @@ -subroutine encode_msk144(message,codeword) -! Encode an 80-bit message and return a 128-bit codeword. -! The generator matrix has dimensions (48,80). -! The code is a (128,80) regular ldpc code with column weight 3. -! The code was generated using the PEG algorithm. -! After creating the codeword, the columns are re-ordered according to -! "colorder" to make the codeword compatible with the parity-check -! matrix stored in Radford Neal's "pchk" format. -! -character*20 g(48) -integer*1 codeword(128) -integer*1 colorder(128) -integer*1 gen144(48,80) -integer*1 itmp(128) -integer*1 message(80) -integer*1 pchecks(48) -logical first -data first/.true./ -data g/ & !parity-check generator matrix for (128,80) code - "24084000800020008000", & - "b39678f7ccdb1baf5f4c", & - "10001000400408012000", & - "08104000100002010800", & - "dc9c18f61ea0e4b7f05c", & - "42c040160909ca002c00", & - "cc50b52b9a80db0d7f9e", & - "dde5ace80780bae74740", & - "00800080020000890080", & - "01020040010400400040", & - "20008010020000100030", & - "80400008004000040050", & - "a4b397810915126f5604", & - "04040100001040200008", & - "00800006000888000800", & - "00010c00000104040001", & - "cc7cd7d953cdc204eba0", & - "0094abe7dd146beb16ce", & - "5af2aec8c7b051c7544a", & - "14040508801840200088", & - "7392f5e720f8f5a62c1e", & - "503cc2a06bff4e684ec9", & - "5a2efd46f1efbb513b80", & - "ac06e9513fd411f1de03", & - "16a31be3dd3082ca2bd6", & - "28542e0daf62fe1d9332", & - "00210c002001540c0401", & - "0ed90d56f84298706a98", & - "939670f7ecdf9baf4f4c", & - "cfe41dec47a433e66240", & - "16d2179c2d5888222630", & - "408000160108ca002800", & - "808000830a00018900a0", & - "9ae2ed8ef3afbf8c3a52", & - "5aaafd86f3efbfc83b02", & - "f39658f68cdb0baf1f4c", & - "9414bb6495106261366a", & - "71ba18670c08411bf682", & - "7298f1a7217cf5c62e5e", & - "86d7a4864396a981369b", & - "a8042c01ae22fe191362", & - "9235ae108b2d60d0e306", & - "dfe5ade807a03be74640", & - "d2451588e6e27ccd9bc4", & - "12b51ae39d20e2ea3bde", & - "a49387810d95136fd604", & - "467e7578e51d5b3b8a0e", & - "f6ad1ac7cc3aaa3fe580"/ - -data colorder/0,1,2,3,4,5,6,7,8,9, & - 10,11,12,13,14,15,24,26,29,30, & - 32,43,44,47,60,77,79,97,101,111, & - 96,38,64,53,93,34,59,94,74,90, & - 108,123,85,57,70,25,69,62,48,49, & - 50,51,52,33,54,55,56,21,58,36, & - 16,61,23,63,20,65,66,67,68,46, & - 22,71,72,73,31,75,76,45,78,17, & - 80,81,82,83,84,42,86,87,88,89, & - 39,91,92,35,37,95,19,27,98,99, & - 100,28,102,103,104,105,106,107,40,109, & - 110,18,112,113,114,115,116,117,118,119, & - 120,121,122,41,124,125,126,127/ - -save first,gen144 - -if( first ) then ! fill the generator matrix - gen144=0 - do i=1,48 - do j=1,5 - read(g(i)( (j-1)*4+1:(j-1)*4+4 ),"(Z4)") istr - do jj=1,16 - icol=(j-1)*16+jj - if( btest(istr,16-jj) ) gen144(i,icol)=1 - enddo - enddo - enddo -first=.false. -endif - -do i=1,48 - nsum=0 - do j=1,80 - nsum=nsum+message(j)*gen144(i,j) - enddo - pchecks(i)=mod(nsum,2) -enddo -itmp(1:48)=pchecks -itmp(49:128)=message(1:80) -codeword(colorder+1)=itmp(1:128) - -return -end subroutine encode_msk144 diff --git a/lib/encode_msk40.f90 b/lib/encode_msk40.f90 deleted file mode 100644 index 9c53255..0000000 --- a/lib/encode_msk40.f90 +++ /dev/null @@ -1,46 +0,0 @@ -subroutine encode_msk40(message,codeword) -! Encode a 16-bit message and return a 32-bit codeword. -! The code is a (32,16) regular ldpc code with column weight 3. -! The code was generated using the PEG algorithm. -! After creating the codeword, the columns are re-ordered according to -! "colorder" to make the codeword compatible with the parity-check -! matrix stored in Radford Neal's "pchk" format. -! -integer*1 codeword(32) -integer*1 colorder(32) -integer g(16) -integer*1 gen40(16,16) -integer*1 itmp(32) -integer*1 message(16) -integer*1 pchecks(16) -logical first -data first/.true./ -data g/Z'4428',Z'5a6b',Z'1b04',Z'2c12',Z'60c4',Z'1071',Z'be6a',Z'36dd', & - Z'c580',Z'ad9a',Z'eca2',Z'7843',Z'332e',Z'a685',Z'5906',Z'1efe'/ -data colorder/4,1,2,3,0,8,6,10,13,28,20,23,17,15,27,25, & - 16,12,18,19,7,21,22,11,24,5,26,14,9,29,30,31/ -save first,gen40 - -if( first ) then ! fill the generator matrix - gen40=0 - do i=1,16 - do j=1,16 - if( btest(g(i),16-j) ) gen40(i,j)=1 - enddo - enddo - first=.false. -endif - -do i=1,16 - nsum=0 - do j=1,16 - nsum=nsum+message(j)*gen40(i,j) - enddo - pchecks(i)=mod(nsum,2) -enddo -itmp(1:16)=pchecks -itmp(17:32)=message(1:16) -codeword(colorder+1)=itmp(1:32) - -return -end subroutine encode_msk40 diff --git a/lib/extract.f90 b/lib/extract.f90 deleted file mode 100644 index b9fed93..0000000 --- a/lib/extract.f90 +++ /dev/null @@ -1,245 +0,0 @@ -subroutine extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip, & - mycall_12,hiscall_12,hisgrid,nQSOProgress,ljt65apon, & - nexp_decode,ncount, & - nhist,decoded,ltext,nft,qual) - -! Input: -! s3 64-point spectra for each of 63 data symbols -! nadd number of spectra summed into s3 -! nqd 0/1 to indicate decode attempt at QSO frequency - -! Output: -! ncount number of symbols requiring correction (-1 for no KV decode) -! nhist maximum number of identical symbol values -! decoded decoded message (if ncount >=0) -! ltext true if decoded message is free text -! nft 0=no decode; 1=FT decode; 2=hinted decode - - use prog_args !shm_key, exe_dir, data_dir - use packjt - use jt65_mod - use timer_module, only: timer - - real s3(64,63) - character decoded*22, apmessage*22 - character*12 mycall_12,hiscall_12 - character*6 mycall,hiscall,hisgrid - character*6 mycall0,hiscall0,hisgrid0 - integer apsymbols(7,12),ap(12) - integer nappasses(0:5) ! the number of decoding passes to use for each QSO state - integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now - integer dat4(12) - integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63) - integer correct(63),tmp(63) - logical first,ltext,ljt65apon - common/chansyms65/correct - data first/.true./ - save - - if(mode65.eq.-99) stop !Silence compiler warning - if(first) then - -! aptype -!------------------------ -! 1 CQ ??? ??? -! 2 MyCall ??? ??? -! 3 MyCall DxCall ??? -! 4 MyCall DxCall RRR -! 5 MyCall DxCall 73 -! 6 MyCall DxCall DxGrid -! 7 CQ DxCall DxGrid - - apsymbols=-1 - nappasses=(/3,4,2,3,3,4/) - naptypes(0,1:4)=(/1,2,6,0/) ! Tx6 - naptypes(1,1:4)=(/2,3,6,7/) ! Tx1 - naptypes(2,1:4)=(/2,3,0,0/) ! Tx2 - naptypes(3,1:4)=(/3,4,5,0/) ! Tx3 - naptypes(4,1:4)=(/3,4,5,0/) ! Tx4 - naptypes(5,1:4)=(/2,3,4,5/) ! Tx5 - first=.false. - endif - - mycall=mycall_12(1:6) - hiscall=hiscall_12(1:6) -! Fill apsymbols array - if(ljt65apon .and. & - (mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. hisgrid.ne.hisgrid0)) then -!write(*,*) 'initializing apsymbols ' - apsymbols=-1 - mycall0=mycall - hiscall0=hiscall - ap=-1 - apsymbols(1,1:4)=(/62,32,32,49/) ! CQ - if(len_trim(mycall).gt.0) then - apmessage=mycall//" "//mycall//" RRR" - call packmsg(apmessage,ap,itype,.false.) - if(itype.ne.1) ap=-1 - apsymbols(2,1:4)=ap(1:4) -!write(*,*) 'mycall symbols ',ap(1:4) - if(len_trim(hiscall).gt.0) then - apmessage=mycall//" "//hiscall//" RRR" - call packmsg(apmessage,ap,itype,.false.) - if(itype.ne.1) ap=-1 - apsymbols(3,1:9)=ap(1:9) - apsymbols(4,:)=ap - apmessage=mycall//" "//hiscall//" 73" - call packmsg(apmessage,ap,itype,.false.) - if(itype.ne.1) ap=-1 - apsymbols(5,:)=ap - if(len_trim(hisgrid(1:4)).gt.0) then - apmessage=mycall//' '//hiscall//' '//hisgrid(1:4) - call packmsg(apmessage,ap,itype,.false.) - if(itype.ne.1) ap=-1 - apsymbols(6,:)=ap - apmessage='CQ'//' '//hiscall//' '//hisgrid(1:4) - call packmsg(apmessage,ap,itype,.false.) - if(itype.ne.1) ap=-1 - apsymbols(7,:)=ap - endif - endif - endif - endif - - qual=0. - nbirdie=20 - npct=50 - afac1=1.1 - nft=0 - nfail=0 - decoded=' ' - call pctile(s3,4032,npct,base) - s3=s3/base - s3a=s3 !### - -! Get most reliable and second-most-reliable symbol values, and their -! probabilities -1 call demod64a(s3,nadd,afac1,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) - - call chkhist(mrsym,nhist,ipk) !Test for birdies and QRM - if(nhist.ge.nbirdie) then - nfail=nfail+1 - call pctile(s3,4032,npct,base) - s3(ipk,1:63)=base - if(nfail.gt.30) then - decoded=' ' - ncount=-1 - go to 900 - endif - go to 1 - endif - - mrs=mrsym - mrs2=mr2sym - - call graycode65(mrsym,63,-1) !Remove gray code - call interleave63(mrsym,-1) !Remove interleaving - call interleave63(mrprob,-1) - - call graycode65(mr2sym,63,-1) !Remove gray code and interleaving - call interleave63(mr2sym,-1) !from second-most-reliable symbols - call interleave63(mr2prob,-1) - - npass=1 ! if ap decoding is disabled - if(ljt65apon .and. len_trim(mycall).gt.0) then - npass=1+nappasses(nQSOProgress) -!write(*,*) 'ap is on: ',npass-1,'ap passes of types ',naptypes(nQSOProgress,:) - endif - do ipass=1,npass - ap=-1 - ntype=0 - if(ipass.gt.1) then - ntype=naptypes(nQSOProgress,ipass-1) -!write(*,*) 'ap pass, type ',ntype - ap=apsymbols(ntype,:) - if(count(ap.ge.0).eq.0) cycle ! don't bother if all ap symbols are -1 -!write(*,'(12i3)') ap - endif - ntry=0 - call timer('ftrsd ',0) - param=0 - call ftrsdap(mrsym,mrprob,mr2sym,mr2prob,ap,ntrials,correct,param,ntry) - call timer('ftrsd ',1) - ncandidates=param(0) - nhard=param(1) - nsoft=param(2) - nerased=param(3) - rtt=0.001*param(4) - ntotal=param(5) - qual=0.001*param(7) - nd0=81 - r0=0.87 - if(naggressive.eq.10) then - nd0=83 - r0=0.90 - endif - - if(ntotal.le.nd0 .and. rtt.le.r0) then - nft=1+ishft(ntype,2) - endif - - if(nft.gt.0) exit - enddo -!write(*,*) nft - if(nft.eq.0 .and. iand(ndepth,32).eq.32) then - qmin=2.0 - 0.1*naggressive - call timer('hint65 ',0) - call hint65(s3,mrs,mrs2,nadd,nflip,mycall,hiscall,hisgrid,qual,decoded) - if(qual.ge.qmin) then - nft=2 - ncount=0 - else - decoded=' ' - ntry=0 - endif - call timer('hint65 ',1) - go to 900 - endif - - ncount=-1 - decoded=' ' - ltext=.false. - if(nft.gt.0) then -! Turn the corrected symbol array into channel symbols for subtraction; -! pass it back to jt65a via common block "chansyms65". - do i=1,12 - dat4(i)=correct(13-i) - enddo - do i=1,63 - tmp(i)=correct(64-i) - enddo - correct(1:63)=tmp(1:63) - call interleave63(correct,1) - call graycode65(correct,63,1) - call unpackmsg(dat4,decoded,.false.,' ') !Unpack the user message - ncount=0 - if(iand(dat4(10),8).ne.0) ltext=.true. - endif -900 continue - if(nft.eq.1 .and. nhard.lt.0) decoded=' ' - - return -end subroutine extract - -subroutine getpp(workdat,p) - - use jt65_mod - integer workdat(63) - integer a(63) - - a(1:63)=workdat(63:1:-1) - call interleave63(a,1) - call graycode(a,63,1,a) - - psum=0. - do j=1,63 - i=a(j)+1 - x=s3a(i,j) - s3a(i,j)=0. - psum=psum + x - s3a(i,j)=x - enddo - p=psum/63.0 - - return -end subroutine getpp diff --git a/lib/extract4.f90 b/lib/extract4.f90 deleted file mode 100644 index 46c317c..0000000 --- a/lib/extract4.f90 +++ /dev/null @@ -1,69 +0,0 @@ -subroutine extract4(sym0,ncount,decoded) - - use packjt - real sym0(207) - real sym(207) - character decoded*22 - character*72 c72 - integer*1 symbol(207) - integer*1 data1(13) !Decoded data (8-bit bytes) - integer data4a(9) !Decoded data (8-bit bytes) - integer data4(12) !Decoded data (6-bit bytes) - integer mettab(-128:127,0:1) !Metric table - logical first - data first/.true./ - save first,mettab,ndelta - - if(first) then - call getmet4(mettab,ndelta) - first=.false. - endif - -!### Optimize these params: ... - amp=30.0 - limit=10000 - - ave0=sum(sym0)/207.0 - sym=sym0-ave0 - sq=dot_product(sym,sym) - rms0=sqrt(sq/206.0) - sym=sym/rms0 - - do j=1,207 - n=nint(amp*sym(j)) - if(n.lt.-127) n=-127 - if(n.gt.127) n=127 - symbol(j)=n - enddo - - nbits=72 - ncycles=0 - ncount=-1 - decoded=' ' - call interleave4(symbol(2),-1) !Remove the interleaving - call fano232(symbol(2),nbits+31,mettab,ndelta,limit,data1, & - ncycles,metric,ncount) - nlim=ncycles/(nbits+31) - -!### Make usage here like that in jt9fano... - if(ncount.ge.0) then - do i=1,9 - i4=data1(i) - if(i4.lt.0) i4=i4+256 - data4a(i)=i4 - enddo - write(c72,1100) (data4a(i),i=1,9) -1100 format(9b8.8) - read(c72,1102) data4 -1102 format(12b6) - - call unpackmsg(data4,decoded,.false.,' ') - if(decoded(1:6).eq.'000AAA') then -! decoded='***WRONG MODE?***' - decoded=' ' - ncount=-1 - endif - endif - - return -end subroutine extract4 diff --git a/lib/extractmessage144.f90 b/lib/extractmessage144.f90 deleted file mode 100644 index 151cb1d..0000000 --- a/lib/extractmessage144.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine extractmessage144(decoded,msgreceived,nhashflag,recent_calls,nrecent) - use iso_c_binding, only: c_loc,c_size_t - use packjt - use hashing - - character*22 msgreceived - character*12 call1,call2 - character*12 recent_calls(nrecent) - integer*1 decoded(80) - integer*1, target:: i1Dec8BitBytes(10) - integer*1 i1hashdec - integer*4 i4Dec6BitWords(12) - -! Collapse 80 decoded bits to 10 bytes. Bytes 1-9 are the message, byte 10 is the hash - do ibyte=1,10 - itmp=0 - do ibit=1,8 - itmp=ishft(itmp,1)+iand(1_1,decoded((ibyte-1)*8+ibit)) - enddo - i1Dec8BitBytes(ibyte)=itmp - enddo - -! Calculate the hash using the first 9 bytes. - ihashdec=nhash(c_loc(i1Dec8BitBytes),int(9,c_size_t),146) - ihashdec=2*iand(ihashdec,255) - -! Compare calculated hash with received byte 10 - if they agree, keep the message. - i1hashdec=ihashdec - if( i1hashdec .eq. i1Dec8BitBytes(10) ) then -! Good hash --- unpack 72-bit message - do ibyte=1,12 - itmp=0 - do ibit=1,6 - itmp=ishft(itmp,1)+iand(1_1,decoded((ibyte-1)*6+ibit)) - enddo - i4Dec6BitWords(ibyte)=itmp - enddo - call unpackmsg144(i4Dec6BitWords,msgreceived,call1,call2) - nhashflag=1 - if( call1(1:2) .ne. 'CQ' .and. call1(1:2) .ne. ' ' ) then - call update_recent_calls(call1,recent_calls,nrecent) - endif - if( call2(1:2) .ne. ' ' ) then - call update_recent_calls(call2,recent_calls,nrecent) - endif - else - msgreceived=' ' - nhashflag=-1 - endif - return - end subroutine extractmessage144 diff --git a/lib/fast9.f90 b/lib/fast9.f90 deleted file mode 100644 index 1214862..0000000 --- a/lib/fast9.f90 +++ /dev/null @@ -1,191 +0,0 @@ -subroutine fast9(id2,narg,line) - -! Decoder for "fast9" modes, JT9E to JT9H. - - parameter (NMAX=30*12000,NSAVE=500) - integer*2 id2(0:NMAX) - integer narg(0:14) - integer*1 i1SoftSymbols(207) - integer*1 i1save(207,NSAVE) - integer indx(NSAVE) - integer*8 count0,count1,clkfreq - real s1(720000) !To reserve space. Logically s1(nq,jz) - real s2(240,340) !Symbol spectra at quarter-symbol steps - real ss2(0:8,85) !Folded symbol spectra - real ss3(0:7,69) !Folded spectra without sync symbols - real s(1500) - real ccfsave(NSAVE) - real t0save(NSAVE) - real t1save(NSAVE) - real freqSave(NSAVE) - real t(6) - character*22 msg !Decoded message - character*80 line(100) - data nsubmode0/-1/,ntot/0/ - save s1,nsubmode0,ntot - -! Parameters from GUI are in narg(): - nutc=narg(0) !UTC - npts=min(narg(1),NMAX) !Number of samples in id2 (12000 Hz) - nsubmode=narg(2) !0=A 1=B 2=C 3=D 4=E 5=F 6=G 7=H - if(nsubmode.lt.4) go to 900 - newdat=narg(3) !1==> new data, compute symbol spectra - minsync=narg(4) !Lower sync limit - npick=narg(5) - t0=0.001*narg(6) - t1=0.001*narg(7) - maxlines=narg(8) !Max # of decodes to return to caller - nmode=narg(9) - nrxfreq=narg(10) !Targer Rx audio frequency (Hz) - ntol=narg(11) !Search range, +/- ntol (Hz) - - tmid=npts*0.5/12000.0 - line(1:100)(1:1)=char(0) - s=0 - s2=0 - nsps=60 * 2**(7-nsubmode) !Samples per sysbol - nfft=2*nsps !FFT size - nh=nfft/2 - nq=nfft/4 - istep=nsps/4 !Symbol spectra at quarter-symbol steps - jz=npts/istep - df=12000.0/nfft !FFT bin width - db1=db(2500.0/df) - nfa=max(200,nrxfreq-ntol) !Lower frequency limit - nfb=min(nrxfreq+ntol,2500) !Upper frequency limit - nline=0 - t=0. - - if(newdat.eq.1 .or. nsubmode.ne.nsubmode0) then - call system_clock(count0,clkfreq) - call spec9f(id2,npts,nsps,s1,jz,nq) !Compute symbol spectra, s1 - call system_clock(count1,clkfreq) - t(1)=t(1)+float(count1-count0)/float(clkfreq) - endif - - nsubmode0=nsubmode - tmsg=nsps*85.0/12000.0 - limit=2000 - nlen0=0 - i1=0 - i2=0 - ccfsave=0. - do ilength=1,14 - nlen=1.4142136**(ilength-1) - if(nlen.gt.jz/340) nlen=jz/340 - if(nlen.eq.nlen0) cycle - nlen0=nlen - - db0=db(float(nlen)) - jlen=nlen*340 - jstep=jlen/4 !### Is this about right? ### - if(nsubmode.ge.6) jstep=jlen/2 - - do ja=1,jz-jlen,jstep - jb=ja+jlen-1 - call system_clock(count0,clkfreq) - call foldspec9f(s1,nq,jz,ja,jb,s2) !Fold symbol spectra into s2 - call system_clock(count1,clkfreq) - t(2)=t(2)+float(count1-count0)/float(clkfreq) - -! Find sync; put sync'ed symbol spectra into ss2 and ss3 -! Might want to do a peakup in DT and DF, then re-compute symbol spectra. - - call system_clock(count0,clkfreq) - call sync9f(s2,nq,nfa,nfb,ss2,ss3,lagpk,ipk,ccfbest) - call system_clock(count1,clkfreq) - t(3)=t(3)+float(count1-count0)/float(clkfreq) - - i1=i1+1 - if(ccfbest.lt.30.0) cycle - call system_clock(count0,clkfreq) - call softsym9f(ss2,ss3,i1SoftSymbols) !Compute soft symbols - call system_clock(count1,clkfreq) - t(4)=t(4)+float(count1-count0)/float(clkfreq) - - i2=i2+1 - ccfsave(i2)=ccfbest - i1save(1:207,i2)=i1SoftSymbols - t0=(ja-1)*istep/12000.0 - t1=(jb-1)*istep/12000.0 - t0save(i2)=t0 - t1save(i2)=t1 - freq=ipk*df - freqSave(i2)=freq - enddo - enddo - nsaved=i2 - - ccfsave(1:nsaved)=-ccfsave(1:nsaved) - call system_clock(count0,clkfreq) - indx=0 - call indexx(ccfsave,nsaved,indx) - call system_clock(count1,clkfreq) - t(5)=t(5)+float(count1-count0)/float(clkfreq) - - ccfsave(1:nsaved)=-ccfsave(1:nsaved) - - do iter=1,2 -! do isave=1,nsaved - do isave=1,50 - i2=indx(isave) - if(i2.lt.1 .or. i2.gt.nsaved) cycle !### Why needed? ### - t0=t0save(i2) - t1=t1save(i2) - if(iter.eq.1 .and. t1.lt.tmid) cycle - if(iter.eq.2 .and. t1.ge.tmid) cycle - ccfbest=ccfsave(i2) - i1SoftSymbols=i1save(1:207,i2) - freq=freqSave(i2) - call system_clock(count0,clkfreq) - call jt9fano(i1SoftSymbols,limit,nlim,msg) !Invoke Fano decoder - call system_clock(count1,clkfreq) - t(6)=t(6)+float(count1-count0)/float(clkfreq) - - i=t0*12000.0 - kz=(t1-t0)/0.02 - smax=0. - do k=1,kz - sq=0. - do n=1,240 - i=i+1 - x=id2(i) - sq=sq+x*x - enddo - s(k)=sq/240. - smax=max(s(k),smax) - enddo - call pctile(s,kz,35,base) - snr=smax/(1.1*base) - 1.0 - nsnr=-20 - if(snr.gt.0.0) nsnr=nint(db(snr)) - -! write(72,3002) nutc,iter,isave,nlen,tmid,t0,t1,ccfbest, & -! nint(freq),nlim,msg -!3002 format(i6.6,i1,i4,i3,4f6.1,i5,i7,1x,a22) - - if(msg.ne.' ') then - -! Display multiple decodes only if they differ: - do n=1,nline - if(index(line(n),msg).gt.1) go to 100 - enddo -!### Might want to use decoded message to get a complete estimate of S/N. - nline=nline+1 - write(line(nline),1000) nutc,nsnr,t0,nint(freq),msg,char(0) -1000 format(i6.6,i4,f5.1,i5,1x,'@ ',1x,a22,a1) - ntot=ntot+1 -! write(70,5001) nsaved,isave,nline,maxlines,ntot,nutc,msg -!5001 format(5i5,i7.6,1x,a22) - if(nline.ge.maxlines) go to 900 - endif -100 continue - enddo - enddo - -900 continue -! write(*,6001) t,t(6)/sum(t) -!6001 format(7f10.3) - - return -end subroutine fast9 diff --git a/lib/fchisq.f90 b/lib/fchisq.f90 deleted file mode 100644 index 1aa2b0b..0000000 --- a/lib/fchisq.f90 +++ /dev/null @@ -1,44 +0,0 @@ -real function fchisq(c3,npts,fsample,a) - - parameter (NMAX=85*16) - complex c3(npts) - complex c4(NMAX) - real a(3) - complex z - data a1,a2,a3/99.,99.,99./ - include 'jt9sync.f90' - save - - if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then - a1=a(1) - a2=a(2) - a3=a(3) - call twkfreq(c3,c4,npts,fsample,a) - endif - -! Get sync power. - nspsd=16 - sum1=0. - sum0=0. - k=-1 - do i=1,85 - z=0. - do j=1,nspsd - k=k+1 - z=z+c4(k+1) - enddo - pp=real(z)**2 + aimag(z)**2 - if(isync(i).eq.1) then - sum1=sum1+pp - else - sum0=sum0+pp - endif - enddo - sync_4992=(sum1/16.0)/(sum0/69.0) - 1.0 !r4992 - sync_4993=sum1/10000.0 !r4993+ -! write(80,3001) 1.e-5*sum1,1.e-5*sum0,sync_4992,sync_4993,sync -!3001 format(5f11.4) - fchisq=-sync_4993 - - return -end function fchisq diff --git a/lib/fchisq65.f90 b/lib/fchisq65.f90 deleted file mode 100644 index 3c62414..0000000 --- a/lib/fchisq65.f90 +++ /dev/null @@ -1,68 +0,0 @@ -real function fchisq65(cx,npts,fsample,nflip,a,ccfmax,dtmax) - - use timer_module, only: timer - - parameter (NMAX=60*12000) !Samples per 60 s - complex cx(npts) - real a(5) - complex w,wstep,z - real ss(3000) - complex csx(0:NMAX/8) - data twopi/6.283185307/a1,a2,a3/99.,99.,99./ - save - - call timer('fchisq65',0) - baud=11025.0/4096.0 - nsps=nint(fsample/baud) !Samples per symbol - nsph=nsps/2 !Samples per half-symbol - ndiv=16 !Output ss() steps per symbol - nout=ndiv*npts/nsps - dtstep=1.0/(ndiv*baud) !Time per output step - - if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then - a1=a(1) - a2=a(2) - a3=a(3) - -! Mix and integrate the complex signal - csx(0)=0. - w=1.0 - x0=0.5*(npts+1) - s=2.0/npts - do i=1,npts - x=s*(i-x0) - if(mod(i,100).eq.1) then - p2=1.5*x*x - 0.5 - dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/fsample) - wstep=cmplx(cos(dphi),sin(dphi)) - endif - w=w*wstep - csx(i)=csx(i-1) + w*cx(i) - enddo - endif - -! Compute whole-symbol powers at 1/16-symbol steps. - fac=1.e-4 - do i=1,nout - j=nsps+(i-1)*nsps/16 !steps by 8 samples (1/16 of a symbol) - k=j-nsps - ss(i)=0. - if(k.ge.0 .and. j.le.npts) then - z=csx(j)-csx(k) ! difference over span of 128 pts - ss(i)=fac*(real(z)**2 + aimag(z)**2) - endif - enddo - - ccfmax=0. - call timer('ccf2 ',0) - call ccf2(ss,nout,nflip,ccf,xlagpk) - call timer('ccf2 ',1) - if(ccf.gt.ccfmax) then - ccfmax=ccf - dtmax=xlagpk*dtstep - endif - fchisq65=-ccfmax - call timer('fchisq65',1) - - return -end function fchisq65 diff --git a/lib/fil6521.f90 b/lib/fil6521.f90 deleted file mode 100644 index ef4b543..0000000 --- a/lib/fil6521.f90 +++ /dev/null @@ -1,45 +0,0 @@ -subroutine fil6521(c1,n1,c2,n2) - -! FIR lowpass filter designed using ScopeFIR - -! Pass #1 Pass #2 -! ----------------------------------------------- -! fsample (Hz) 1378.125 Input sample rate -! Ntaps 21 Number of filter taps -! fc (Hz) 40 Cutoff frequency -! fstop (Hz) 172.266 Lower limit of stopband -! Ripple (dB) 0.1 Ripple in passband -! Stop Atten (dB) 38 Stopband attenuation -! fout (Hz) 344.531 Output sample rate - - parameter (NTAPS=21) - parameter (NH=NTAPS/2) - parameter (NDOWN=4) !Downsample ratio = 1/4 - complex c1(n1) - complex c2(n1/NDOWN) - -! Filter coefficients: - real a(-NH:NH+NTAPS/3) - data a/ & - -0.011958606980,-0.013888627387,-0.015601306443,-0.010602249570, & - 0.003804023436, 0.028320058273, 0.060903935217, 0.096841904411, & - 0.129639871228, 0.152644580853, 0.160917511283, 0.152644580853, & - 0.129639871228, 0.096841904411, 0.060903935217, 0.028320058273, & - 0.003804023436,-0.010602249570,-0.015601306443,-0.013888627387, & - -0.011958606980,1.43370769e-019,2.64031087e-006,6.25548654e+028, & - 2.44565251e+020,4.74227538e+030,10497312.0e0000,7.74079654e-039/ - - n2=(n1-NTAPS+NDOWN)/NDOWN - k0=NH-NDOWN+1 - -! Loop over all output samples - do i=1,n2 - c2(i)=0. - k=k0 + NDOWN*i - do j=-NH,NH - c2(i)=c2(i) + c1(j+k)*a(j) - enddo - enddo - - return -end subroutine fil6521 diff --git a/lib/flat65.f90 b/lib/flat65.f90 deleted file mode 100644 index 7aa106c..0000000 --- a/lib/flat65.f90 +++ /dev/null @@ -1,25 +0,0 @@ -subroutine flat65(ss,nhsym,maxhsym,nsz,ref) - - real stmp(nsz) - real ss(maxhsym,nsz) - real ref(nsz) - - npct=28 !Somewhat arbitrary - do i=1,nsz - call pctile(ss(1,i),nhsym,npct,stmp(i)) - enddo - - nsmo=33 - ia=nsmo/2 + 1 - ib=nsz - nsmo/2 - 1 - do i=ia,ib - call pctile(stmp(i-nsmo/2),nsmo,npct,ref(i)) - enddo - ref(:ia-1)=ref(ia) - ref(ib+1:)=ref(ib) - ref=4.0*ref - - return -end subroutine flat65 - - diff --git a/lib/foldspec9f.f90 b/lib/foldspec9f.f90 deleted file mode 100644 index a6436eb..0000000 --- a/lib/foldspec9f.f90 +++ /dev/null @@ -1,30 +0,0 @@ -subroutine foldspec9f(s1,nq,jz,ja,jb,s2) - -! Fold symbol spectra (quarter-symbol steps) from s1 into s2 - - real s1(nq,jz) - real s2(240,340) !340 = 4*85 - integer nsum(340) - - s2=0. - nsum=0 - - do j=ja,jb - k=mod(j-1,340)+1 - nsum(k)=nsum(k)+1 - do i=1,NQ - s2(i,k)=s2(i,k) + s1(i,j) - enddo - enddo - - do k=1,340 - fac=1.0 - if(nsum(k).gt.0) fac=1.0/nsum(k) - s2(1:nq,k)=fac*s2(1:nq,k) - enddo - - ave=sum(s2)/(340.0*nq) - if(ave.gt.0.0) s2=s2/ave - - return -end subroutine foldspec9f diff --git a/lib/ft8/bpdecode174.f90 b/lib/ft8/bpdecode174.f90 index 1260fba..5c576ea 100644 --- a/lib/ft8/bpdecode174.f90 +++ b/lib/ft8/bpdecode174.f90 @@ -395,3 +395,53 @@ enddo nharderror=-1 return end subroutine bpdecode174 + +subroutine pltanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.8 ) then + y=0.83*x + return + elseif( z.le. 1.6 ) then + y=isign*(0.322*z+0.4064) + return + elseif( z.le. 3.0 ) then + y=isign*(0.0524*z+0.8378) + return + elseif( z.lt. 7.0 ) then + y=isign*(0.0012*z+0.9914) + return + else + y=isign*0.9998 + return + endif +end subroutine pltanh + +subroutine platanh(x,y) + isign=+1 + z=x + if( x.lt.0 ) then + isign=-1 + z=abs(x) + endif + if( z.le. 0.664 ) then + y=x/0.83 + return + elseif( z.le. 0.9217 ) then + y=isign*(z-0.4064)/0.322 + return + elseif( z.le. 0.9951 ) then + y=isign*(z-0.8378)/0.0524 + return + elseif( z.le. 0.9998 ) then + y=isign*(z-0.9914)/0.0012 + return + else + y=isign*7.0 + return + endif +end subroutine platanh diff --git a/lib/graycode65.f90 b/lib/graycode65.f90 deleted file mode 100644 index 3ee9a42..0000000 --- a/lib/graycode65.f90 +++ /dev/null @@ -1,9 +0,0 @@ -subroutine graycode65(dat,n,idir) - - integer dat(n) - do i=1,n - dat(i)=igray(dat(i),idir) - enddo - - return -end subroutine graycode65 diff --git a/lib/grayline.f90 b/lib/grayline.f90 deleted file mode 100644 index cc1aeee..0000000 --- a/lib/grayline.f90 +++ /dev/null @@ -1,32 +0,0 @@ -subroutine grayline(nyear,month,nday,uth,mygrid,nduration,isun) - - character*6 mygrid - real LST - real lat,lon - - call grid2deg(MyGrid,elon,lat) - lon=-elon - - uth0=uth-0.5*nduration/60.0 - uth1=uth+0.5*nduration/60.0 - - call sun(nyear,month,nday,uth0,lon,lat,RASun,DecSun,LST, & - AzSun,ElSun0,mjd,day) - call sun(nyear,month,nday,uth1,lon,lat,RASun,DecSun,LST, & - AzSun,ElSun1,mjd,day) - - elchk=-0.8333 - isun=-1 - if(elsun0.lt.elchk .and. elsun1.ge.elchk) then - isun=0 - else if(elsun0.gt.elchk .and. elsun1.le.elchk) then - isun=2 - else if(elsun1.gt.elchk) then - isun=1 - else - isun=3 - endif - - return -end subroutine grayline - diff --git a/lib/hint65.f90 b/lib/hint65.f90 deleted file mode 100644 index 3d18533..0000000 --- a/lib/hint65.f90 +++ /dev/null @@ -1,166 +0,0 @@ -subroutine hint65(s3,mrs,mrs2,nadd,nflip,mycall,hiscall,hisgrid,qual,decoded) - - use packjt - use prog_args - parameter (MAXCALLS=10000,MAXRPT=63) - parameter (MAXMSG=2*MAXCALLS + 2 + MAXRPT) - real s3(64,63) - integer*1 sym1(0:62,MAXMSG) - integer*1 sym2(0:62,MAXMSG) - integer mrs(63),mrs2(63) - integer dgen(12),sym(0:62),sym_rev(0:62) - character*6 mycall,hiscall,hisgrid,call2(MAXCALLS) - character*4 grid2(MAXCALLS),rpt(MAXRPT) - character callsign*12,grid*4 - character*180 line - character ceme*3,msg*22,msg00*22 - character*22 msg0(MAXMSG),decoded - logical*1 eme(MAXCALLS) - logical first - data first/.true./ - data rpt/'-01','-02','-03','-04','-05', & - '-06','-07','-08','-09','-10', & - '-11','-12','-13','-14','-15', & - '-16','-17','-18','-19','-20', & - '-21','-22','-23','-24','-25', & - '-26','-27','-28','-29','-30', & - 'R-01','R-02','R-03','R-04','R-05', & - 'R-06','R-07','R-08','R-09','R-10', & - 'R-11','R-12','R-13','R-14','R-15', & - 'R-16','R-17','R-18','R-19','R-20', & - 'R-21','R-22','R-23','R-24','R-25', & - 'R-26','R-27','R-28','R-29','R-30', & - 'RO','RRR','73'/ - save first,sym1,nused,msg0,sym2 - - first=.true. !### For now, at least: always recompute hypothetical messages - if(first) then - neme=0 - open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown') - icall=0 - j=0 - do i=1,MAXCALLS - read(23,1002,end=10) line -1002 format(a80) - if(line(1:4).eq.'ZZZZ') cycle - if(line(1:2).eq.'//') cycle - i1=index(line,',') - if(i1.lt.4) cycle - i2=index(line(i1+1:),',') - if(i2.lt.5) cycle - i2=i2+i1 - i3=index(line(i2+1:),',') - if(i3.lt.1) i3=index(line(i2+1:),' ') - i3=i2+i3 - callsign=line(1:i1-1) - grid=line(i1+1:i1+4) - ceme=line(i2+1:i3-1) - eme(i)=ceme.eq.'EME' - if(neme.eq.1 .and. (.not.eme(i))) cycle - j=j+1 - call2(j)=callsign(1:6) !### Fix for compound callsigns! - grid2(j)=grid - enddo -10 ncalls=j - if(ncalls.lt.10) then - write(*,1010) ncalls -1010 format('CALL3.TXT very short (N =',i2,') or missing?') - endif - close(23) - -! NB: generation of test messages is not yet complete! - j=0 - do i=-1,ncalls - if(i.eq.0 .and. hiscall.eq.' ' .and. hisgrid(1:4).eq.' ') cycle - mz=2 - if(i.eq.-1) mz=1 - if(i.eq.0) mz=65 - do m=1,mz - j=j+1 - if(i.eq.-1) then - msg='0123456789ABC' - else if(i.eq.0) then - if(m.eq.1) msg=mycall//' '//hiscall//' '//hisgrid(1:4) - if(m.eq.2) msg='CQ '//hiscall//' '//hisgrid(1:4) - if(m.ge.3) msg=mycall//' '//hiscall//' '//rpt(m-2) - else - if(m.eq.1) msg=mycall//' '//call2(i)//' '//grid2(i) - if(m.eq.2) msg='CQ '//call2(i)//' '//grid2(i) - endif - call fmtmsg(msg,iz) - call packmsg(msg,dgen,itype,.false.) !Pack message into 72 bits - call rs_encode(dgen,sym_rev) !RS encode - sym(0:62)=sym_rev(62:0:-1) - sym1(0:62,j)=sym - - call interleave63(sym_rev,1) !Interleave channel symbols - call graycode(sym_rev,63,1,sym_rev) !Apply Gray code - sym2(0:62,j)=sym_rev(0:62) - msg0(j)=msg - enddo - enddo - nused=j - first=.false. - endif - - ref0=0. - do j=1,63 - ref0=ref0 + s3(mrs(j)+1,j) - enddo - - u1=0. - u1=-99.0 - u2=u1 - -! Find u1 and u2 (best and second-best) codeword from a list, using -! a bank of matched filters on the symbol spectra s3(i,j). - ipk=1 - ipk2=0 - msg00=' ' - do k=1,nused - if(k.ge.2 .and. k.le.64 .and. nflip.lt.0) cycle -! Test all messages if nflip=+1; skip the CQ messages if nflip=-1. - if(nflip.gt.0 .or. msg0(k)(1:3).ne.'CQ ') then - psum=0. - ref=ref0 - do j=1,63 - i=sym2(j-1,k)+1 - psum=psum + s3(i,j) - if(i.eq.mrs(j)+1) ref=ref - s3(i,j) + s3(mrs2(j)+1,j) - enddo - p=psum/ref - - if(p.gt.u1) then - if(msg0(k).ne.msg00) then - ipk2=ipk - u2=u1 - endif - u1=p - ipk=k - msg00=msg0(k) - endif - if(msg0(k).ne.msg00 .and. p.gt.u2) then - u2=p - ipk2=k - endif - endif - enddo - -!### Just in case ??? -! rewind 77 -! write(77,*) u1,u2,ipk,ipk2 -! call flush(77) -!### - - decoded=' ' - bias=max(1.12*u2,0.35) - if(nadd.ge.4) bias=max(1.08*u2,0.45) - if(nadd.ge.8) bias=max(1.04*u2,0.60) - qual=100.0*(u1-bias) -! write(*,3301) u1,u2,u1/u2,bias,qual,nadd,ipk,ipk2 -!3301 format(5f6.2,i3,2i6) - qmin=1.0 - if(qual.ge.qmin) decoded=msg0(ipk) - - return -end subroutine hint65 diff --git a/lib/inter_wspr.f90 b/lib/inter_wspr.f90 deleted file mode 100644 index 9f98045..0000000 --- a/lib/inter_wspr.f90 +++ /dev/null @@ -1,45 +0,0 @@ -subroutine inter_wspr(id,ndir) - -! Interleave (ndir=1) or de-interleave (ndir=-1) the array id. - - integer*1 id(0:161),itmp(0:161) - integer j0(0:161) - logical first - data first/.true./ - save - - if(first) then -! Compute the interleave table using bit reversal. - k=-1 - do i=0,255 - n=0 - ii=i - do j=0,7 - n=n+n - if(iand(ii,1).ne.0) n=n+1 - ii=ii/2 - enddo - if(n.le.161) then - k=k+1 - j0(k)=n - endif - enddo - first=.false. - endif - - if(ndir.eq.1) then - do i=0,161 - itmp(j0(i))=id(i) - enddo - else - do i=0,161 - itmp(i)=id(j0(i)) - enddo - endif - - do i=0,161 - id(i)=itmp(i) - enddo - - return -end subroutine inter_wspr diff --git a/lib/interleave4.f90 b/lib/interleave4.f90 deleted file mode 100644 index db57ec3..0000000 --- a/lib/interleave4.f90 +++ /dev/null @@ -1,43 +0,0 @@ -subroutine interleave4(id,ndir) - integer*1 id(0:205),itmp(0:205) - integer j0(0:205) - logical first - data first/.true./ - save first,j0 - - if(first) then - k=-1 - do i=0,255 - m=i - n=iand(m,1) - n=2*n + iand(m/2,1) - n=2*n + iand(m/4,1) - n=2*n + iand(m/8,1) - n=2*n + iand(m/16,1) - n=2*n + iand(m/32,1) - n=2*n + iand(m/64,1) - n=2*n + iand(m/128,1) - if(n.le.205) then - k=k+1 - j0(k)=n - endif - enddo - first=.false. - endif - - if(ndir.eq.1) then - do i=0,205 - itmp(j0(i))=id(i) - enddo - else - do i=0,205 - itmp(i)=id(j0(i)) - enddo - endif - - do i=0,205 - id(i)=itmp(i) - enddo - - return -end subroutine interleave4 diff --git a/lib/interleave63.f90 b/lib/interleave63.f90 deleted file mode 100644 index 048244e..0000000 --- a/lib/interleave63.f90 +++ /dev/null @@ -1,25 +0,0 @@ -subroutine interleave63(d1,idir) - -! Interleave (idir=1) or de-interleave (idir=-1) the array d1. - - integer d1(0:6,0:8) - integer d2(0:8,0:6) - - if(idir.ge.0) then - do i=0,6 - do j=0,8 - d2(j,i)=d1(i,j) - enddo - enddo - call move(d2,d1,63) - else - call move(d1,d2,63) - do i=0,6 - do j=0,8 - d1(i,j)=d2(j,i) - enddo - enddo - endif - - return -end subroutine interleave63 diff --git a/lib/interleave8.f90 b/lib/interleave8.f90 deleted file mode 100644 index e13346e..0000000 --- a/lib/interleave8.f90 +++ /dev/null @@ -1,17 +0,0 @@ -subroutine interleave8(idat,jdat) - - integer idat(66),jdat(66) - integer ii(66),jj(66) - data ii/ & - 64,32,16,48, 8,40,24,56, 4,36,20,52,12,44,28,60, 2,66,34,18, & - 50,10,42,26,58, 6,38,22,54,14,46,30,62, 1,65,33,17,49, 9,41, & - 25,57, 5,37,21,53,13,45,29,61, 3,35,19,51,11,43,27,59, 7,39, & - 23,55,15,47,31,63/ - data jj/ & - 34,17,51, 9,43,26,59, 5,39,22,55,13,47,30,63, 3,37,20,53,11, & - 45,28,61, 7,41,24,57,15,49,32,65, 2,36,19,52,10,44,27,60, 6, & - 40,23,56,14,48,31,64, 4,38,21,54,12,46,29,62, 8,42,25,58,16, & - 50,33,66, 1,35,18/ - - return -end subroutine interleave8 diff --git a/lib/interleave9.f90 b/lib/interleave9.f90 deleted file mode 100644 index e3026a9..0000000 --- a/lib/interleave9.f90 +++ /dev/null @@ -1,39 +0,0 @@ -subroutine interleave9(ia,ndir,ib) - integer*1 ia(0:205),ib(0:205) - integer j0(0:205) - logical first - data first/.true./ - save first,j0 !Save not working, or j0 overwritten ??? - - if(first) then - k=-1 - do i=0,255 - m=i - n=iand(m,1) - n=2*n + iand(m/2,1) - n=2*n + iand(m/4,1) - n=2*n + iand(m/8,1) - n=2*n + iand(m/16,1) - n=2*n + iand(m/32,1) - n=2*n + iand(m/64,1) - n=2*n + iand(m/128,1) - if(n.le.205) then - k=k+1 - j0(k)=n - endif - enddo -! first=.false. - endif - - if(ndir.gt.0) then - do i=0,205 - ib(j0(i))=ia(i) - enddo - else - do i=0,205 - ib(i)=ia(j0(i)) - enddo - endif - - return -end subroutine interleave9 diff --git a/lib/iscat.f90 b/lib/iscat.f90 deleted file mode 100644 index c02a0fb..0000000 --- a/lib/iscat.f90 +++ /dev/null @@ -1,206 +0,0 @@ -subroutine iscat(cdat0,npts0,nh,npct,t2,pick,cfile6,minsync,ntol, & - NFreeze,MouseDF,mousebutton,mode4,nafc,nmore,psavg,maxlines,nlines,line) - -! Decode an ISCAT signal - - parameter (NMAX=30*3101) - parameter (NSZ=4*1400) - character cfile6*6 !File time - character c42*42 - character msg*29,msg1*29,msgbig*29 - character*80 line(100) - character csync*1 - complex cdat0(NMAX) - complex cdat(NMAX) - real s0(288,NSZ) - real fs1(0:41,30) - real psavg(72) !Average spectrum of whole file - integer nsum(30) - integer ntol - integer icos(4) - logical pick,last - data icos/0,1,3,2/ - data nsync/4/,nlen/2/,ndat/18/ - data c42/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ /.?@-'/ - save cdat,s0 - - nlines = 0 - fsample=3100.78125 !Sample rate after 9/32 downsampling - nsps=144/mode4 - - bigworst=-1.e30 !Silence compiler warnings ... - bigxsync=0. - bigsig=-1.e30 - msglenbig=0 - ndf0big=0 - nfdotbig=0 - bigt2=0. - bigavg=0. - bigtana=0. - if(nmore.eq.-999) bigsig=-1 !... to here - - last=.false. - do inf=1,6 !Loop over data-segment sizes - nframes=2**inf - if(nframes*24*nsps.gt.npts0) then - nframes=npts0/(24*nsps) - last=.true. - endif - npts=nframes*24*nsps - - do ia=1,npts0-npts,nsps*24 !Loop over start times stepped by 1 frame - ib=ia+npts-1 - cdat(1:npts)=cdat0(ia:ib) - t3=(ia + 0.5*npts)/fsample + 0.9 - if(pick) t3=t2+t3 - -! Compute symbol spectra and establish sync: - call synciscat(cdat,npts,nh,npct,s0,jsym,df,ntol,NFreeze, & - MouseDF,mousebutton,mode4,nafc,psavg,xsync,sig,ndf0,msglen, & - ipk,jpk,idf,df1) - nfdot=nint(idf*df1) - - isync=xsync - if(msglen.eq.0 .or. isync.lt.max(minsync,0)) then - msglen=0 - worst=1. - avg=1. - ndf0=0 - cycle - endif - - ipk3=0 !Silence compiler warning - nblk=nsync+nlen+ndat - fs1=0. - nsum=0 - nfold=jsym/96 - jb=96*nfold - k=0 - n=0 - do j=jpk,jsym,4 !Fold information symbols into fs1 - k=k+1 - km=mod(k-1,nblk)+1 - if(km.gt.6) then - n=n+1 - m=mod(n-1,msglen)+1 - ii=nint(idf*float(j-jb/2)/float(jb)) - do i=0,41 - iii=ii+ipk+2*i - if(iii.ge.1 .and. iii.le.288) fs1(i,m)=fs1(i,m) + s0(iii,j) - enddo - nsum(m)=nsum(m)+1 - endif - enddo - - do m=1,msglen - fs1(0:41,m)=fs1(0:41,m)/nsum(m) - enddo - -! Read out the message contents: - msg= ' ' - msg1=' ' - mpk=0 - worst=9999. - sum=0. - do m=1,msglen - smax=0. - smax2=0. - do i=0,41 - if(fs1(i,m).gt.smax) then - smax=fs1(i,m) - ipk3=i - endif - enddo - do i=0,41 - if(fs1(i,m).gt.smax2 .and. i.ne.ipk3) smax2=fs1(i,m) - enddo - rr=0. - if(smax2.gt.0.0) rr=smax/smax2 - sum=sum + rr - if(rr.lt.worst) worst=rr - if(ipk3.eq.40) mpk=m - msg1(m:m)=c42(ipk3+1:ipk3+1) - enddo - - avg=sum/msglen - if(mpk.eq.1) then - msg=msg1(2:) - else if(mpk.lt.msglen) then - msg=msg1(mpk+1:msglen)//msg1(1:mpk-1) - else - msg=msg1(1:msglen-1) - endif - - ttot=npts/3100.78125 - - if(worst.gt.bigworst) then - bigworst=worst - bigavg=avg - bigxsync=xsync - bigsig=sig - ndf0big=ndf0 - nfdotbig=nfdot - msgbig=msg - msglenbig=msglen - bigt2=t3 - bigtana=nframes*24*nsps/fsample - endif - - isync = xsync - if(avg.gt.2.5 .and. xsync.ge.max(float(minsync),1.5) .and. & - maxlines.ge.2) then - nsig=nint(sig) - nworst=10.0*(worst-1.0) - navg=10.0*(avg-1.0) - if(nworst.gt.10) nworst=10 - if(navg.gt.10) navg=10 - tana=nframes*24*nsps/fsample - csync=' ' - if(isync.ge.1) csync='*' - if(nlines.le.maxlines-1) nlines = nlines + 1 - write(line(nlines),1020) cfile6,isync,nsig,t2,ndf0,nfdot,csync, & - msg(1:28),msglen,navg,nworst,tana,char(0) - endif - enddo - if(last) exit - enddo - - worst=bigworst - avg=bigavg - xsync=bigxsync - sig=bigsig - ndf0=ndf0big - nfdot=nfdotbig - msg=msgbig - msglen=msglenbig - t2=bigt2 - tana=bigtana - - isync=xsync - nworst=10.0*(worst-1.0) - navg=10.0*(avg-1.0) - if(nworst.gt.10) nworst=10 - if(navg.gt.10) navg=10 - - if(navg.le.0 .or. isync.lt.max(minsync,0)) then - msg=' ' - nworst=0 - navg=0 - ndf0=0 - nfdot=0 - sig=-20 - msglen=0 - tana=0. - t2=0. - endif - csync=' ' - if(isync.ge.1) csync='*' - nsig=nint(sig) - - if(nlines.le.maxlines-1) nlines = nlines + 1 - write(line(nlines),1020) cfile6,isync,nsig,t2,ndf0,nfdot,csync,msg(1:28), & - msglen,navg,nworst,tana,char(0) -1020 format(a6,2i4,f5.1,i5,i4,1x,a1,2x,a28,i4,i3,2x,i1,f5.1,a1) - - return -end subroutine iscat diff --git a/lib/jt4.f90 b/lib/jt4.f90 deleted file mode 100644 index 2140725..0000000 --- a/lib/jt4.f90 +++ /dev/null @@ -1,26 +0,0 @@ -module jt4 - parameter (MAXAVE=64) - integer iutc(MAXAVE) - integer nfsave(MAXAVE) - integer listutc(10) - real ppsave(207,7,MAXAVE) !Accumulated data for message averaging - real rsymbol(207,7) - real dtsave(MAXAVE) - real syncsave(MAXAVE) - real flipsave(MAXAVE) - real zz(1260,65,7) - - integer nsave,nlist,ich1,ich2 - integer nch(7) - integer npr(207) - data rsymbol/1449*0.0/ - data nch/1,2,4,9,18,36,72/ - data npr/ & - 0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, & - 0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, & - 1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, & - 0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, & - 0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, & - 0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, & - 1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/ -end module jt4 diff --git a/lib/jt4_decode.f90 b/lib/jt4_decode.f90 deleted file mode 100644 index 3540b0c..0000000 --- a/lib/jt4_decode.f90 +++ /dev/null @@ -1,420 +0,0 @@ -module jt4_decode - type :: jt4_decoder - procedure(jt4_decode_callback), pointer :: decode_callback => null () - procedure(jt4_average_callback), pointer :: average_callback => null () - contains - procedure :: decode - procedure, private :: wsjt4, avg4 - end type jt4_decoder - -! Callback function to be called with each decode - abstract interface - subroutine jt4_decode_callback (this, snr, dt, freq, have_sync, & - sync, is_deep, decoded, qual, ich, is_average, ave) - import jt4_decoder - implicit none - class(jt4_decoder), intent(inout) :: this - integer, intent(in) :: snr - real, intent(in) :: dt - integer, intent(in) :: freq - logical, intent(in) :: have_sync - logical, intent(in) :: is_deep - character(len=1), intent(in) :: sync - character(len=22), intent(in) :: decoded - real, intent(in) :: qual - integer, intent(in) :: ich - logical, intent(in) :: is_average - integer, intent(in) :: ave - end subroutine jt4_decode_callback - end interface - -! Callback function to be called with each average result - abstract interface - subroutine jt4_average_callback (this, used, utc, sync, dt, freq, flip) - import jt4_decoder - implicit none - class(jt4_decoder), intent(inout) :: this - logical, intent(in) :: used - integer, intent(in) :: utc - real, intent(in) :: sync - real, intent(in) :: dt - integer, intent(in) :: freq - logical, intent(in) :: flip - end subroutine jt4_average_callback - end interface - -contains - - subroutine decode(this,decode_callback,dd,jz,nutc,nfqso,ntol0,emedelay, & - dttol,nagain,ndepth,nclearave,minsync,minw,nsubmode,mycall,hiscall, & - hisgrid,nlist0,listutc0,average_callback) - - use jt4 - use timer_module, only: timer - - class(jt4_decoder), intent(inout) :: this - procedure(jt4_decode_callback) :: decode_callback - integer, intent(in) :: jz,nutc,nfqso,ntol0,ndepth,minsync,minw,nsubmode, & - nlist0,listutc0(10) - real, intent(in) :: dd(jz),emedelay,dttol - logical, intent(in) :: nagain, nclearave - character(len=12), intent(in) :: mycall,hiscall - character(len=6), intent(in) :: hisgrid - procedure(jt4_average_callback), optional :: average_callback - - real*4 dat(30*11025) - character*6 cfile6 - - this%decode_callback => decode_callback - if (present (average_callback)) then - this%average_callback => average_callback - end if - mode4=nch(nsubmode+1) - ntol=ntol0 - neme=0 - lumsg=6 !### temp ? ### - ndiag=1 - nlist=nlist0 - listutc=listutc0 - - ! Lowpass filter and decimate by 2 - call timer('lpf1 ',0) - call lpf1(dd,jz,dat,jz2) - call timer('lpf1 ',1) - - write(cfile6(1:4),1000) nutc -1000 format(i4.4) - cfile6(5:6)=' ' - - call timer('wsjt4 ',0) - call this%wsjt4(dat,jz2,nutc,NClearAve,minsync,ntol,emedelay,dttol,mode4, & - minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme) - call timer('wsjt4 ',1) - - return - end subroutine decode - - subroutine wsjt4(this,dat,npts,nutc,NClearAve,minsync,ntol,emedelay,dttol, & - mode4,minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme) - -! Orchestrates the process of decoding JT4 messages. Note that JT4 -! always operates as if in "Single Decode" mode; it looks for only one -! decodable signal in the FTol range. - - use jt4 - use timer_module, only: timer - - class(jt4_decoder), intent(inout) :: this - integer, intent(in) :: npts,nutc,minsync,ntol,mode4,minw, & - nfqso,ndepth,neme - logical, intent(in) :: NAgain,NClearAve - character(len=12), intent(in) :: mycall,hiscall - character(len=6), intent(in) :: hisgrid - real, intent(in) :: dat(npts) !Raw data - - real ccfblue(-5:540) !CCF in time - real ccfred(-224:224) !CCF in frequency - real ps0(450) - -! real z(458,65) - logical first,prtavg - character decoded*22,special*5 - character*22 avemsg,deepmsg,deepave,blank,deepmsg0,deepave1 - character csync*1 - data first/.true./,nutc0/-999/,nfreq0/-999999/ - save - - if(first) then - nsave=0 - first=.false. - blank=' ' - ccfblue=0. - ccfred=0. -! Silence compiler warnings - if(dttol.eq.-99.0 .and. emedelay.eq.-99.0 .and. nagain) stop - endif - - zz=0. -! syncmin=3.0 + minsync - syncmin=1.0+minsync - naggressive=0 - if(ndepth.ge.2) naggressive=1 - nq1=3 - nq2=6 - if(naggressive.eq.1) nq1=1 - if(NClearAve) then - nsave=0 - iutc=-1 - nfsave=0. - listutc=0 - ppsave=0. - rsymbol=0. - dtsave=0. - syncsave=0. - nfanoave=0 - ndeepave=0 - endif - -! Attempt to synchronize: look for sync pattern, get DF and DT. - call timer('sync4 ',0) - mousedf=nint(nfqso + 1.5*4.375*mode4 - 1270.46) - call sync4(dat,npts,ntol,1,MouseDF,4,mode4,minw+1,dtx,dfx, & - snrx,snrsync,ccfblue,ccfred,flip,width,ps0) - sync=snrsync - dtxz=dtx-0.8 - nfreqz=dfx + 1270.46 - 1.5*4.375*mode4 - call timer('sync4 ',1) - - snrx=db(sync) - 26. - nsnr=nint(snrx) - if(sync.lt.syncmin) then - if (associated (this%decode_callback)) then - call this%decode_callback(nsnr,dtxz,nfreqz,.false.,csync, & - .false.,decoded,0.,ich,.false.,0) - end if - go to 990 - endif - -! We have achieved sync - decoded=blank - deepmsg=blank - special=' ' - nsync=sync - nsnrlim=-33 - csync='*' - if(flip.lt.0.0) csync='#' - qbest=0. - qabest=0. - prtavg=.false. - - do idt=-2,2 - dtx=dtxz + 0.03*idt - nfreq=nfreqz + 2*idf - -! Attempt a single-sequence decode, including deep4 if Fano fails. - call timer('decode4 ',0) - call decode4(dat,npts,dtx,nfreq,flip,mode4,ndepth,neme,minw, & - mycall,hiscall,hisgrid,decoded,nfano,deepmsg,qual,ich) - call timer('decode4 ',1) - - if(nfano.gt.0) then -! Fano succeeded: report the message and return !Fano OK - if (associated (this%decode_callback)) then - call this%decode_callback(nsnr,dtx,nfreq,.true.,csync, & - .false.,decoded,99.,ich,.false.,0) - end if - nsave=0 - go to 990 - - else !Fano failed - if(qual.gt.qbest) then - dtx0=dtx - nfreq0=nfreq - deepmsg0=deepmsg - ich0=ich - qbest=qual - endif - endif - - if(idt.ne.0) cycle -! Single-sequence Fano decode failed, so try for an average Fano decode: - qave=0. -! If we're doing averaging, call avg4 - if(iand(ndepth,16).eq.16 .and. (.not.prtavg)) then - if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then -! This is a new minute or a new frequency, so call avg4. - nutc0=nutc !Try decoding average - nfreq0=nfreq - nsave=nsave+1 - nsave=mod(nsave-1,64)+1 - call timer('avg4 ',0) - call this%avg4(nutc,sync,dtx,flip,nfreq,mode4,ntol,ndepth,neme, & - mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ich, & - ndeepave) - call timer('avg4 ',1) - endif - - if(nfanoave.gt.0) then -! Fano succeeded: report the message AVG FANO OK - if (associated (this%decode_callback)) then - call this%decode_callback(nsnr,dtx,nfreq,.true.,csync, & - .false.,avemsg,99.,ich,.true.,nfanoave) - end if - prtavg=.true. - cycle - else - if(qave.gt.qabest) then - dtx1=dtx - nfreq1=nfreq - deepave1=deepave - ich1=ich - qabest=qave - endif - endif - endif - enddo - - dtx=dtx0 - nfreq=nfreq0 - deepmsg=deepmsg0 - ich=ich0 - qual=qbest - - if (associated (this%decode_callback)) then - if(int(qual).ge.nq1) then - call this%decode_callback(nsnr,dtx,nfreqz,.true.,csync,.true., & - deepmsg,qual,ich,.false.,0) - else - call this%decode_callback(nsnr,dtxz,nfreqz,.true.,csync, & - .false.,blank,0.,ich,.false.,0) - endif - end if - - dtx=dtx1 - nfreq=nfreq1 - deepave=deepave1 - ich=ich1 - qave=qabest - - if (associated (this%decode_callback) .and. ndeepave.ge.2) then - if(int(qave).ge.nq1) then - call this%decode_callback(nsnr,dtx,nfreq,.true.,csync,.true., & - deepave,qave,ich,.true.,ndeepave) - endif - end if - -990 return - end subroutine wsjt4 - - subroutine avg4(this,nutc,snrsync,dtxx,flip,nfreq,mode4,ntol,ndepth,neme, & - mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ichbest,ndeepave) - -! Decodes averaged JT4 data - - use jt4 - class(jt4_decoder), intent(inout) :: this - - character*22 avemsg,deepave,deepbest - character mycall*12,hiscall*12,hisgrid*6 - character*1 csync,cused(64) - real sym(207,7) - integer iused(64) - logical first - data first/.true./ - save - - if(first) then - iutc=-1 - nfsave=0 - dtdiff=0.2 - first=.false. - endif - - do i=1,64 - if(nutc.eq.iutc(i) .and. abs(nfreq-nfsave(i)).le.ntol) go to 10 - enddo - -! Save data for message averaging - iutc(nsave)=nutc - syncsave(nsave)=snrsync - dtsave(nsave)=dtxx - nfsave(nsave)=nfreq - flipsave(nsave)=flip - ppsave(1:207,1:7,nsave)=rsymbol(1:207,1:7) - -10 sym=0. - syncsum=0. - dtsum=0. - nfsum=0 - nsum=0 - - do i=1,64 - cused(i)='.' - if(iutc(i).lt.0) cycle - if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same sequence - if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match - if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match - if(flip.ne.flipsave(i)) cycle !Sync (*/#) must match - sym(1:207,1:7)=sym(1:207,1:7) + ppsave(1:207,1:7,i) - syncsum=syncsum + syncsave(i) - dtsum=dtsum + dtsave(i) - nfsum=nfsum + nfsave(i) - cused(i)='$' - nsum=nsum+1 - iused(nsum)=i - enddo - if(nsum.lt.64) iused(nsum+1)=0 - - syncave=0. - dtave=0. - fave=0. - if(nsum.gt.0) then - sym=sym/nsum - syncave=syncsum/nsum - dtave=dtsum/nsum - fave=float(nfsum)/nsum - endif - - do i=1,nsave - csync='*' - if(flipsave(i).lt.0.0) csync='#' - if (associated (this%average_callback)) then - call this%average_callback(cused(i) .eq. '$',iutc(i), & - syncsave(i),dtsave(i),nfsave(i),flipsave(i).lt.0.) - end if - enddo - - sqt=0. - sqf=0. - do j=1,64 - i=iused(j) - if(i.eq.0) exit - csync='*' - if(flipsave(i).lt.0.0) csync='#' - sqt=sqt + (dtsave(i)-dtave)**2 - sqf=sqf + (nfsave(i)-fave)**2 - enddo - rmst=0. - rmsf=0. - if(nsum.ge.2) then - rmst=sqrt(sqt/(nsum-1)) - rmsf=sqrt(sqf/(nsum-1)) - endif - kbest=ich1 - do k=ich1,ich2 - call extract4(sym(1,k),ncount,avemsg) !Do the Fano decode - nfanoave=0 - if(ncount.ge.0) then - ichbest=k - nfanoave=nsum - go to 900 - endif - if(nch(k).ge.mode4) exit - enddo - - deepave=' ' - qave=0. - -! Possibly should pass nadd=nused, also ? - if(iand(ndepth,32).eq.32) then - flipx=1.0 !Normal flip not relevant for ave msg - qbest=0. - do k=ich1,ich2 - call deep4(sym(2,k),neme,flipx,mycall,hiscall,hisgrid,deepave,qave) - if(qave.gt.qbest) then - qbest=qave - deepbest=deepave - kbest=k - ndeepave=nsum - endif - if(nch(k).ge.mode4) exit - enddo - - deepave=deepbest - qave=qbest - ichbest=kbest - endif - -900 return - end subroutine avg4 -end module jt4_decode diff --git a/lib/jt65.f90 b/lib/jt65.f90 deleted file mode 100644 index bce3a4f..0000000 --- a/lib/jt65.f90 +++ /dev/null @@ -1,143 +0,0 @@ -program jt65 - - ! Test the JT65 decoder for WSJT-X - - use options - use timer_module, only: timer - use timer_impl, only: init_timer - use jt65_test - use readwav - - character c,mode - logical :: display_help=.false.,nrobust=.false.,single_decode=.false., ljt65apon=.false. - type(wav_header) :: wav - integer*2 id2(NZMAX) - real*4 dd(NZMAX) - character*80 infile - character(len=500) optarg - character*12 mycall,hiscall - character*6 hisgrid - - type (option) :: long_options(12) = [ & - option ('aggressive',.true.,'a','aggressiveness [0-10], default AGGR=0','AGGR'), & - option ('depth',.true.,'d','depth=5 hinted decoding, default DEPTH=0','DEPTH'), & - option ('freq',.true.,'f','signal frequency, default FREQ=1270','FREQ'), & - option ('help',.false.,'h','Display this help message',''), & - option ('mode',.true.,'m','Mode A, B, C. Default is A.','MODE'), & - option ('ntrials',.true.,'n','number of trials, default TRIALS=10000','TRIALS'), & - option ('robust-sync',.false.,'r','robust sync',''), & - option ('my-call',.true.,'c','my callsign',''), & - option ('his-call',.true.,'x','his callsign',''), & - option ('his-grid',.true.,'g','his grid locator',''), & - option ('experience-decoding',.true.,'X' & - ,'experience decoding options (1..n), default FLAGS=0','FLAGS'), & - option ('single-signal-mode',.false.,'s','decode at signal frequency only','') ] - - naggressive=10 - nfqso=1500 - ntrials=100000 - nexp_decode=0 - ntol=20 - nsubmode=0 - nlow=200 - nhigh=4000 - n2pass=1 - ndepth=1 - nQSOProgress=6 - - do - call getopt('a:d:f:hm:n:rc:x:g:X:s',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.) - if( nstat .ne. 0 ) then - exit - end if - select case (c) - case ('a') - read (optarg(:narglen), *) naggressive - case ('d') - read (optarg(:narglen), *) ndepth - case ('f') - read (optarg(:narglen), *) nfqso - case ('h') - display_help = .true. - case ('m') - read (optarg(:narglen), *) mode - if( mode .eq. 'b' .or. mode .eq. 'B' ) then - nsubmode=1 - endif - if( mode .eq. 'c' .or. mode .eq. 'C' ) then - nsubmode=2 - endif - case ('n') - read (optarg(:narglen), *) ntrials - case ('r') - nrobust=.true. - case ('c') - read (optarg(:narglen), *) mycall - case ('x') - read (optarg(:narglen), *) hiscall - case ('g') - read (optarg(:narglen), *) hisgrid - case ('X') - read (optarg(:narglen), *) nexp_decode - case ('s') - single_decode=.true. - ntol=100 - nlow=nfqso-ntol - nhigh=nfqso+ntol - n2pass=1 - end select - end do - - if(single_decode) nexp_decode=ior(nexp_decode,32) - if(display_help .or. nstat.lt.0 .or. nremain.lt.1) then - print *, '' - print *, 'Usage: jt65 [OPTIONS] file1 [file2 ...]' - print *, '' - print *, ' JT65 decode pre-recorded .WAV file(s)' - print *, '' - print *, 'OPTIONS:' - print *, '' - do i = 1, size (long_options) - call long_options(i) % print (6) - end do - go to 999 - endif - - call init_timer ('timer.out') - call timer('jt65 ',0) - - ndecoded=0 - do ifile=noffset+1,noffset+nremain - nfa=nlow - nfb=nhigh - minsync=0 - call get_command_argument(ifile,optarg,narglen) - infile=optarg(:narglen) - call timer('read ',0) - call wav%read (infile) - i1=index(infile,'.wav') - if( i1 .eq. 0 ) i1=index(infile,'.WAV') - read(infile(i1-4:i1-1),*,err=998) nutc - npts=52*12000 - read(unit=wav%lun) id2(1:npts) - close(unit=wav%lun) - call timer('read ',1) - dd(1:npts)=id2(1:npts) - dd(npts+1:)=0. - call test(dd,nutc,nfa,nfb,nfqso,ntol,nsubmode, & - n2pass,nrobust,ntrials,naggressive,ndepth, & - mycall,hiscall,hisgrid,nexp_decode,nQSOProgress,ljt65apon) -! if(nft.gt.0) exit - enddo - - call timer('jt65 ',1) - call timer('jt65 ',101) - ! call four2a(a,-1,1,1,1) !Free the memory used for plans - ! call filbig(a,-1,1,0.0,0,0,0,0,0) ! (ditto) - go to 999 - -998 print*,'Cannot read from file:' - print*,infile - -999 continue -end program jt65 diff --git a/lib/jt65_decode.f90 b/lib/jt65_decode.f90 deleted file mode 100644 index 4a899b8..0000000 --- a/lib/jt65_decode.f90 +++ /dev/null @@ -1,524 +0,0 @@ -module jt65_decode - - integer, parameter :: NSZ=3413, NZMAX=60*12000 - - type :: jt65_decoder - procedure(jt65_decode_callback), pointer :: callback => null() - contains - procedure :: decode - end type jt65_decoder - -! Callback function to be called with each decode - abstract interface - subroutine jt65_decode_callback(this,sync,snr,dt,freq,drift, & - nflip,width,decoded,ft,qual,nsmo,nsum,minsync) - - import jt65_decoder - implicit none - class(jt65_decoder), intent(inout) :: this - real, intent(in) :: sync - integer, intent(in) :: snr - real, intent(in) :: dt - integer, intent(in) :: freq - integer, intent(in) :: drift - integer, intent(in) :: nflip - real, intent(in) :: width - character(len=22), intent(in) :: decoded - integer, intent(in) :: ft - integer, intent(in) :: qual - integer, intent(in) :: nsmo - integer, intent(in) :: nsum - integer, intent(in) :: minsync - - end subroutine jt65_decode_callback - end interface - -contains - - subroutine decode(this,callback,dd0,npts,newdat,nutc,nf1,nf2,nfqso, & - ntol,nsubmode,minsync,nagain,n2pass,nrobust,ntrials,naggressive, & - ndepth,emedelay,clearave,mycall,hiscall,hisgrid,nexp_decode, & - nQSOProgress,ljt65apon) - -! Process dd0() data to find and decode JT65 signals. - - use jt65_mod - use timer_module, only: timer - - include 'constants.f90' - - class(jt65_decoder), intent(inout) :: this - procedure(jt65_decode_callback) :: callback - real, intent(in) :: dd0(NZMAX),emedelay - integer, intent(in) :: npts, nutc, nf1, nf2, nfqso, ntol & - , nsubmode, minsync, n2pass, ntrials, naggressive, ndepth & - , nexp_decode, nQSOProgress - logical, intent(in) :: newdat, nagain, nrobust, clearave, ljt65apon - character(len=12), intent(in) :: mycall, hiscall - character(len=6), intent(in) :: hisgrid - - real dd(NZMAX) - real ss(552,NSZ) - real savg(NSZ) - real a(5) - character*22 decoded,decoded0,avemsg,deepave - type candidate - real freq - real dt - real sync - real flip - end type candidate - type(candidate) ca(300) - type accepted_decode - real freq - real dt - real sync - character*22 decoded - end type accepted_decode - type(accepted_decode) dec(50) - logical :: first_time,prtavg,single_decode,bVHF - - integer h0(0:11),d0(0:11) - real r0(0:11) - common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano - common/steve/thresh0 - common/sync/ss - -! 0 1 2 3 4 5 6 7 8 9 10 11 - data h0/41,42,43,43,44,45,46,47,48,48,49,49/ - data d0/71,72,73,74,76,77,78,80,81,82,83,83/ - -! 0 1 2 3 4 5 6 7 8 9 10 11 - data r0/0.70,0.72,0.74,0.76,0.78,0.80,0.82,0.84,0.86,0.88,0.90,0.90/ - data nutc0/-999/,nfreq0/-999/,nsave/0/ - save - - this%callback => callback - first_time=newdat - dd=dd0 - ndecoded=0 - - if(nsubmode.ge.100) then -! This is QRA64 mode - mode64=2**(nsubmode-100) -!### -! open(60,file='qra64_data.bin',access='stream',position='append') -! write(60) dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & -! mycall,hiscall,hisgrid -! close(60) -!### - call qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & - emedelay,mycall,hiscall,hisgrid,sync,nsnr,dtx,nfreq,decoded,nft) - if (associated(this%callback)) then - ndrift=0 - nflip=1 - width=1.0 - nsmo=0 - nqual=0 - call this%callback(sync,nsnr,dtx,nfreq,ndrift, & - nflip,width,decoded,nft,nqual,nsmo,1,minsync) - end if - go to 900 - endif - - single_decode=iand(nexp_decode,32).ne.0 .or. nagain - bVHF=iand(nexp_decode,64).ne.0 - - if( bVHF ) then - nvec=ntrials - npass=1 - if(n2pass.gt.1) npass=2 - else - nvec=1000 - if(ndepth.eq.1) then - npass=2 - nvec=100 - elseif(ndepth.eq.2) then - npass=2 - nvec=1000 - else - npass=4 - nvec=1000 - endif - endif - do ipass=1,npass - first_time=.true. - if(ipass.eq.1) then !First-pass parameters - thresh0=2.5 - nsubtract=1 - nrob=0 - elseif( ipass.eq.2 ) then !Second-pass parameters - thresh0=2.0 - nsubtract=1 - nrob=0 - elseif( ipass.eq.3 ) then - thresh0=2.0 - nsubtract=1 - nrob=0 - elseif( ipass.eq.4 ) then - thresh0=2.0 - nsubtract=0 - nrob=1 - endif - if(npass.eq.1) then - nsubtract=0 - thresh0=2.0 - endif - - call timer('symsp65 ',0) - ss=0. - call symspec65(dd,npts,nqsym,savg) !Get normalized symbol spectra - call timer('symsp65 ',1) - nfa=nf1 - nfb=nf2 - -!### Q: should either of the next two uses of "single_decode" be "bVHF" instead? - if(single_decode .or. (bVHF .and. ntol.lt.1000)) then - nfa=max(200,nfqso-ntol) - nfb=min(4000,nfqso+ntol) - thresh0=1.0 - endif - df=12000.0/8192.0 !df = 1.465 Hz - if(bVHF) then - ia=max(1,nint(nfa/df)-ntol) - ib=min(NSZ,nint(nfb/df)+ntol) - nz=ib-ia+1 - call lorentzian(savg(ia),nz,a) - baseline=a(1) - amp=a(2) - f0=(a(3)+ia-1)*df - width=a(4)*df - endif - - ncand=0 - call timer('sync65 ',0) - call sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrob,bVHF) - call timer('sync65 ',1) - -! If a candidate was found within +/- ntol of nfqso, move it into ca(1). - call fqso_first(nfqso,ntol,ca,ncand) - if(single_decode) then - if(ncand.eq.0) ncand=1 - if(abs(ca(1)%freq - f0).gt.width) width=2*df !### ??? ### - endif - - mode65=2**nsubmode - nflip=1 - nqd=0 - decoded=' ' - decoded0="" - freq0=0. - prtavg=.false. - if(.not.nagain) nsum=0 - if(clearave) then - nsum=0 - nsave=0 - endif - - if(bVHF) then -! Be sure to search for shorthand message at nfqso +/- ntol - if(ncand.lt.300) ncand=ncand+1 - ca(ncand)%sync=5.0 - ca(ncand)%dt=2.5 - ca(ncand)%freq=nfqso - endif - do icand=1,ncand - sync1=ca(icand)%sync - dtx=ca(icand)%dt - freq=ca(icand)%freq - if(bVHF) then - flip=ca(icand)%flip - nflip=flip - endif - if(sync1.lt.float(minsync)) nflip=0 - if(ipass.eq.1) ntry65a=ntry65a + 1 - if(ipass.eq.2) ntry65b=ntry65b + 1 - call timer('decod65a',0) - nft=0 - nspecial=0 - call decode65a(dd,npts,first_time,nqd,freq,nflip,mode65,nvec, & - naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, & - ljt65apon,nexp_decode,bVHF,sync2,a,dtx,nft,nspecial,qual, & - nhist,nsmo,decoded) - if(nspecial.eq.2) decoded='RO' - if(nspecial.eq.3) decoded='RRR' - if(nspecial.eq.4) decoded='73' - call timer('decod65a',1) - if(sync1.lt.float(minsync) .and. & - decoded.eq.' ') nflip=0 - if(nft.ne.0) nsum=1 - - nhard_min=param(1) - nrtt1000=param(4) - ntotal_min=param(5) - nsmo=param(9) - - nfreq=nint(freq+a(1)) - ndrift=nint(2.0*a(2)) - if(bVHF) then - xtmp=10**((sync1+16.0)/10.0) ! sync comes to us in dB - s2db=1.1*db(xtmp)+1.4*(dB(width)-4.3)-52.0 -! s2db=sync1 - 30.0 + db(width/3.3) !### VHF/UHF/microwave - if(nspecial.gt.0) s2db=sync2 - else - s2db=10.0*log10(sync2) - 35 !### Empirical (HF) - endif - nsnr=nint(s2db) - if(nsnr.lt.-30) nsnr=-30 - if(nsnr.gt.-1) nsnr=-1 - nftt=0 - -!********* DOES THIS STILL WORK WHEN NFT INCLUDES # OF AP SYMBOLS USED?? - if(nft.ne.1 .and. iand(ndepth,16).eq.16 .and. (.not.prtavg)) then -! Single-sequence FT decode failed, so try for an average FT decode. - if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then -! This is a new minute or a new frequency, so call avg65. - nutc0=nutc - nfreq0=nfreq - nsave=nsave+1 - nsave=mod(nsave-1,64)+1 - call avg65(nutc,nsave,sync1,dtx,nflip,nfreq,mode65,ntol, & - ndepth,nagain,ntrials,naggressive,clearave,neme,mycall, & - hiscall,hisgrid,nftt,avemsg,qave,deepave,nsum,ndeepave, & - nQSOProgress,ljt65apon) - nsmo=param(9) - nqave=qave - - if (associated(this%callback) .and. nsum.ge.2) then - call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, & - nflip,width,avemsg,nftt,nqave,nsmo,nsum,minsync) - prtavg=.true. - end if - - endif - endif - - if(nftt.eq.1) then -! nft=1 - decoded=avemsg - go to 5 - endif - n=naggressive - rtt=0.001*nrtt1000 - if(nft.lt.2 .and. minsync.ge.0 .and. nspecial.eq.0) then - if(nhard_min.gt.50) cycle - if(nhard_min.gt.h0(n)) cycle - if(ntotal_min.gt.d0(n)) cycle - if(rtt.gt.r0(n)) cycle - endif - -5 continue - if(decoded.eq.decoded0 .and. abs(freq-freq0).lt. 3.0 .and. & - minsync.ge.0) cycle !Don't display dupes - if(decoded.ne.' ' .or. minsync.lt.0) then - if(nsubtract.eq.1) then - call timer('subtr65 ',0) - call subtract65(dd,npts,freq,dtx) - call timer('subtr65 ',1) - endif - - ndupe=0 ! de-dedupe - do i=1, ndecoded - if(decoded==dec(i)%decoded) then - ndupe=1 - exit - endif - enddo - if(ndupe.ne.1 .and. sync1.ge.float(minsync)) then - if(ipass.eq.1) n65a=n65a + 1 - if(ipass.eq.2) n65b=n65b + 1 - if(ndecoded.lt.50) ndecoded=ndecoded+1 - dec(ndecoded)%freq=freq+a(1) - dec(ndecoded)%dt=dtx - dec(ndecoded)%sync=sync2 - dec(ndecoded)%decoded=decoded - nqual=min(qual,9999.0) - - if (associated(this%callback)) then - call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, & - nflip,width,decoded,nft,nqual,nsmo,1,minsync) - end if - endif - decoded0=decoded - freq0=freq - if(decoded0.eq.' ') decoded0='*' - endif - enddo !Candidate loop - if(ipass.eq.2 .and. ndecoded.lt.1) exit - enddo !Multiple-pass loop -900 return - end subroutine decode - - subroutine avg65(nutc,nsave,snrsync,dtxx,nflip,nfreq,mode65,ntol,ndepth, & - nagain, ntrials,naggressive,clearave,neme,mycall,hiscall,hisgrid,nftt, & - avemsg,qave,deepave,nsum,ndeepave,nQSOProgress,ljt65apon) - -! Decodes averaged JT65 data - - use jt65_mod - parameter (MAXAVE=64) - character*22 avemsg,deepave,deepbest - character mycall*12,hiscall*12,hisgrid*6 - character*1 csync,cused(64) - logical nagain - integer iused(64) -! Accumulated data for message averaging - integer iutc(MAXAVE) - integer nfsave(MAXAVE) - integer nflipsave(MAXAVE) - real s1b(-255:256,126) - real s1save(-255:256,126,MAXAVE) - real s2(66,126) - real s3save(64,63,MAXAVE) - real s3b(64,63) - real s3c(64,63) - real dtsave(MAXAVE) - real syncsave(MAXAVE) - logical first,clearave,ljt65apon - data first/.true./ - save - - if(first .or. clearave) then - iutc=-1 - nfsave=0 - dtdiff=0.2 - first=.false. - s3save=0. - s1save=0. - nsave=1 !### ??? -! Silence compiler warnings - if(nagain .and. ndeepave.eq.-99 .and. neme.eq.-99) stop - endif - - do i=1,64 - if(iutc(i).lt.0) exit - if(nutc.eq.iutc(i) .and. abs(nfreq-nfsave(i)).le.ntol) go to 10 - enddo - -! Save data for message averaging - iutc(nsave)=nutc - syncsave(nsave)=snrsync - dtsave(nsave)=dtxx - nfsave(nsave)=nfreq - nflipsave(nsave)=nflip - s1save(-255:256,1:126,nsave)=s1 - s3save(1:64,1:63,nsave)=s3a - -10 syncsum=0. - dtsum=0. - nfsum=0 - nsum=0 - s1b=0. - s3b=0. - s3c=0. - - do i=1,MAXAVE !Consider all saved spectra - cused(i)='.' - if(iutc(i).lt.0) cycle - if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same (odd/even) seq - if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match - if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match - if(nflip.ne.nflipsave(i)) cycle !Sync type (*/#) must match - s3b=s3b + s3save(1:64,1:63,i) - s1b=s1b + s1save(-255:256,1:126,i) - syncsum=syncsum + syncsave(i) - dtsum=dtsum + dtsave(i) - nfsum=nfsum + nfsave(i) - cused(i)='$' - nsum=nsum+1 - iused(nsum)=i - enddo - if(nsum.lt.64) iused(nsum+1)=0 - - syncave=0. - dtave=0. - fave=0. - if(nsum.gt.0) then - syncave=syncsum/nsum - dtave=dtsum/nsum - fave=float(nfsum)/nsum - endif - - do i=1,nsave - csync='*' - if(nflipsave(i).lt.0.0) csync='#' - write(14,1000) cused(i),iutc(i),syncsave(i),dtsave(i)-1.0,nfsave(i),csync -1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1) - enddo - if(nsum.lt.2) go to 900 - - nftt=0 - df=1378.125/512.0 - -! Do the smoothing loop - qualbest=0. - minsmo=0 - maxsmo=0 - if(mode65.ge.2) then - minsmo=nint(width/df) - maxsmo=2*minsmo - endif - nn=0 - do ismo=minsmo,maxsmo - if(ismo.gt.0) then - do j=1,126 - call smo121(s1b(-255,j),512) - if(j.eq.1) nn=nn+1 - if(nn.ge.4) then - call smo121(s1b(-255,j),512) - if(j.eq.1) nn=nn+1 - endif - enddo - endif - - do i=1,66 - jj=i - if(mode65.eq.2) jj=2*i-1 - if(mode65.eq.4) then - ff=4*(i-1)*df - 355.297852 - jj=nint(ff/df)+1 - endif - s2(i,1:126)=s1b(jj,1:126) - enddo - - do j=1,63 - k=mdat(j) !Points to data symbol - if(nflip.lt.0) k=mdat2(j) - do i=1,64 - s3c(i,j)=4.e-5*s2(i+2,k) - enddo - enddo - - nadd=nsum*ismo - call extract(s3c,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, & - hiscall,hisgrid,nQSOProgress,ljt65apon,nexp_decode,ncount,nhist, & - avemsg,ltext,nftt,qual) - if(nftt.eq.1) then - nsmo=ismo - param(9)=nsmo - go to 900 - else if(nftt.eq.2) then - if(qual.gt.qualbest) then - deepbest=avemsg - qualbest=qual - nnbest=nn - nsmobest=ismo - nfttbest=nftt - endif - endif - enddo - - if(nfttbest.eq.2) then - avemsg=deepbest !### ??? - deepave=deepbest - qave=qualbest - nsmo=nsmobest - param(9)=nsmo - nftt=nfttbest - endif -900 continue - - return - end subroutine avg65 - -end module jt65_decode diff --git a/lib/jt65_mod.f90 b/lib/jt65_mod.f90 deleted file mode 100644 index 9bf9e26..0000000 --- a/lib/jt65_mod.f90 +++ /dev/null @@ -1,13 +0,0 @@ -module jt65_mod - - integer param(0:9) - integer mrs(63) - integer mrs2(63) - integer mdat(126),mref(126,2),mdat2(126),mref2(126,2) !From prcom - - real s1(-255:256,126) - real s3a(64,63) - real pr(126) - real width - -end module jt65_mod diff --git a/lib/jt65_test.f90 b/lib/jt65_test.f90 deleted file mode 100644 index d6a80a2..0000000 --- a/lib/jt65_test.f90 +++ /dev/null @@ -1,78 +0,0 @@ -module jt65_test - - ! Test the JT65 decoder for WSJT-X - - implicit none - - public :: test - integer, parameter, public :: NZMAX=60*12000 - integer, public :: nft - -contains - - subroutine test (dd,nutc,nflow,nfhigh,nfqso,ntol,nsubmode,n2pass,nrobust & - ,ntrials,naggressive,ndepth,mycall,hiscall,hisgrid,nexp_decode, & - nQSOProgress,ljt65apon) - use timer_module, only: timer - use jt65_decode - implicit none - - include 'constants.f90' - real, intent(in) :: dd(NZMAX) - integer, intent(in) :: nutc, nflow, nfhigh, nfqso, ntol, nsubmode, n2pass & - , ntrials, naggressive, ndepth, nexp_decode, nQSOProgress - logical, intent(in) :: nrobust,ljt65apon - character(len=12), intent(in) :: mycall, hiscall - character(len=6), intent(in) :: hisgrid - type(jt65_decoder) :: my_decoder - logical nclearave !### Should be a dummy arg? - nclearave=.false. - - call timer('jt65a ',0) - call my_decoder%decode(my_callback,dd,npts=52*12000,newdat=.true., & - nutc=nutc,nf1=nflow,nf2=nfhigh,nfqso=nfqso,ntol=ntol, & - nsubmode=nsubmode, minsync=-1,nagain=.false.,n2pass=n2pass, & - nrobust=nrobust,ntrials=ntrials,naggressive=naggressive, & - ndepth=ndepth,emedelay=0.0,clearave=nclearave,mycall=mycall, & - hiscall=hiscall,hisgrid=hisgrid,nexp_decode=nexp_decode, & - nQSOProgress=nQSOProgress,ljt65apon=ljt65apon) - call timer('jt65a ',1) - end subroutine test - - subroutine my_callback (this,sync,snr,dt,freq,drift,nflip,width, & - decoded,ft,qual,smo,sum,minsync) - use jt65_decode - implicit none - - class(jt65_decoder), intent(inout) :: this - real, intent(in) :: sync - integer, intent(in) :: snr - real, intent(in) :: dt - integer, intent(in) :: freq - integer, intent(in) :: drift - integer, intent(in) :: nflip - real, intent(in) :: width - character(len=22), intent(in) :: decoded - integer, intent(in) :: ft - integer, intent(in) :: qual - integer, intent(in) :: smo - integer, intent(in) :: sum - integer, intent(in) :: minsync - - integer nwidth - real t - - if(minsync+nflip+qual.eq.-9999) stop !Silence compiler warning - t=max(0.0,width*width-7.2) - nwidth=max(nint(sqrt(t)),2) -!### deal with nflip here! ### -!### also single_decode, csync, etc... ### - write(*,1012) nint(sync),snr,dt,freq,drift,nwidth, & - decoded,ft,sum,smo -1012 format(i4,i5,f6.2,i5,i4,i3,1x,a22,' JT65',3i3) - nft=ft - call flush(6) - - end subroutine my_callback - -end module jt65_test diff --git a/lib/jt65code.f90 b/lib/jt65code.f90 deleted file mode 100644 index 4f2a4e0..0000000 --- a/lib/jt65code.f90 +++ /dev/null @@ -1,101 +0,0 @@ -program JT65code - -! Provides examples of message packing, bit and symbol ordering, -! Reed Solomon encoding, and other necessary details of the JT65 -! protocol. - - use packjt - character*22 msg,msgchk,msg0,msg1,decoded,cok*3,bad*1,msgtype*10,expected - integer dgen(12),sent(63),tmp(63),recd(12),era(51) - include 'testmsg.f90' - - nargs=iargc() - if(nargs.ne.1) then - print*,'Usage: jt65code "message"' - print*,' jt65code -t' - go to 999 - endif - - call getarg(1,msg) !Get message from command line - msgchk=msg - call fmtmsg(msgchk,iz) - nmsg=1 - if(msg(1:2).eq."-t") then - if (NTEST+5 > MAXTEST) then - write(*,*) "NTEST exceed MAXTEST" - endif - testmsg(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" - testmsg(NTEST+2)="KA1ABC WB9XYZ OOO" - testmsg(NTEST+3)="RO" - testmsg(NTEST+4)="RRR" - testmsg(NTEST+5)="73" - testmsgchk(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" - testmsgchk(NTEST+2)="KA1ABC WB9XYZ OOO" - testmsgchk(NTEST+3)="RO" - testmsgchk(NTEST+4)="RRR" - testmsgchk(NTEST+5)="73" - nmsg=NTEST+5 - endif - - write(*,1010) -1010 format(" Message Decoded Err? Type Expected"/ & - 76("-")) - - do imsg=1,nmsg - if(nmsg.gt.1) then - msg=testmsg(imsg) - msgchk=testmsgchk(imsg) - endif - - call fmtmsg(msg,iz) !To upper, collapse mult blanks - msg0=msg !Input message - call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report - msg1=msg !Message without "OOO" - - if(nspecial.gt.0) then !or is a shorthand message - if(nspecial.eq.2) decoded="RO" - if(nspecial.eq.3) decoded="RRR" - if(nspecial.eq.4) decoded="73" - itype=-1 - msgtype="Shorthand" - go to 10 - endif - - call packmsg(msg1,dgen,itype,.false.) !Pack message into 12 six-bit bytes - msgtype="" - if(itype.eq.1) msgtype="Std Msg" - if(itype.eq.2) msgtype="Type 1 pfx" - if(itype.eq.3) msgtype="Type 1 sfx" - if(itype.eq.4) msgtype="Type 2 pfx" - if(itype.eq.5) msgtype="Type 2 sfx" - if(itype.eq.6) msgtype="Free text" - - call rs_encode(dgen,sent) !RS encode - call interleave63(sent,1) !Interleave channel symbols - call graycode(sent,63,1,sent) !Apply Gray code - - call graycode(sent,63,-1,tmp) !Remove Gray code - call interleave63(tmp,-1) !Remove interleaving - call rs_decode(tmp,era,0,recd,nerr) !Decode the message - call unpackmsg(recd,decoded,.false.,' ') !Unpack the user message - if(cok.eq."OOO") decoded(20:22)=cok - call fmtmsg(decoded,iz) - -10 bad=" " - if(decoded.ne.msgchk) bad="*" - expected = 'EXACT' - if (msg0.ne.msgchk) expected = 'TRUNCATED' - if (nmsg.eq.1) expected = 'UNKNOWN' - write(*,1020) imsg,msg0,decoded,bad,itype,msgtype,expected -1020 format(i2,'.',1x,a22,1x,a22,1x,a1,i3,":",a10,2x,a22) - enddo - - if(nmsg.eq.1 .and. nspecial.eq.0) then - write(*,1030) dgen -1030 format(/'Packed message, 6-bit symbols ',12i3) !Display packed symbols - - write(*,1040) sent -1040 format(/'Information-carrying channel symbols'/(i5,20i3)) - endif - -999 end program JT65code diff --git a/lib/jt65sim.f90 b/lib/jt65sim.f90 deleted file mode 100644 index ba4285d..0000000 --- a/lib/jt65sim.f90 +++ /dev/null @@ -1,299 +0,0 @@ -program jt65sim - -! Generate simulated JT65 data for testing WSJT-X - - use wavhdr - use packjt - use options - parameter (NMAX=54*12000) ! = 648,000 @12kHz - parameter (NFFT=10*65536,NH=NFFT/2) - type(hdr) h !Header for .wav file - integer*2 iwave(NMAX) !Generated waveform - integer*4 itone(126) !Channel symbols (values 0-65) - integer dgen(12) !Twelve 6-bit data symbols - integer sent(63) !RS(63,12) codeword - real*4 xnoise(NMAX) !Generated random noise - real*4 dat(NMAX) !Generated real data - complex cdat(NMAX) !Generated complex waveform - complex cspread(0:NFFT-1) !Complex amplitude for Rayleigh fading - complex z - real*8 f0,dt,twopi,phi,dphi,baud,fsample,freq,sps - character msg*22,fname*11,csubmode*1,c,optarg*500,numbuf*32 -! character call1*5,call2*5 - logical :: display_help=.false.,seed_prngs=.true. - type (option) :: long_options(12) = [ & - option ('help',.false.,'h','Display this help message',''), & - option ('sub-mode',.true.,'m','sub mode, default MODE=A','MODE'), & - option ('num-sigs',.true.,'n','number of signals per file, default SIGNALS=10','SIGNALS'), & - option ('f0',.true.,'F','base frequency offset, default F0=1500.0','F0'), & - option ('doppler-spread',.true.,'d','Doppler spread, default SPREAD=0.0','SPREAD'), & - option ('time-offset',.true.,'t','Time delta, default SECONDS=0.0','SECONDS'), & - option ('num-files',.true.,'f','Number of files to generate, default FILES=1','FILES'), & - option ('no-prng-seed',.false.,'p','Do not seed PRNGs (use for reproducible tests)',''), & - option ('strength',.true.,'s','S/N in dB (2500Hz reference b/w), default SNR=0','SNR'), & - option ('11025',.false.,'S','Generate at 11025Hz sample rate, default 12000Hz',''), & - option ('gain-offset',.true.,'G','Gain offset in dB, default GAIN=0dB','GAIN'), & - option ('message',.true.,'M','Message text','Message') ] - - integer nprc(126) !Sync pattern - data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & - 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & - 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & - 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & - 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & - 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & - 1,1,1,1,1,1/ - -! Default parameters: - csubmode='A' - mode65=1 - nsigs=10 - bf0=1500. - fspread=0. - xdt=0. - snrdb=0. - nfiles=1 - nsample_rate=12000 - gain_offset=0. - msg="K1ABC W9XYZ EN37" - - do - call getopt('hm:n:F:d:t:f:ps:SG:M:',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.) - if( nstat .ne. 0 ) then - exit - end if - select case (c) - case ('h') - display_help = .true. - case ('m') - read (optarg(:narglen), *) csubmode - if(csubmode.eq.'A') mode65=1 - if(csubmode.eq.'B') mode65=2 - if(csubmode.eq.'C') mode65=4 - case ('n') - read (optarg(:narglen), *,err=10) nsigs - case ('F') - read (optarg(:narglen), *,err=10) bf0 - case ('d') - read (optarg(:narglen), *,err=10) fspread - case ('t') - read (optarg(:narglen), *) numbuf - if (numbuf(1:1) == '\') then !'\' - read (numbuf(2:), *,err=10) xdt - else - read (numbuf, *,err=10) xdt - end if - case ('f') - read (optarg(:narglen), *,err=10) nfiles - case ('p') - seed_prngs=.false. - case ('s') - read (optarg(:narglen), *) numbuf - if (numbuf(1:1) == '\') then !'\' - read (numbuf(2:), *,err=10) snrdb - else - read (numbuf, *,err=10) snrdb - end if - case ('S') - nsample_rate=11025 - case ('G') - read (optarg(:narglen), *) numbuf - if (numbuf(1:1) == '\') then !'\' - read (numbuf(2:), *, err=10) gain_offset - else - read (numbuf, *, err=10) gain_offset - end if - case ('M') - read (optarg(:narglen), '(A)',err=10) msg - write(*,*) msg - end select - cycle -10 display_help=.true. - print *, 'Optional argument format error for option -', c - end do - - if(display_help .or. nstat.lt.0 .or. nremain.ge.1) then - print *, '' - print *, 'Usage: jt65sim [OPTIONS]' - print *, '' - print *, ' Generate one or more simulated JT65 signals in .WAV file(s)' - print *, '' - print *, 'Example: jt65sim -m B -n 10 -d 0.2 -s \\-24.5 -t 0.0 -f 4' - print *, '' - print *, 'OPTIONS: NB Use \ (\\ on *nix shells) to escape -ve arguments' - print *, '' - do i = 1, size (long_options) - call long_options(i) % print (6) - end do - go to 999 - endif - - if (seed_prngs) then - call init_random_seed() ! seed Fortran RANDOM_NUMBER generator - call sgran() ! see C rand generator (used in gran) - end if - - rms=100. * 10. ** (gain_offset / 20.) - - fsample=nsample_rate !Sample rate (Hz) - dt=1.d0/fsample !Sample interval (s) - twopi=8.d0*atan(1.d0) - npts=54*nsample_rate !Total samples in .wav file - baud=11025.d0/4096.d0 !Keying rate - sps=real(nsample_rate)/baud !Samples per symbol, at fsample=NSAMPLE_RATE Hz - nsym=126 !Number of channel symbols - h=default_header(nsample_rate,npts) - dfsig=2000.0/nsigs !Freq spacing between sigs in file (Hz) - - do ifile=1,nfiles !Loop over requested number of files - write(fname,1002) ifile !Output filename -1002 format('000000_',i4.4) - open(10,file=fname//'.wav',access='stream',status='unknown') - - xnoise=0. - cdat=0. - if(snrdb.lt.90) then - do i=1,npts - xnoise(i)=gran() !Generate gaussian noise - enddo - endif - - do isig=1,nsigs !Generate requested number of sigs - if(mod(nsigs,2).eq.0) f0=bf0 + dfsig*(isig-0.5-nsigs/2) - if(mod(nsigs,2).eq.1) f0=bf0 + dfsig*(isig-(nsigs+1)/2) - xsnr=snrdb - if(snrdb.eq.0.0) xsnr=-19 - isig - if(csubmode.eq.'B' .and. snrdb.eq.0.0) xsnr=-21 - isig - if(csubmode.eq.'C' .and. snrdb.eq.0.0) xsnr=-21 - isig - -!### -! call1="K1ABC" -! ic3=65+mod(isig-1,26) -! ic2=65+mod((isig-1)/26,26) -! ic1=65 -! call2="W9"//char(ic1)//char(ic2)//char(ic3) -! write(msg,1010) call1,call2,nint(xsnr) -!1010 format(a5,1x,a5,1x,i3.2) -!### - call packmsg(msg,dgen,itype,.false.) !Pack message into 12 six-bit bytes - call rs_encode(dgen,sent) !Encode using RS(63,12) - call interleave63(sent,1) !Interleave channel symbols - call graycode65(sent,63,1) !Apply Gray code - - k=0 - do j=1,nsym !Insert sync and data into itone() - if(nprc(j).eq.0) then - k=k+1 - itone(j)=sent(k)+2 - else - itone(j)=0 - endif - enddo - - bandwidth_ratio=2500.0/(fsample/2.0) - sig=sqrt(2*bandwidth_ratio)*10.0**(0.05*xsnr) - if(xsnr.gt.90.0) sig=1.0 - write(*,1020) ifile,isig,f0,csubmode,xsnr,xdt,fspread,msg -1020 format(i4,i4,f10.3,2x,a1,2x,f5.1,f6.2,f5.1,1x,a22) - - phi=0.d0 - dphi=0.d0 - k=nsample_rate + xdt*nsample_rate !Start audio at t = xdt + 1.0 s - isym0=-99 - do i=1,npts !Add this signal into cdat() - isym=floor(i/sps)+1 - if(isym.gt.nsym) exit - if(isym.ne.isym0) then - freq=f0 + itone(isym)*baud*mode65 - dphi=twopi*freq*dt - isym0=isym - endif - phi=phi + dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - z=cmplx(cos(xphi),sin(xphi)) - k=k+1 - if(k.ge.1) cdat(k)=cdat(k) + sig*z - enddo - enddo - - if(fspread.ne.0) then !Apply specified Doppler spread - df=real(nsample_rate)/nfft - twopi=8*atan(1.0) - cspread(0)=1.0 - cspread(NH)=0. - -! The following options were added 3/15/2016 to make the half-power tone -! widths equal to the requested Doppler spread. (Previously we effectively -! used b=1.0 and Gaussian shape, which made the tones 1.665 times wider.) -! b=2.0*sqrt(log(2.0)) !Gaussian (before 3/15/2016) -! b=2.0 !Lorenzian 3/15 - 3/27 - b=6.0 !Lorenzian 3/28 onward - - do i=1,NH - f=i*df - x=b*f/fspread - z=0. - a=0. - if(x.lt.3.0) then !Cutoff beyond x=3 -! a=sqrt(exp(-x*x)) !Gaussian - a=sqrt(1.111/(1.0+x*x)-0.1) !Lorentzian - call random_number(r1) - phi1=twopi*r1 - z=a*cmplx(cos(phi1),sin(phi1)) - endif - cspread(i)=z - z=0. - if(x.lt.50.0) then - call random_number(r2) - phi2=twopi*r2 - z=a*cmplx(cos(phi2),sin(phi2)) - endif - cspread(NFFT-i)=z - enddo - - do i=0,NFFT-1 - f=i*df - if(i.gt.NH) f=(i-nfft)*df - s=real(cspread(i))**2 + aimag(cspread(i))**2 -! write(13,3000) i,f,s,cspread(i) -!3000 format(i5,f10.3,3f12.6) - enddo -! s=real(cspread(0))**2 + aimag(cspread(0))**2 -! write(13,3000) 1024,0.0,s,cspread(0) - - call four2a(cspread,NFFT,1,1,1) !Transform to time domain - - sum=0. - do i=0,NFFT-1 - p=real(cspread(i))**2 + aimag(cspread(i))**2 - sum=sum+p - enddo - avep=sum/NFFT - fac=sqrt(1.0/avep) - cspread=fac*cspread !Normalize to constant avg power - cdat(1:npts)=cspread(1:npts)*cdat(1:npts) !Apply Rayleigh fading - -! do i=0,NFFT-1 -! p=real(cspread(i))**2 + aimag(cspread(i))**2 -! write(14,3010) i,p,cspread(i) -!3010 format(i8,3f12.6) -! enddo - - endif - - dat=aimag(cdat) + xnoise !Add the generated noise - if(snrdb.lt.90.0) then - dat=rms*dat(1:npts) - else - datpk=maxval(abs(dat(1:npts))) - fac=32766.9/datpk - dat(1:npts)=fac*dat(1:npts) - endif - if(any(abs(dat(1:npts)).gt.32767.0)) print*,"Warning - data will be clipped." - iwave(1:npts)=nint(dat(1:npts)) - write(10) h,iwave(1:npts) !Save the .wav file - close(10) - enddo - -999 end program jt65sim diff --git a/lib/jt9_decode.f90 b/lib/jt9_decode.f90 deleted file mode 100644 index d862504..0000000 --- a/lib/jt9_decode.f90 +++ /dev/null @@ -1,172 +0,0 @@ -module jt9_decode - - type :: jt9_decoder - procedure(jt9_decode_callback), pointer :: callback - contains - procedure :: decode - end type jt9_decoder - - abstract interface - subroutine jt9_decode_callback (this, sync, snr, dt, freq, drift, & - decoded) - import jt9_decoder - implicit none - class(jt9_decoder), intent(inout) :: this - real, intent(in) :: sync - integer, intent(in) :: snr - real, intent(in) :: dt - real, intent(in) :: freq - integer, intent(in) :: drift - character(len=22), intent(in) :: decoded - end subroutine jt9_decode_callback - end interface - -contains - - subroutine decode(this,callback,ss,id2,nfqso,newdat,npts8,nfa, & - nfsplit,nfb,ntol,nzhsym,nagain,ndepth,nmode,nsubmode,nexp_decode) - use timer_module, only: timer - - include 'constants.f90' - class(jt9_decoder), intent(inout) :: this - procedure(jt9_decode_callback) :: callback - real ss(184,NSMAX) - logical, intent(in) :: newdat, nagain - character*22 msg - real*4 ccfred(NSMAX) - real*4 red2(NSMAX) - logical ccfok(NSMAX) - logical done(NSMAX) - integer*2 id2(NTMAX*12000) - integer*1 i1SoftSymbols(207) - common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano - save ccfred,red2 - - if(nexp_decode.eq.-99) stop !Silence compiler warning - this%callback => callback - if(nmode.eq.9 .and. nsubmode.ge.1) then - call decode9w(nfqso,ntol,nsubmode,ss,id2,sync,nsnr,xdt,freq,msg) - if (associated(this%callback)) then - ndrift=0 - call this%callback(sync,nsnr,xdt,freq,ndrift,msg) - end if - go to 999 - endif - - nsynced=0 - ndecoded=0 - nsps=6912 !Params for JT9-1 - df3=1500.0/2048.0 - - tstep=0.5*nsps/12000.0 !Half-symbol step (seconds) - done=.false. - - nf0=0 - nf1=nfa - if(nmode.eq.65+9) nf1=nfsplit - ia=max(1,nint((nf1-nf0)/df3)) - ib=min(NSMAX,nint((nfb-nf0)/df3)) - lag1=-int(2.5/tstep + 0.9999) - lag2=int(5.0/tstep + 0.9999) - if(newdat) then - call timer('sync9 ',0) - call sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipk) - call timer('sync9 ',1) - endif - - nsps8=nsps/8 - df8=1500.0/nsps8 - dblim=db(864.0/nsps8) - 26.2 - - ia1=1 !quel compiler gripe - ib1=1 !quel compiler gripe - do nqd=1,0,-1 - limit=5000 - ccflim=3.0 - red2lim=1.6 - schklim=2.2 - if(iand(ndepth,7).eq.2) then - limit=10000 - ccflim=2.7 - endif - if(iand(ndepth,7).eq.3 .or. nqd.eq.1) then - limit=30000 - ccflim=2.5 - schklim=2.0 - endif - if(nagain) then - limit=100000 - ccflim=2.4 - schklim=1.8 - endif - ccfok=.false. - - if(nqd.eq.1) then - nfa1=nfqso-ntol - nfb1=nfqso+ntol - ia=max(1,nint((nfa1-nf0)/df3)) - ib=min(NSMAX,nint((nfb1-nf0)/df3)) - ccfok(ia:ib)=(ccfred(ia:ib).gt.(ccflim-2.0)) .and. & - (red2(ia:ib).gt.(red2lim-1.0)) - ia1=ia - ib1=ib - else - nfa1=nf1 - nfb1=nfb - ia=max(1,nint((nfa1-nf0)/df3)) - ib=min(NSMAX,nint((nfb1-nf0)/df3)) - do i=ia,ib - ccfok(i)=ccfred(i).gt.ccflim .and. red2(i).gt.red2lim - enddo - ccfok(ia1:ib1)=.false. - endif - - fgood=0. - do i=ia,ib - if(done(i) .or. (.not.ccfok(i))) cycle - f=(i-1)*df3 - if(nqd.eq.1 .or. & - (ccfred(i).ge.ccflim .and. abs(f-fgood).gt.10.0*df8)) then - - call timer('softsym ',0) - fpk=nf0 + df3*(i-1) - call softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, & - freq,drift,a3,schk,i1SoftSymbols) - call timer('softsym ',1) - - sync=(syncpk+1)/4.0 - if(nqd.eq.1 .and. ((sync.lt.0.5) .or. (schk.lt.1.0))) cycle - if(nqd.ne.1 .and. ((sync.lt.1.0) .or. (schk.lt.1.5))) cycle - - call timer('jt9fano ',0) - call jt9fano(i1SoftSymbols,limit,nlim,msg) - call timer('jt9fano ',1) - - if(sync.lt.0.0 .or. snrdb.lt.dblim-2.0) sync=0.0 - nsync=int(sync) - if(nsync.gt.10) nsync=10 - nsnr=nint(snrdb) - ndrift=nint(drift/df3) - num9=num9+1 - - if(msg.ne.' ') then - numfano=numfano+1 - if (associated(this%callback)) then - call this%callback(sync,nsnr,xdt,freq,ndrift,msg) - end if - iaa=max(1,i-1) - ibb=min(NSMAX,i+22) - fgood=f - nsynced=1 - ndecoded=1 - ccfok(iaa:ibb)=.false. - done(iaa:ibb)=.true. - endif - endif - enddo - if(nagain) exit - enddo - -999 return - end subroutine decode -end module jt9_decode diff --git a/lib/jt9code.f90 b/lib/jt9code.f90 deleted file mode 100644 index 5a4b4fc..0000000 --- a/lib/jt9code.f90 +++ /dev/null @@ -1,84 +0,0 @@ -program jt9code - -! Generate simulated data for testing of WSJT-X - - character*22 msg,msgchk,msg0,msg1,decoded,cok*3,bad*1,msgtype*10,expected - integer*4 i4tone(85) !Channel symbols (values 0-8) - include 'testmsg.f90' - include 'jt9sync.f90' - - nargs=iargc() - if(nargs.ne.1) then - print*,'Usage: jt9code "message"' - print*,' jt9code -t' - go to 999 - endif - - call getarg(1,msg) - nmsg=1 - if(msg(1:2).eq."-t") then - if (NTEST+5 > MAXTEST) then - write(*,*) "NTEST exceed MAXTEST" - endif - testmsg(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" - testmsg(NTEST+2)="KA1ABC WB9XYZ OOO" - testmsg(NTEST+3)="RO" - testmsg(NTEST+4)="RRR" - testmsg(NTEST+5)="73" - testmsgchk(NTEST+1)="KA1ABC WB9XYZ EN34 OOO" - testmsgchk(NTEST+2)="KA1ABC WB9XYZ OOO" - testmsgchk(NTEST+3)="RO" - testmsgchk(NTEST+4)="RRR" - testmsgchk(NTEST+5)="73" - nmsg=NTEST+5 - endif - - write(*,1010) -1010 format(" Message Decoded Err? Type Expected"/ & - 76("-")) - do imsg=1,nmsg - if(nmsg.gt.1) then - msg=testmsg(imsg) - msgchk=testmsgchk(imsg) - endif - call fmtmsg(msg,iz) !To upper case, collapse multiple blanks - msg0=msg - ichk=0 - call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report - msg1=msg !Message without "OOO" - - if(nspecial.gt.0) then !or is a shorthand message - if(nspecial.eq.2) decoded="RO" - if(nspecial.eq.3) decoded="RRR" - if(nspecial.eq.4) decoded="73" - itype=-1 - msgtype="Shorthand" - go to 10 - endif - - call gen9(msg,ichk,decoded,i4tone,itype) !Encode message into tone #s - - msgtype="" - if(itype.eq.1) msgtype="Std Msg" - if(itype.eq.2) msgtype="Type 1 pfx" - if(itype.eq.3) msgtype="Type 1 sfx" - if(itype.eq.4) msgtype="Type 2 pfx" - if(itype.eq.5) msgtype="Type 2 sfx" - if(itype.eq.6) msgtype="Free text" - - if(cok.eq."OOO") decoded(20:22)=cok - call fmtmsg(decoded,iz) - -10 bad=" " - expected = 'EXACT' - if (msg0.ne.msgchk) expected = 'TRUNCATED' - if (nmsg.eq.1) expected = 'UNKNOWN' - if(decoded.ne.msgchk) bad="*" - write(*,1020) imsg,msg0,decoded,bad,itype,msgtype,expected -1020 format(i2,'.',1x,a22,1x,a22,1x,a1,i3,":",a10,2x,a22) - enddo - - if(nmsg.eq.1) write(*,1030) i4tone -1030 format(/'Channel symbols'/(30i2)) - -999 end program jt9code diff --git a/lib/jt9fano.f90 b/lib/jt9fano.f90 deleted file mode 100644 index 275e0e0..0000000 --- a/lib/jt9fano.f90 +++ /dev/null @@ -1,92 +0,0 @@ -subroutine jt9fano(i1SoftSymbols,limit,nlim,msg) - -! Decoder for JT9 -! Input: i1SoftSymbols(207) - Single-bit soft symbols -! Output: msg - decoded message (blank if erasure) - - use packjt - character*22 msg - integer*4 i4DecodedBytes(9) - integer*4 i4Decoded6BitWords(12) - integer*1 i1DecodedBytes(13) !72 bits and zero tail as 8-bit bytes - integer*1 i1SoftSymbols(207) - integer*1 i1DecodedBits(72) - - real*4 xx0(0:262) - - logical first - integer*4 mettab(-128:127,0:1) - data first/.true./ - data xx0/ & !Metric table - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & - 0.988, 1.000, 0.991, 0.993, 1.000, 0.995, 1.000, 0.991, & - 1.000, 0.991, 0.992, 0.991, 0.990, 0.990, 0.992, 0.996, & - 0.990, 0.994, 0.993, 0.991, 0.992, 0.989, 0.991, 0.987, & - 0.985, 0.989, 0.984, 0.983, 0.979, 0.977, 0.971, 0.975, & - 0.974, 0.970, 0.970, 0.970, 0.967, 0.962, 0.960, 0.957, & - 0.956, 0.953, 0.942, 0.946, 0.937, 0.933, 0.929, 0.920, & - 0.917, 0.911, 0.903, 0.895, 0.884, 0.877, 0.869, 0.858, & - 0.846, 0.834, 0.821, 0.806, 0.790, 0.775, 0.755, 0.737, & - 0.713, 0.691, 0.667, 0.640, 0.612, 0.581, 0.548, 0.510, & - 0.472, 0.425, 0.378, 0.328, 0.274, 0.212, 0.146, 0.075, & - 0.000,-0.079,-0.163,-0.249,-0.338,-0.425,-0.514,-0.606, & - -0.706,-0.796,-0.895,-0.987,-1.084,-1.181,-1.280,-1.376, & - -1.473,-1.587,-1.678,-1.790,-1.882,-1.992,-2.096,-2.201, & - -2.301,-2.411,-2.531,-2.608,-2.690,-2.829,-2.939,-3.058, & - -3.164,-3.212,-3.377,-3.463,-3.550,-3.768,-3.677,-3.975, & - -4.062,-4.098,-4.186,-4.261,-4.472,-4.621,-4.623,-4.608, & - -4.822,-4.870,-4.652,-4.954,-5.108,-5.377,-5.544,-5.995, & - -5.632,-5.826,-6.304,-6.002,-6.559,-6.369,-6.658,-7.016, & - -6.184,-7.332,-6.534,-6.152,-6.113,-6.288,-6.426,-6.313, & - -9.966,-6.371,-9.966,-7.055,-9.966,-6.629,-6.313,-9.966, & - -5.858,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - -9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, & - 1.43370769e-019,2.64031087e-006,6.25548654e+028, & - 2.44565251e+020,4.74227538e+030,10497312.,7.74079654e-039/ - save - - if(first) then -! Get the metric table - bias=0.5 - scale=50 - ndelta=nint(3.4*scale) - ib=160 !Break point - slope=2 !Slope beyond break - do i=0,255 - mettab(i-128,0)=nint(scale*(xx0(i)-bias)) - if(i.gt.ib) mettab(i-128,0)=mettab(ib-128,0) - slope*(i-ib) - if(i.ge.1) mettab(128-i,1)=mettab(i-128,0) - enddo - mettab(-128,1)=mettab(-127,1) - first=.false. - endif - - msg=' ' - nbits=72 - call fano232(i1SoftSymbols,nbits+31,mettab,ndelta,limit,i1DecodedBytes, & - ncycles,metric,ierr) - - nlim=ncycles/(nbits+31) - if(ncycles.lt.((nbits+31)*limit)) then - nbytes=(nbits+7)/8 - do i=1,nbytes - n=i1DecodedBytes(i) - i4DecodedBytes(i)=iand(n,255) - enddo - call unpackbits(i4DecodedBytes,nbytes,8,i1DecodedBits) - call packbits(i1DecodedBits,12,6,i4Decoded6BitWords) - call unpackmsg(i4Decoded6BitWords,msg,.false.,' ') !Unpack decoded msg - if(index(msg,'000AAA ').gt.0) msg=' ' - endif - - return -end subroutine jt9fano diff --git a/lib/jt9sim.f90 b/lib/jt9sim.f90 deleted file mode 100644 index 480d493..0000000 --- a/lib/jt9sim.f90 +++ /dev/null @@ -1,175 +0,0 @@ -program jt9sim - -! Generate simulated data for testing of WSJT-X - - use wavhdr - use packjt - parameter (NTMAX=120) - parameter (NMAX=NTMAX*12000) - type(hdr) h - integer*2 iwave(NMAX) !Generated waveform (no noise) - real*4 dat(NMAX) - real*8 f0,f,dt,twopi,phi,dphi,baud,fspan,fsample,freq - character msg*22,msg0*22,message*22,msgsent*22,arg*8,fname*11 - - integer*4 i4tone(85) !Channel symbols (values 0-8) - integer*4 i4DataSymNoGray(69) !Data Symbols, values 0-7 - integer*1 i1ScrambledBits(207) !Unpacked bits, scrambled order - integer*1 i1Bits(207) !Encoded information-carrying bits - integer*1 i1SoftSymbols(207) - include 'jt9sync.f90' - - nargs=iargc() - if(nargs.ne.6) then - print*,'Usage: jt9sim "message" fspan nsigs minutes SNR nfiles' - print*,'Example: jt9sim "CQ K1ABC FN42" 200 20 2 -28 1' - print*,' ' - print*,'Enter message = "" to use entries in msgs.txt.' - print*,'Enter SNR = 0 to generate a range of SNRs.' - print*,'Enter SNR = 99 to generate a noiseless signal at frequency fspan' - go to 999 - endif - - call getarg(1,msg0) - call fmtmsg(msg0,iz) - message=msg0 !Transmitted message - call getarg(2,arg) - read(arg,*) fspan !Total freq range (Hz) - call getarg(3,arg) - read(arg,*) nsigs !Number of signals in each file - call getarg(4,arg) - read(arg,*) minutes !Length of file (1 2 5 10 30 minutes) - call getarg(5,arg) - read(arg,*) snrdb !S/N in dB (2500 hz reference BW) - call getarg(6,arg) - read(arg,*) nfiles !Number of files - - rmsdb=25. - rms=10.0**(0.05*rmsdb) - fsample=12000.d0 !Sample rate (Hz) - dt=1.d0/fsample !Sample interval (s) - twopi=8.d0*atan(1.d0) - npts=12000*(60*minutes-6) - nsps=0 - if(minutes.eq.1) nsps=6912 - if(minutes.eq.2) nsps=15360 - if(minutes.eq.5) nsps=40960 - if(minutes.eq.10) nsps=82944 - if(minutes.eq.30) nsps=252000 - if(nsps.eq.0) stop 'Bad value for minutes.' - - f0=1400.d0 !Center frequency (Hz) -! f0=3000.d0 !Center frequency (Hz) - -! f0=1500.0 -! if(minutes.eq.5) f0=1100. -! if(minutes.eq.10) f0=1050. -! if(minutes.eq.30) f0=1025. - - - call init_random_seed() ! seed Fortran RANDOM_NUMBER generator - call sgran() ! see C rand generator (used in gran) - - h=default_header(12000,npts) - k=0 !Silence compiler warning - - if(msg0(1:3).eq.'sin') read(msg0(4:),*) sinfreq - - if(message.eq."") open(12,file='msgs.txt',status='old') - - write(*,1000) -1000 format('File N freq S/N Message'/ & - '---------------------------------------------------') - - do ifile=1,nfiles !Loop over all files - nmin=(ifile-1)*minutes - ihr=nmin/60 - imin=mod(nmin,60) - write(fname,1002) ihr,imin !Create output filename -1002 format('000000_',2i2.2) - open(10,file=fname//'.wav',access='stream',status='unknown') - - if(snrdb.lt.90) then - do i=1,npts - dat(i)=gran() - enddo - else - dat(1:npts)=0. - endif - - if(msg0.ne.' ') then - call gen9(message,0,msgsent,i4tone,itype) !Encode message into tone #s - endif - - rewind 12 - do isig=1,nsigs !Loop over multiple signals - - if(msg0.eq.' ') then - read(12,1004) message !Use pre-generated message texts -1004 format(a22) - call gen9(message,0,msgsent,i4tone,itype) - endif - - f=f0 - if(nsigs.gt.1) f=f0 - 0.5d0*fspan + fspan*(isig-1.d0)/(nsigs-1.d0) - snrdbx=snrdb -! snrdbx=snrdb + (ifile-1)*4.0 - sig=10.0**(0.05*snrdbx) - if(snrdb.gt.90.0) sig=1.0 - write(*,1020) ifile,isig,f,snrdbx,msgsent -1020 format(i3,i4,f10.3,f7.1,2x,a22) - - phi=0. - baud=12000.d0/nsps - k=12000 !Start audio at t = 1.0 s -! f1=0.0001 * (ifile-1) - f1=0. -! print*,ifile-1,f1 - dphi2=0. - ddphi2=twopi*f1*dt/60.0 - do isym=1,85 - freq=f + i4tone(isym)*baud - if(msg0(1:3).eq.'sin') freq=sinfreq - dphi=twopi*freq*dt + dphi2 - do i=1,nsps - phi=phi + dphi - dphi2=dphi2 + ddphi2 - if(phi.lt.-twopi) phi=phi+twopi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - k=k+1 - dat(k)=dat(k) + sig*sin(xphi) !Use lookup table for i*2 sin(x) ? - enddo - enddo - enddo - - fac=32767.0/nsigs - if(snrdb.ge.90.0) iwave(1:npts)=nint(fac*dat(1:npts)) - if(snrdb.lt.90.0) iwave(1:npts)=nint(rms*dat(1:npts)) - - write(10) h,iwave(1:npts) - close(10) - -! We're done! Now decode the data symbols from i4tone, as a test. - if(msg0.ne.' ') then - j=0 - do i=1,85 - if(isync(i).eq.1) cycle - j=j+1 - i4DataSymNoGray(j)=igray(i4tone(i)-1,-1) - enddo - call unpackbits(i4DataSymNoGray,69,3,i1ScrambledBits) - call interleave9(i1ScrambledBits,-1,i1Bits) - - do i=1,206 - i4=-10 - if(i1Bits(i).eq.1) i4=10 - i1SoftSymbols(i)=i4 - enddo - limit=1000 - call jt9fano(i1SoftSymbols,limit,nlim,msg) - if(msg.ne.msg0) print*,'Decode error: ',msg0,' ',msg - endif - enddo - -999 end program jt9sim diff --git a/lib/jt9sync.f90 b/lib/jt9sync.f90 deleted file mode 100644 index a8e3368..0000000 --- a/lib/jt9sync.f90 +++ /dev/null @@ -1,18 +0,0 @@ - integer ii(16) !Locations of sync symbols - data ii/ 1,2,5,10,16,23,33,35,51,52,55,60,66,73,83,85/ - - integer ii2(16) !Locations of sync half-symbols - data ii2/1,3,9,19,31,45,65,69,101,103,109,119,131,145,165,169/ - - integer ka(16),kb(16) !Reference symbols for sync - data ka/5,5,11,21,33,47,63,71,97,105,111,121,133,147,159,163/ - data kb/7,7,13,23,35,49,67,73,99,107,113,123,135,149,161,167/ - - - integer isync(85) !Sync vector - data isync/ & - 1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0, & - 0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0, & - 0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,0,0,0,0,1, & - 0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & - 0,0,1,0,1/ diff --git a/lib/ldpcsim40.f90 b/lib/ldpcsim40.f90 deleted file mode 100644 index aba6e22..0000000 --- a/lib/ldpcsim40.f90 +++ /dev/null @@ -1,138 +0,0 @@ -program ldpcsim - -use, intrinsic :: iso_c_binding -use hashing -use packjt - -character*22 msg,msgsent,msgreceived -character*8 arg -integer*1, allocatable :: codeword(:), decoded(:), message(:) -real*8, allocatable :: rxdata(:), rxavgd(:) -real, allocatable :: llr(:) -integer ihash -integer*1 hardbits(32) - -nargs=iargc() -if(nargs.ne.4) then - print*,'Usage: ldpcsim niter navg #trials s ' - print*,'eg: ldpcsim 10 1 1000 0.75' - return -endif -call getarg(1,arg) -read(arg,*) max_iterations -call getarg(2,arg) -read(arg,*) navg -call getarg(3,arg) -read(arg,*) ntrials -call getarg(4,arg) -read(arg,*) s - -K=16 -N=32 -!rate=real(K)/real(N) -! don't count hash bits as data bits -rate=4.0/real(N) -write(*,*) "rate: ",rate -write(*,*) "niter= ",max_iterations,"navg= ",navg," s= ",s - -allocate ( codeword(N), decoded(K), message(K) ) -allocate ( rxdata(N), rxavgd(N), llr(N) ) - -msg="K1JT K9AN" -call fmtmsg(msg,iz) -call hash(msg,22,ihash) -irpt=14 -ihash=iand(ihash,4095) !12-bit hash -ig=16*ihash + irpt !4-bit report -write(*,*) irpt,ihash,ig - -do i=1,16 - message(i)=iand(1,ishft(ig,1-i)) -enddo -write(*,'(16i1)') message -call encode_msk40(message,codeword) -write(*,'(32i1)') codeword -call init_random_seed() - -write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadhash" -do idb = 0, 30 - db=idb/2.0 - sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) - ngood=0 - nue=0 - nbadhash=0 - - itsum=0 - do itrial=1, ntrials - rxavgd=0d0 - do iav=1,navg - call sgran() -! Create a realization of a noisy received word - do i=1,N - rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() - enddo - rxavgd=rxavgd+rxdata - enddo - rxdata=rxavgd - -! Correct signal normalization is important for this decoder. - rxav=sum(rxdata)/N - rx2av=sum(rxdata*rxdata)/N - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - if( s .le. 0 ) then - ss=sigma - else - ss=s - endif - - llr=2.0*rxdata/(ss*ss) - - call bpdecode40(llr, max_iterations, decoded, niterations) -! If the decoder finds a valid codeword, niterations will be .ge. 0. - if( niterations .ge. 0 ) then - nueflag=0 - nhashflag=0 - imsg=0 - do i=1,16 - imsg=ishft(imsg,1)+iand(1_1,decoded(17-i)) - enddo - nrxrpt=iand(imsg,15) - nrxhash=(imsg-nrxrpt)/16 - if( nrxhash .ne. ihash ) then - nbadhash=nbadhash+1 - nhashflag=1 - endif - -! Check the message plus hash against what was sent. - do i=1,K - if( message(i) .ne. decoded(i) ) then - nueflag=1 - endif - enddo - - if( nhashflag .eq. 0 .and. nueflag .eq. 0 ) then - ngood=ngood+1 - itsum=itsum+niterations - else if( nhashflag .eq. 0 .and. nueflag .eq. 1 ) then - nue=nue+1; - endif - else - hardbits=0 - where(llr .gt. 0) hardbits=1 -! write(*,'(32i1)') hardbits -! write(*,'(32i1)') codeword - isum=0 - do i=1,32 - if( hardbits(i) .ne. codeword(i) ) isum=isum+1 - enddo -! write(*,*) 'number of errors ',isum - endif - enddo - avits=real(itsum)/real(ngood+0.1) - snr2500=db-10.0 - write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,1x,f8.2,1x,f8.1)") db,snr2500,ngood,nue,nbadhash,ss,avits - -enddo - -end program ldpcsim diff --git a/lib/peakdt9.f90 b/lib/peakdt9.f90 deleted file mode 100644 index 946d453..0000000 --- a/lib/peakdt9.f90 +++ /dev/null @@ -1,54 +0,0 @@ -subroutine peakdt9(c2,nsps8,nspsd,c3,xdt) - - parameter (NZ2=1512,NZ3=1360) - complex c2(0:NZ2-1) - complex c3(0:NZ3-1) - complex z - real p(0:3300) - include 'jt9sync.f90' - - p=0. - i0=5*nspsd - do i=0,NZ2-1 - z=1.e-3*sum(c2(max(i-(nspsd-1),0):i)) - p(i0+i)=real(z)**2 + aimag(z)**2 !Integrated symbol power at freq=0 - enddo - - call getlags(nsps8,lag0,lag1,lag2) - tsymbol=nsps8/1500.0 - dtlag=tsymbol/nspsd - smax=0. - lagpk=0 - do lag=lag1,lag2 - sum0=0. - sum1=0. - j=-nspsd - do i=1,85 - j=j+nspsd - if(isync(i).eq.1) then - sum1=sum1+p(j+lag) - else - sum0=sum0+p(j+lag) - endif - enddo - ss=(sum1/16.0)/(sum0/69.0) - 1.0 - xdt=(lag-lag0)*dtlag - if(ss.gt.smax) then - smax=ss - lagpk=lag - endif - enddo - - xdt=(lagpk-lag0)*dtlag - - do i=0,NZ3-1 - j=i+lagpk-i0-nspsd+1 - if(j.ge.0 .and. j.lt.NZ2) then - c3(i)=c2(j) - else - c3(i)=0. - endif - enddo - - return -end subroutine peakdt9 diff --git a/lib/qra64a.f90 b/lib/qra64a.f90 deleted file mode 100644 index 2f128ac..0000000 --- a/lib/qra64a.f90 +++ /dev/null @@ -1,158 +0,0 @@ -subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & - emedelay,mycall_12,hiscall_12,hisgrid_6,sync,nsnr,dtx,nfreq,decoded,nft) - - use packjt - use timer_module, only: timer - - parameter (NMAX=60*12000,LN=1152*63) - character decoded*22 - character*12 mycall_12,hiscall_12 - character*6 mycall,hiscall,hisgrid_6 - character*4 hisgrid - logical ltext - complex c00(0:720000) !Complex spectrum of dd() - complex c0(0:720000) !Complex data for dd() - real a(3) - real dd(NMAX) !Raw data sampled at 12000 Hz - real s3(LN) !Symbol spectra - real s3a(LN) !Symbol spectra - integer dat4(12) !Decoded message (as 12 integers) - integer dat4x(12) - integer nap(0:11) - data nap/0,2,3,2,3,4,2,3,6,4,6,6/ - data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/ - save - - call timer('qra64a ',0) - irc=-1 - decoded=' ' - nft=99 - if(nfqso.lt.nf1 .or. nfqso.gt.nf2) go to 900 - - mycall=mycall_12(1:6) !### May need fixing ### - hiscall=hiscall_12(1:6) - hisgrid=hisgrid_6(1:4) - call packcall(mycall,nc1,ltext) - call packcall(hiscall,nc2,ltext) - call packgrid(hisgrid,ng2,ltext) - nSubmode=0 - if(mode64.eq.2) nSubmode=1 - if(mode64.eq.4) nSubmode=2 - if(mode64.eq.8) nSubmode=3 - if(mode64.eq.16) nSubmode=4 - b90=1.0 - nFadingModel=1 - maxaptype=4 - if(iand(ndepth,64).ne.0) maxaptype=5 - if(nc1.ne.nc1z .or. nc2.ne.nc2z .or. ng2.ne.ng2z .or. & - maxaptype.ne.maxaptypez) then - do naptype=0,maxaptype - if(naptype.eq.2 .and. maxaptype.eq.4) cycle - call qra64_dec(s3,nc1,nc2,ng2,naptype,1,nSubmode,b90, & - nFadingModel,dat4,snr2,irc) - enddo - nc1z=nc1 - nc2z=nc2 - ng2z=ng2 - maxaptypez=maxaptype - endif - naptype=maxaptype - - call ana64(dd,npts,c00) - npts2=npts/2 - - call timer('sync64 ',0) - call sync64(c00,nf1,nf2,nfqso,ntol,mode64,emedelay,dtx,f0,jpk0,sync, & - sync2,width) - call timer('sync64 ',1) - nfreq=nint(f0) - if(mode64.eq.1 .and. minsync.ge.0 .and. (sync-7.0).lt.minsync) go to 900 -! if((sync-3.4).lt.float(minsync) .or.width.gt.340.0) go to 900 - a=0. - a(1)=-f0 - call twkfreq(c00,c0,npts2,6000.0,a) - - irc=-99 - s3lim=20. - itz=11 - if(mode64.eq.4) itz=9 - if(mode64.eq.2) itz=7 - if(mode64.eq.1) itz=5 - - LL=64*(mode64+2) - NN=63 - napmin=99 - do itry0=1,5 - idt=itry0/2 - if(mod(itry0,2).eq.0) idt=-idt - jpk=jpk0 + 750*idt - call spec64(c0,npts2,mode64,jpk,s3a,LL,NN) - call pctile(s3a,LL*NN,40,base) - s3a=s3a/base - where(s3a(1:LL*NN)>s3lim) s3a(1:LL*NN)=s3lim - do iter=itz,0,-2 - b90=1.728**iter - if(b90.gt.230.0) cycle - if(b90.lt.0.15*width) exit - s3(1:LL*NN)=s3a(1:LL*NN) - call timer('qra64_de',0) - call qra64_dec(s3,nc1,nc2,ng2,naptype,0,nSubmode,b90, & - nFadingModel,dat4,snr2,irc) - call timer('qra64_de',1) - if(irc.eq.0) go to 10 - if(irc.gt.0) call badmsg(irc,dat4,nc1,nc2,ng2) - iirc=max(0,min(irc,11)) - if(irc.gt.0 .and. nap(iirc).lt.napmin) then - dat4x=dat4 - b90x=b90 - snr2x=snr2 - napmin=nap(iirc) - irckeep=irc - dtxkeep=jpk/6000.0 - 1.0 - itry0keep=itry0 - iterkeep=iter - endif - enddo - if(irc.eq.0) exit - enddo - - if(napmin.ne.99) then - dat4=dat4x - b90=b90x - snr2=snr2x - irc=irckeep - dtx=dtxkeep - itry0=itry0keep - iter=iterkeep - endif -10 decoded=' ' - - if(irc.ge.0) then - call unpackmsg(dat4,decoded,.false.,' ') !Unpack the user message - call fmtmsg(decoded,iz) - if(index(decoded,"000AAA ").ge.1) then - ! Suppress a certain type of garbage decode. - decoded=' ' - irc=-1 - endif - nft=100 + irc - nsnr=nint(snr2) - else - snr2=0. - endif - -900 if(irc.lt.0) then - sy=max(1.0,sync) - if(nSubmode.eq.0) nsnr=nint(10.0*log10(sy)-35.0) !A - if(nSubmode.eq.1) nsnr=nint(10.0*log10(sy)-34.0) !B - if(nSubmode.eq.2) nsnr=nint(10.0*log10(sy)-29.0) !C - if(nSubmode.eq.3) nsnr=nint(10.0*log10(sy)-29.0) !D - if(nSubmode.eq.4) nsnr=nint(10.0*log10(sy)-24.0) !E - endif - call timer('qra64a ',1) - -! write(71,3001) nutc,dtx,f0,sync,sync2,width,minsync,decoded -!3001 format(i4.4,f7.2,4f8.1,i3,2x,a22) - - return -end subroutine qra64a diff --git a/lib/qra64code.f90 b/lib/qra64code.f90 deleted file mode 100644 index 1d1336f..0000000 --- a/lib/qra64code.f90 +++ /dev/null @@ -1,66 +0,0 @@ -program QRA64code - -! Provides examples of message packing, bit and symbol ordering, -! QRA (63,12) encoding, and other necessary details of the QRA64 -! protocol. - - use packjt - character*22 msg,msg0,msg1,decoded,cok*3,msgtype*10,arg*12 - character*6 mycall - logical ltext - integer dgen(12),sent(63),dec(12) - integer icos7(0:6) - data icos7/4,2,5,6,1,3,0/ !Costas 7x7 tone pattern - - include 'testmsg.f90' - - nargs=iargc() - if(nargs.lt.1) then - print*,'Usage: qra64code "message"' - print*,' qra64code -t' - go to 999 - endif - - call getarg(1,msg) !Get message from command line - nmsg=1 - if(msg(1:2).eq."-t") nmsg=NTEST - - write(*,1010) -1010 format(" Message Decoded Err? Type"/74("-")) - - do imsg=1,nmsg - if(nmsg.gt.1) msg=testmsg(imsg) - call fmtmsg(msg,iz) !To upper, collapse mult blanks - msg0=msg !Input message - call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report - msg1=msg !Message without "OOO" - call packmsg(msg1,dgen,itype,.false.) !Pack message into 12 six-bit bytes - msgtype="" - if(itype.eq.1) msgtype="Std Msg" - if(itype.eq.2) msgtype="Type 1 pfx" - if(itype.eq.3) msgtype="Type 1 sfx" - if(itype.eq.4) msgtype="Type 2 pfx" - if(itype.eq.5) msgtype="Type 2 sfx" - if(itype.eq.6) msgtype="Free text" - - call qra64_enc(dgen,sent) !Encode using QRA64 - - call unpackmsg(dgen,decoded,.false.,' ') !Unpack the user message - call fmtmsg(decoded,iz) - ii=imsg - write(*,1020) ii,msg0,decoded,itype,msgtype -1020 format(i4,1x,a22,2x,a22,4x,i3,": ",a13) - enddo - - if(nmsg.eq.1) then - write(*,1030) dgen -1030 format(/'Packed message, 6-bit symbols ',12i3) !Display packed symbols - - write(*,1040) sent -1040 format(/'Information-carrying channel symbols'/(i5,29i3)) - - write(*,1050) 10*icos7,sent(1:32),10*icos7,sent(33:63),10*icos7 -1050 format(/'Channel symbols including sync'/(i5,29i3)) - endif - -999 end program QRA64code diff --git a/lib/setup65.f90 b/lib/setup65.f90 deleted file mode 100644 index 42274ce..0000000 --- a/lib/setup65.f90 +++ /dev/null @@ -1,96 +0,0 @@ -subroutine setup65 - -! Defines arrays related to the JT65 pseudo-random synchronizing pattern. -! Executed at program start. - - use jt65_mod - integer nprc(126) - -! JT65 - data nprc/ & - 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & - 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & - 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & - 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & - 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & - 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & - 1,1,1,1,1,1/ - data mr2/0/ !Silence compiler warning - -! Put the appropriate pseudo-random sequence into pr - nsym=126 - do i=1,nsym - pr(i)=2*nprc(i)-1 - enddo - -! Determine locations of data and reference symbols - k=0 - mr1=0 - do i=1,nsym - if(pr(i).lt.0.0) then - k=k+1 - mdat(k)=i - else - mr2=i - if(mr1.eq.0) mr1=i - endif - enddo - nsig=k - -! Determine the reference symbols for each data symbol. - do k=1,nsig - m=mdat(k) - mref(k,1)=mr1 - do n=1,10 !Get ref symbol before data - if((m-n).gt.0) then - if (pr(m-n).gt.0.0) go to 10 - endif - enddo - go to 12 -10 mref(k,1)=m-n -12 mref(k,2)=mr2 - do n=1,10 !Get ref symbol after data - if((m+n).le.nsym) then - if (pr(m+n).gt.0.0) go to 20 - endif - enddo - cycle -20 mref(k,2)=m+n - enddo - -! Now do it all again, using opposite logic on pr(i) - k=0 - mr1=0 - do i=1,nsym - if(pr(i).gt.0.0) then - k=k+1 - mdat2(k)=i - else - mr2=i - if(mr1.eq.0) mr1=i - endif - enddo - nsig=k - - do k=1,nsig - m=mdat2(k) - mref2(k,1)=mr1 - do n=1,10 - if((m-n).gt.0) then - if (pr(m-n).lt.0.0) go to 110 - endif - enddo - go to 112 -110 mref2(k,1)=m-n -112 mref2(k,2)=mr2 - do n=1,10 - if((m+n).le.nsym) then - if (pr(m+n).lt.0.0) go to 120 - endif - enddo - cycle -120 mref2(k,2)=m+n - enddo - - return -end subroutine setup65 diff --git a/lib/sh65.f90 b/lib/sh65.f90 deleted file mode 100644 index 8f13fdc..0000000 --- a/lib/sh65.f90 +++ /dev/null @@ -1,89 +0,0 @@ -subroutine sh65(cx,n5,mode65,ntol,xdf,nspecial,snrdb) - parameter(NFFT=2048,NH=NFFT/2,MAXSTEPS=150) - complex cx(90000) - complex c(0:NFFT-1) - real s(-NH+1:NH) - real s2(-NH+1:NH,MAXSTEPS) - real ss(-NH+1:NH,8) - real sigmax(8) - integer ipk(8) - - s=0. - ss=0. - - jstep=NFFT/4 - nblks=n5/jstep - 3 - ia=-jstep+1 - do iblk=1,nblks - ia=ia+jstep - ib=ia+NFFT-1 - c=cx(ia:ib) - call four2a(c,nfft,1,1,1) !c2c FFT - do i=0,NFFT-1 - j=i - if(j.gt.NH) j=j-NFFT - p=real(c(i))**2 + aimag(c(i))**2 - s(j)=s(j) + p - s2(j,iblk)=p - enddo - n=mod(iblk-1,8) +1 - ss(-NH+1:NH,n)=ss(-NH+1:NH,n) + s2(-NH+1:NH,iblk) - enddo - - s=1.e-6*s - ss=1.e-6*ss - df=1378.1285/NFFT - nfac=40*mode65 - dtstep=0.25/df - -! Define range of frequencies to be searched - fa=-ntol - fb=ntol - ia2=max(-NH+1,nint(fa/df)) -! Upper tone is above sync tone by 4*nfac*df Hz - ib2=min(NH,nint(fb/df + 4.1*nfac)) - -! Find strongest line in each of the 4 phases, repeating for each drift rate. - sbest=0. - snrbest=0. - nbest=1 - ipk=0 - - do n=1,8 - sigmax(n)=0. - do i=ia2,ib2 - sig=ss(i,n) - if(sig.ge.sigmax(n)) then - ipk(n)=i - sigmax(n)=sig - if(sig.ge.sbest) then - sbest=sig - nbest=n - endif - endif - enddo - enddo - n2best=nbest+4 - if(n2best.gt.8) n2best=nbest-4 - xdf=min(ipk(nbest),ipk(n2best))*df - nspecial=0 - if(abs(xdf).le.ntol) then - idiff=abs(ipk(nbest)-ipk(n2best)) - xk=float(idiff)/nfac - k=nint(xk) - iderr=nint((xk-k)*nfac) -! maxerr=nint(0.008*abs(idiff) + 0.51) - maxerr=nint(0.02*abs(idiff) + 0.51) !### Better test ??? ### - if(abs(iderr).le.maxerr .and. k.ge.2 .and. k.le.4) nspecial=k - snrdb=-30.0 - if(nspecial.gt.0) then - call sh65snr(ss(ia2,nbest),ib2-ia2+1,snr1) - call sh65snr(ss(ia2,n2best),ib2-ia2+1,snr2) - snr=0.5*(snr1+snr2) - snrdb=db(snr) - db(2500.0/df) - db(sqrt(nblks/4.0)) + 8.0 - endif - if(snr1.lt.4.0 .or. snr2.lt.4.0 .or. snr.lt.5.0) nspecial=0 - endif - - return -end subroutine sh65 diff --git a/lib/sh65snr.f90 b/lib/sh65snr.f90 deleted file mode 100644 index 3d44901..0000000 --- a/lib/sh65snr.f90 +++ /dev/null @@ -1,36 +0,0 @@ -subroutine sh65snr(x,nz,snr) - - real x(nz) - - ipk=0 !Shut up compiler warnings. -db - smax=-1.e30 - do i=1,nz - if(x(i).gt.smax) then - ipk=i - smax=x(i) - endif - s=s+x(i) - enddo - - s=0. - ns=0 - do i=1,nz - if(abs(i-ipk).ge.3) then - s=s+x(i) - ns=ns+1 - endif - enddo - ave=s/ns - - sq=0. - do i=1,nz - if(abs(i-ipk).ge.3) then - sq=sq+(x(i)-ave)**2 - ns=ns+1 - endif - enddo - rms=sqrt(sq/(nz-2)) - snr=(smax-ave)/rms - - return -end subroutine sh65snr diff --git a/lib/softsym.f90 b/lib/softsym.f90 deleted file mode 100644 index 6475b0e..0000000 --- a/lib/softsym.f90 +++ /dev/null @@ -1,54 +0,0 @@ -subroutine softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, & - freq,drift,a3,schk,i1SoftSymbols) - -! Compute the soft symbols - - use timer_module, only: timer - - parameter (NZ2=1512,NZ3=1360) - logical, intent(inout) :: newdat - complex c2(0:NZ2-1) - complex c3(0:NZ3-1) - complex c5(0:NZ3-1) - real a(3) - integer*1 i1SoftSymbolsScrambled(207) - integer*1 i1SoftSymbols(207) - include 'jt9sync.f90' - - nspsd=16 - ndown=nsps8/nspsd - -! Mix, low-pass filter, and downsample to 16 samples per symbol - call timer('downsam9',0) - call downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2) - call timer('downsam9',1) - - call peakdt9(c2,nsps8,nspsd,c3,xdt) !Find DT - - fsample=1500.0/ndown - a=0. - call timer('afc9 ',0) - call afc9(c3,nz3,fsample,a,syncpk) !Find deltaF, fDot, extra DT - call timer('afc9 ',1) - freq=fpk - a(1) - drift=-2.0*a(2) -! write(*,3301) fpk,freq,a -!3301 format(2f9.3,3f10.4) - a3=a(3) - a(3)=0. - - call timer('twkfreq ',0) - call twkfreq(c3,c5,nz3,fsample,a) !Correct for delta f, f1, f2 ==> a(1:3) - call timer('twkfreq ',1) - -! Compute soft symbols (in scrambled order) - call timer('symspec2',0) - call symspec2(c5,nz3,nsps8,nspsd,fsample,freq,drift,snrdb,schk, & - i1SoftSymbolsScrambled) - call timer('symspec2',1) - -! Remove interleaving - call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols) - - return -end subroutine softsym diff --git a/lib/softsym9f.f90 b/lib/softsym9f.f90 deleted file mode 100644 index bb505f0..0000000 --- a/lib/softsym9f.f90 +++ /dev/null @@ -1,55 +0,0 @@ -subroutine softsym9f(ss2,ss3,i1SoftSymbols) - -! Compute soft symbols and S/N - - real ss2(0:8,85) - real ss3(0:7,69) - integer*1 i1SoftSymbolsScrambled(207) - integer*1 i1SoftSymbols(207) - - ss=0. - sig=0. - if(ss2(0,1).eq.-999.0) return !Silence compiler warning - do j=1,69 - smax=0. - do i=0,7 - smax=max(smax,ss3(i,j)) - ss=ss+ss3(i,j) - enddo - sig=sig+smax - ss=ss-smax - enddo - ave=ss/(69*7) !Baseline -! call pctile(ss2,9*85,35,xmed) !### better? ### - ss3=ss3/ave - sig=sig/69. !Signal - - m0=3 - k=0 - scale=10.0 - do j=1,69 - do m=m0-1,0,-1 !Get bit-wise soft symbols - if(m.eq.2) then - r1=max(ss3(4,j),ss3(5,j),ss3(6,j),ss3(7,j)) - r0=max(ss3(0,j),ss3(1,j),ss3(2,j),ss3(3,j)) - else if(m.eq.1) then - r1=max(ss3(2,j),ss3(3,j),ss3(4,j),ss3(5,j)) - r0=max(ss3(0,j),ss3(1,j),ss3(6,j),ss3(7,j)) - else - r1=max(ss3(1,j),ss3(2,j),ss3(4,j),ss3(7,j)) - r0=max(ss3(0,j),ss3(3,j),ss3(5,j),ss3(6,j)) - endif - - k=k+1 - i4=nint(scale*(r1-r0)) - if(i4.lt.-127) i4=-127 - if(i4.gt.127) i4=127 - i1SoftSymbolsScrambled(k)=i4 - enddo - enddo - - - call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols) - - return -end subroutine softsym9f diff --git a/lib/softsym9w.f90 b/lib/softsym9w.f90 deleted file mode 100644 index c9b1d0a..0000000 --- a/lib/softsym9w.f90 +++ /dev/null @@ -1,125 +0,0 @@ -subroutine softsym9w(id2,npts,xdt0,f0,width,nsubmode,xdt1,snrdb,i1softsymbols) - - parameter (NFFT=6912,NH=NFFT/2,NQ=NH/2) - real s(NQ) - real s2(0:8,85) - real s3(0:7,69) - real x(NFFT) - complex cx(0:NH) - integer*2 id2(60*12000) - integer*1 i1SoftSymbolsScrambled(207) - integer*1 i1softsymbols(207) - include 'jt9sync.f90' - equivalence (x,cx) - - if(npts.eq.-99) stop !Silence compiler warning - df=12000.0/NFFT - i0a=max(1.0,(xdt0-1.0)*12000.0) - i0b=(xdt0+1.0)*12000.0 - k1=max(1,nint((f0-0.5*width)/df)) - k2=min(NQ,nint((f0+0.5*width)/df)) - smax=0. - i0pk=1 - i1softsymbols=0 - - do i0=i0a,i0b,432 - s=0. - ssum=0. - do j=1,16 - ia=i0 + (ii(j)-1)*nfft - ib=ia+NFFT-1 - x=1.e-6*id2(ia:ib) - call four2a(x,nfft,1,-1,0) !r2c FFT - do k=1,NQ - s(k)=s(k) + real(cx(k))**2 + aimag(cx(k))**2 - enddo - enddo - ssum=ssum + sum(s(k1:k2)) - if(ssum.gt.smax) then - smax=ssum - i0pk=i0 - else - if(ssum.lt.0.7*smax) exit - endif - end do - xdt1=(i0pk-1)/12000.0 - - if(i0pk.le.0) go to 999 - - m=0 - do j=1,85 - ia=i0pk + (j-1)*nfft - ib=ia+NFFT-1 - x=1.e-6*id2(ia:ib) - call four2a(x,nfft,1,-1,0) !r2c FFT - do k=1,NQ - s(k)=real(cx(k))**2 + aimag(cx(k))**2 - enddo - - dtone=df*(2**nsubmode) - do i=0,8 - f=f0 + i*dtone - k1=max(1,nint((f-0.5*width)/df)) - k2=min(NQ,nint((f+0.5*width)/df)) - s2(i,j)=sum(s(k1:k2)) !Symbol spectra, including sync - enddo - - if(isync(j).eq.0) then - m=m+1 - s3(0:7,m)=s2(1:8,j) !Symbol spectra, data only - endif - -! write(19,3101) j,s2(0:8,j) -!3101 format(i2,9f8.2) - enddo - - ss=0. - sig=0. - do j=1,69 - smax=0. - do i=0,7 - smax=max(smax,s3(i,j)) - ss=ss+s3(i,j) - enddo - sig=sig+smax - ss=ss-smax - enddo - ave=ss/(69*7) !Baseline - call pctile(s2,9*85,35,xmed) - s3=s3/ave - sig=sig/69. !Signal - snrdb=db(sig/xmed) - 28.0 - - m0=3 - k=0 - do j=1,69 - smax=0. - do i=0,7 - if(s3(i,j).gt.smax) smax=s3(i,j) - enddo - - do m=m0-1,0,-1 !Get bit-wise soft symbols - if(m.eq.2) then - r1=max(s3(4,j),s3(5,j),s3(6,j),s3(7,j)) - r0=max(s3(0,j),s3(1,j),s3(2,j),s3(3,j)) - else if(m.eq.1) then - r1=max(s3(2,j),s3(3,j),s3(4,j),s3(5,j)) - r0=max(s3(0,j),s3(1,j),s3(6,j),s3(7,j)) - else - r1=max(s3(1,j),s3(2,j),s3(4,j),s3(7,j)) - r0=max(s3(0,j),s3(3,j),s3(5,j),s3(6,j)) - endif - - k=k+1 - i4=nint(10.0*(r1-r0)) - if(i4.lt.-127) i4=-127 - if(i4.gt.127) i4=127 - i1SoftSymbolsScrambled(k)=i4 - enddo - enddo - -! Remove interleaving - call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols) - -999 return -end subroutine softsym9w diff --git a/lib/spec64.f90 b/lib/spec64.f90 deleted file mode 100644 index a0c0a04..0000000 --- a/lib/spec64.f90 +++ /dev/null @@ -1,42 +0,0 @@ -subroutine spec64(c0,npts2,mode64,jpk,s3,LL,NN) - - parameter (NSPS=3456) !Samples per symbol at 6000 Hz - complex c0(0:360000) !Complex spectrum of dd() - complex cs(0:NSPS-1) !Complex symbol spectrum - real s3(LL,NN) !Synchronized symbol spectra - real xbase0(LL),xbase(LL) - - nfft=nsps - fac=1.0/nfft - do j=1,NN - jj=j+7 !Skip first Costas array - if(j.ge.33) jj=j+14 !Skip middle Costas array - ja=jpk + (jj-1)*nfft - jb=ja+nfft-1 - cs(0:nfft-1)=fac*c0(ja:jb) - call four2a(cs,nfft,1,-1,1) - do ii=1,LL - i=ii-65 - if(i.lt.0) i=i+nfft - s3(ii,j)=real(cs(i))**2 + aimag(cs(i))**2 - enddo - enddo - - df=6000.0/nfft - do i=1,LL - call pctile(s3(i,1:NN),NN,45,xbase0(i)) !Get baseline for passband shape - enddo - - nh=25 - xbase(1:nh-1)=sum(xbase0(1:nh-1))/(nh-1.0) - xbase(LL-nh+1:LL)=sum(xbase0(LL-nh+1:LL))/(nh-1.0) - do i=nh,LL-nh - xbase(i)=sum(xbase0(i-nh+1:i+nh))/(2*nh+1) !Smoothed passband shape - enddo - - do i=1,LL - s3(i,1:NN)=s3(i,1:NN)/(xbase(i)+0.001) !Apply frequency equalization - enddo - - return -end subroutine spec64 diff --git a/lib/spec9f.f90 b/lib/spec9f.f90 deleted file mode 100644 index 96dac29..0000000 --- a/lib/spec9f.f90 +++ /dev/null @@ -1,30 +0,0 @@ -subroutine spec9f(id2,npts,nsps,s1,jz,nq) - -! Compute symbol spectra at quarter-symbol steps. - - integer*2 id2(0:npts) - real s1(nq,jz) - real x(960) - complex c(0:480) - equivalence (x,c) - - nfft=2*nsps !FFTs at twice the symbol length - nh=nfft/2 - do j=1,jz - ia=(j-1)*nsps/4 - ib=ia+nsps-1 - if(ib.gt.npts) exit - x(1:nh)=id2(ia:ib) - x(nh+1:)=0. - call four2a(x,nfft,1,-1,0) !r2c - k=mod(j-1,340)+1 - do i=1,NQ - s1(i,j)=1.e-10*(real(c(i))**2 + aimag(c(i))**2) - enddo - enddo - -!### Reference spectrum should be applied here (or possibly earlier?) ### -!### Normalize so that rms (or level?) is 1.0 ? ### - - return -end subroutine spec9f diff --git a/lib/subtract65.f90 b/lib/subtract65.f90 deleted file mode 100644 index 88b3550..0000000 --- a/lib/subtract65.f90 +++ /dev/null @@ -1,112 +0,0 @@ -subroutine subtract65(dd,npts,f0,dt) - -! Subtract a jt65 signal -! -! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) -! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) -! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ] -! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt} - - use packjt - use timer_module, only: timer - - integer correct(63) - parameter (NMAX=60*12000) !Samples per 60 s - parameter (NFILT=1600) - real*4 dd(NMAX), window(-NFILT/2:NFILT/2) - complex cref,camp,cfilt,cw - integer nprc(126) - real*8 dphi,phi - logical first - data nprc/ & - 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, & - 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, & - 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, & - 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, & - 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, & - 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, & - 1,1,1,1,1,1/ - data first/.true./ - common/chansyms65/correct - common/heap1/cref(NMAX),camp(NMAX),cfilt(NMAX),cw(NMAX) - save first - - pi=4.0*atan(1.0) - -! Symbol duration is 4096/11025 s. -! Sample rate is 12000/s, so 12000*(4096/11025)=4458.23 samples/symbol. -! For now, call it 4458 samples/symbol. Over the message duration, we'll be off -! by about (4458.23-4458)*126=28.98 samples; 29 samples, or 0.7% of 1 symbol. -! Could eliminate accumulated error by injecting one extra sample every -! 5 or so symbols... Maybe try this later. - - nstart=dt*12000+1; - nsym=126 - ns=4458 - nref=nsym*ns - nend=nstart+nref-1 - phi=0.0 - iref=1 - ind=1 - isym=1 - call timer('subtr_1 ',0) - do k=1,nsym - if( nprc(k) .eq. 1 ) then - omega=2*pi*f0 - else - omega=2*pi*(f0+2.6917*(correct(isym)+2)) - isym=isym+1 - endif - dphi=omega/12000.0 - do i=1,ns - cref(ind)=cexp(cmplx(0.0,phi)) - phi=modulo(phi+dphi,2*pi) - id=nstart-1+ind - if(id.ge.1) camp(ind)=dd(id)*conjg(cref(ind)) - ind=ind+1 - enddo - enddo - call timer('subtr_1 ',1) - - call timer('subtr_2 ',0) -! Smoothing filter: do the convolution by means of FFTs. Ignore end-around -! cyclic effects for now. - - nfft=564480 - - if(first) then -! Create and normalize the filter - sum=0.0 - do j=-NFILT/2,NFILT/2 - window(j)=cos(pi*j/NFILT)**2 - sum=sum+window(j) - enddo - cw=0. - do i=-NFILT/2,NFILT/2 - j=i+1 - if(j.lt.1) j=j+nfft - cw(j)=window(i)/sum - enddo - call four2a(cw,nfft,1,-1,1) - first=.false. - endif - - nz=561708 - cfilt(1:nz)=camp(1:nz) - cfilt(nz+1:nfft)=0. - call four2a(cfilt,nfft,1,-1,1) - fac=1.0/float(nfft) - cfilt(1:nfft)=fac*cfilt(1:nfft)*cw(1:nfft) - call four2a(cfilt,nfft,1,1,1) - call timer('subtr_2 ',1) - -! Subtract the reconstructed signal - call timer('subtr_3 ',0) - do i=1,nref - j=nstart+i-1 - if(j.ge.1 .and. j.le.npts) dd(j)=dd(j)-2*REAL(cfilt(i)*cref(i)) - enddo - call timer('subtr_3 ',1) - - return -end subroutine subtract65 diff --git a/lib/symspec2.f90 b/lib/symspec2.f90 deleted file mode 100644 index 2f4dc9e..0000000 --- a/lib/symspec2.f90 +++ /dev/null @@ -1,88 +0,0 @@ -subroutine symspec2(c5,nz3,nsps8,nspsd,fsample,freq,drift,snrdb,schk, & - i1SoftSymbolsScrambled) - -! Compute soft symbols from the final downsampled data - - complex c5(0:4096-1) - complex z - integer*1 i1SoftSymbolsScrambled(207) - real aa(3) - real ss2(0:8,85) - real ss3(0:7,69) - include 'jt9sync.f90' - data scale/10.0/ - - aa(1)=-1500.0/nsps8 - aa(2)=0. - aa(3)=0. - do i=0,8 !Loop over the 9 tones - if(i.ge.1) call twkfreq(c5,c5,nz3,fsample,aa) - m=0 - k=-1 - do j=1,85 !Loop over all symbols - z=0. - do n=1,nspsd !Sum over 16 samples - k=k+1 - z=z+c5(k) - enddo - ss2(i,j)=real(z)**2 + aimag(z)**2 !Symbol speactra, data and sync - if(i.ge.1 .and. isync(j).eq.0) then - m=m+1 - ss3(i-1,m)=ss2(i,j) !Symbol speactra, data only - endif - enddo - enddo - - call chkss2(ss2,freq,drift,schk) - - ss=0. - sig=0. - do j=1,69 - smax=0. - do i=0,7 - smax=max(smax,ss3(i,j)) - ss=ss+ss3(i,j) - enddo - sig=sig+smax - ss=ss-smax - enddo - ave=ss/(69*7) !Baseline - call pctile(ss2,9*85,35,xmed) - ss3=ss3/ave - sig=sig/69. !Signal - t=max(1.0,sig - 1.0) - snrdb=db(t) - 61.3 - - m0=3 - k=0 - do j=1,69 - smax=0. - do i=0,7 - if(ss3(i,j).gt.smax) smax=ss3(i,j) - enddo - - do m=m0-1,0,-1 !Get bit-wise soft symbols - if(m.eq.2) then - r1=max(ss3(4,j),ss3(5,j),ss3(6,j),ss3(7,j)) - r0=max(ss3(0,j),ss3(1,j),ss3(2,j),ss3(3,j)) - else if(m.eq.1) then - r1=max(ss3(2,j),ss3(3,j),ss3(4,j),ss3(5,j)) - r0=max(ss3(0,j),ss3(1,j),ss3(6,j),ss3(7,j)) - else - r1=max(ss3(1,j),ss3(2,j),ss3(4,j),ss3(7,j)) - r0=max(ss3(0,j),ss3(3,j),ss3(5,j),ss3(6,j)) - endif - - k=k+1 - i4=nint(scale*(r1-r0)) - if(i4.lt.-127) i4=-127 - if(i4.gt.127) i4=127 -! i4=i4+128 -! if(i4.le.127) i1SoftSymbolsScrambled(k)=i4 -! if(i4.ge.128) i1SoftSymbolsScrambled(k)=i4-256 - i1SoftSymbolsScrambled(k)=i4 - enddo - enddo - - return -end subroutine symspec2 diff --git a/lib/symspec65.f90 b/lib/symspec65.f90 deleted file mode 100644 index 02885bf..0000000 --- a/lib/symspec65.f90 +++ /dev/null @@ -1,68 +0,0 @@ -!subroutine symspec65(dd,npts,ss,nqsym,savg) -subroutine symspec65(dd,npts,nqsym,savg) - -! Compute JT65 symbol spectra at quarter-symbol steps - - parameter (NFFT=8192) - parameter (NSZ=3413) !NFFT*5000/12000 - parameter (MAXHSYM=322) - parameter (MAXQSYM=552) - real*8 hstep - real*4 dd(npts) -! real*4 ss(MAXHSYM,NSZ) - real*4 ss(MAXQSYM,NSZ) - real*4 savg(NSZ) - real*4 x(NFFT) - real*4 w(NFFT) - complex c(0:NFFT/2) - logical first - common/refspec/dfref,ref(NSZ) - equivalence (x,c) - data first/.true./ - save /refspec/,first,w - common/sync/ss - - hstep=2048.d0*12000.d0/11025.d0 !half-symbol = 2229.116 samples - qstep=hstep/2.0 !quarter-symbol = 1114.558 samples - nsps=nint(2*hstep) - df=12000.0/NFFT - nhsym=(npts-NFFT)/hstep - nqsym=(npts-NFFT)/qstep - savg=0. - fac1=1.e-3 - - if(first) then -! Compute the FFT window -! width=0.25*nsps - do i=1,NFFT -! z=(i-NFFT/2)/width - w(i)=1 - if(i.gt.4458) w(i)=0 -! w(i)=exp(-z*z) - enddo - first=.false. - endif - - do j=1,nqsym - i0=(j-1)*qstep - x=fac1*w*dd(i0+1:i0+NFFT) - call four2a(c,NFFT,1,-1,0) !r2c forward FFT - do i=1,NSZ - s=real(c(i))**2 + aimag(c(i))**2 - ss(j,i)=s - savg(i)=savg(i)+s - enddo - enddo - savg=savg/nhsym - -! call flat65(ss,nhsym,MAXQSYM,NSZ,ref) !Flatten the 2d spectrum, saving - call flat65(ss,nqsym,MAXQSYM,NSZ,ref) !Flatten the 2d spectrum, saving - dfref=df ! the reference spectrum ref() - savg=savg/ref -! do j=1,nhsym - do j=1,nqsym - ss(j,1:NSZ)=ss(j,1:NSZ)/ref - enddo - - return -end subroutine symspec65 diff --git a/lib/sync4.f90 b/lib/sync4.f90 deleted file mode 100644 index c7f33b4..0000000 --- a/lib/sync4.f90 +++ /dev/null @@ -1,179 +0,0 @@ -subroutine sync4(dat,jz,ntol,NFreeze,MouseDF,mode,mode4,minwidth, & - dtx,dfx,snrx,snrsync,ccfblue,ccfred1,flip,width,ps0) - -! Synchronizes JT4 data, finding the best-fit DT and DF. - - parameter (NFFTMAX=2520) !Max length of FFTs - parameter (NHMAX=NFFTMAX/2) !Max length of power spectra - parameter (NSMAX=525) !Max number of half-symbol steps - integer ntol !Range of DF search - real dat(jz) - real psavg(NHMAX) !Average spectrum of whole record - real ps0(450) !Avg spectrum for plotting - real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols - real ccfblue(-5:540) !CCF with pseudorandom sequence - real ccfred(-450:450) !Peak of ccfblue, as function of freq - real red(-450:450) !Peak of ccfblue, as function of freq - real ccfred1(-224:224) !Peak of ccfblue, as function of freq - real tmp(1260) - integer ipk1(1) - integer nch(7) - logical savered - equivalence (ipk1,ipk1a) - data nch/1,2,4,9,18,36,72/ - save - -! write(*,3001) 'A',ntol,nfreeze,mousedf,mode,mode4,minwidth -!3001 format(a1,6i6) - -! Do FFTs of twice symbol length, stepped by half symbols. Note that -! we have already downsampled the data by factor of 2. - nsym=207 - nfft=2520 - nh=nfft/2 - nq=nfft/4 - nsteps=jz/nq - 1 - df=0.5*11025.0/nfft - psavg(1:nh)=0. - if(mode.eq.-999) width=0. !Silence compiler warning - - do j=1,nsteps !Compute spectrum for each step, get average - k=(j-1)*nq + 1 - call ps4(dat(k),nfft,s2(1,j)) - psavg(1:nh)=psavg(1:nh) + s2(1:nh,j) - enddo - - nsmo=min(10*mode4,150) - call flat1b(psavg,nsmo,s2,nh,nsteps,NHMAX,NSMAX) !Flatten spectra - - if(mode4.ge.9) call smo(psavg,nh,tmp,mode4/4) - - i0=132 - do i=1,450 - ps0(i)=5.0*(psavg(i0+2*i) + psavg(i0+2*i+1) - 2.0) - enddo - -! Set freq and lag ranges - famin=200.0 + 3*mode4*df - fbmax=2700.0 - 3*mode4*df - fa=famin - fb=fbmax - if(NFreeze.eq.1) then - fa=max(famin,1270.46+MouseDF-ntol) - fb=min(fbmax,1270.46+MouseDF+ntol) - else - fa=max(famin,1270.46+MouseDF-600) - fb=min(fbmax,1270.46+MouseDF+600) - endif - ia=fa/df - 3*mode4 !Index of lowest tone, bottom of range - ib=fb/df - 3*mode4 !Index of lowest tone, top of range - i0=nint(1270.46/df) - irange=450 - if(ia-i0.lt.-irange) ia=i0-irange - if(ib-i0.gt.irange) ib=i0+irange - lag1=-5 - lag2=59 - syncbest=-1.e30 - ccfred=0. - jmax=-1000 - jmin=1000 - - do ich=minwidth,7 !Find best width - kz=nch(ich)/2 - savered=.false. - do i=ia+kz,ib-kz !Find best frequency channel for CCF - call xcor4(s2,i,nsteps,nsym,lag1,lag2,ich,mode4,ccfblue,ccf0, & - lagpk0,flip) - j=i-i0 + 3*mode4 - if(j.ge.-372 .and. j.le.372) then - ccfred(j)=ccf0 - jmax=max(j,jmax) - jmin=min(j,jmin) - endif - -! Find rms of the CCF, without main peak - call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0) - sync=abs(ccfblue(lagpk0)) - -! Find best sync value - if(sync.gt.syncbest) then - ipk=i - lagpk=lagpk0 - ichpk=ich - syncbest=sync - savered=.true. - endif - enddo - if(savered) red=ccfred - enddo - - ccfred=red -! width=df*nch(ichpk) - dfx=(ipk-i0 + 3*mode4)*df - -! Peak up in time, at best whole-channel frequency - call xcor4(s2,ipk,nsteps,nsym,lag1,lag2,ichpk,mode4,ccfblue,ccfmax, & - lagpk,flip) - xlag=lagpk - if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then - call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2) - xlag=lagpk+dx2 - endif - -! Find rms of the CCF, without the main peak - call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0) - sq=0. - nsq=0 - do lag=lag1,lag2 - if(abs(lag-xlag).gt.2.0) then - sq=sq+ccfblue(lag)**2 - nsq=nsq+1 - endif - enddo - rms=sqrt(sq/nsq) - snrsync=max(0.0,db(abs(ccfblue(lagpk)/rms - 1.0)) - 4.5) - snrx=-26. - if(mode4.eq.2) snrx=-25. - if(mode4.eq.4) snrx=-24. - if(mode4.eq.9) snrx=-23. - if(mode4.eq.18) snrx=-22. - if(mode4.eq.36) snrx=-21. - if(mode4.eq.72) snrx=-20. - snrx=snrx + snrsync - - dt=2.0/11025.0 - istart=xlag*nq - dtx=istart*dt - ccfred1=0. - jmin=max(jmin,-224) - jmax=min(jmax,224) - do i=jmin,jmax - ccfred1(i)=ccfred(i) - enddo - - ipk1=maxloc(ccfred1) - 225 - ns=0 - s=0. - iw=min(mode4,(ib-ia)/4) - do i=jmin,jmax - if(abs(i-ipk1a).gt.iw) then - s=s+ccfred1(i) - ns=ns+1 - endif - enddo - base=s/ns - ccfred1=ccfred1-base - ccf10=0.5*maxval(ccfred1) - do i=ipk1a,jmin,-1 - if(ccfred1(i).le.ccf10) exit - enddo - i1=i - do i=ipk1a,jmax - if(ccfred1(i).le.ccf10) exit - enddo - width=(i-i1)*df - - return -end subroutine sync4 - -include 'flat1b.f90' diff --git a/lib/sync64.f90 b/lib/sync64.f90 deleted file mode 100644 index 7ed9cf8..0000000 --- a/lib/sync64.f90 +++ /dev/null @@ -1,165 +0,0 @@ -subroutine sync64(c0,nf1,nf2,nfqso,ntol,mode64,emedelay,dtx,f0,jpk,sync, & - sync2,width) - - use timer_module, only: timer - - parameter (NMAX=60*12000) !Max size of raw data at 12000 Hz - parameter (NSPS=3456) !Samples per symbol at 6000 Hz - parameter (NSPC=7*NSPS) !Samples per Costas array - real s1(0:NSPC-1) !Power spectrum of Costas 1 - real s2(0:NSPC-1) !Power spectrum of Costas 2 - real s3(0:NSPC-1) !Power spectrum of Costas 3 - real s0(0:NSPC-1) !Sum of s1+s2+s3 - real s0a(0:NSPC-1) !Best synchromized spectrum (saved) - real s0b(0:NSPC-1) !tmp - real a(5) - integer icos7(0:6) !Costas 7x7 tones - integer ipk0(1) - complex cc(0:NSPC-1) !Costas waveform - complex c0(0:720000) !Complex spectrum of dd() - complex c1(0:NSPC-1) !Complex spectrum of Costas 1 - complex c2(0:NSPC-1) !Complex spectrum of Costas 2 - complex c3(0:NSPC-1) !Complex spectrum of Costas 3 - data icos7/4,2,5,6,1,3,0/ !Costas 7x7 tone pattern - data mode64z/-1/ - save - - if(mode64.ne.mode64z) then - twopi=8.0*atan(1.0) - dfgen=mode64*12000.0/6912.0 - k=-1 - phi=0. - do j=0,6 !Compute complex Costas waveform - dphi=twopi*10.0*icos7(j)*dfgen/6000.0 - do i=1,NSPS - phi=phi + dphi - if(phi.gt.twopi) phi=phi-twopi - k=k+1 - cc(k)=cmplx(cos(phi),sin(phi)) - enddo - enddo - mode64z=mode64 - endif - - nfft3=NSPC - nh3=nfft3/2 - df3=6000.0/nfft3 - - fa=max(nf1,nfqso-ntol) - fb=min(nf2,nfqso+ntol) - iaa=max(0,nint(fa/df3)) - ibb=min(NSPC-1,nint(fb/df3)) - - maxtol=max(ntol,500) - fa=max(nf1,nfqso-maxtol) - fb=min(nf2,nfqso+maxtol) - ia=max(0,nint(fa/df3)) - ib=min(NSPC-1,nint(fb/df3)) - id=0.1*(ib-ia) - iz=ib-ia+1 - sync=-1.e30 - smaxall=0. - jpk=0 - ja=0 - jb=(5.0+emedelay)*6000 - jstep=100 - ipk=0 - kpk=0 - nadd=10*mode64 - if(mod(nadd,2).eq.0) nadd=nadd+1 !Make nadd odd - nskip=max(49,nadd) - - do j1=ja,jb,jstep - call timer('sync64_1',0) - j2=j1 + 39*NSPS - j3=j1 + 77*NSPS - c1=1.e-4*c0(j1:j1+NSPC-1) * conjg(cc) - c2=1.e-4*c0(j2:j2+NSPC-1) * conjg(cc) - c3=1.e-4*c0(j3:j3+NSPC-1) * conjg(cc) - call four2a(c1,nfft3,1,-1,1) - call four2a(c2,nfft3,1,-1,1) - call four2a(c3,nfft3,1,-1,1) - s1=0. - s2=0. - s3=0. - s0b=0. - do i=ia,ib - freq=i*df3 - s1(i)=real(c1(i))**2 + aimag(c1(i))**2 - s2(i)=real(c2(i))**2 + aimag(c2(i))**2 - s3(i)=real(c3(i))**2 + aimag(c3(i))**2 - enddo - call timer('sync64_1',1) - - call timer('sync64_2',0) - s0(ia:ib)=s1(ia:ib) + s2(ia:ib) + s3(ia:ib) - s0(:ia-1)=0. - s0(ib+1:)=0. - if(nadd.ge.3) then - do ii=1,3 - s0b(ia:ib)=s0(ia:ib) - call smo(s0b(ia:ib),iz,s0(ia:ib),nadd) - enddo - endif - call averms(s0(ia+id:ib-id),iz-2*id,nskip,ave,rms) - s=(maxval(s0(iaa:ibb))-ave)/rms - ipk0=maxloc(s0(iaa:ibb)) - ip=ipk0(1) + iaa - 1 - if(s.gt.sync) then - jpk=j1 - s0a=(s0-ave)/rms - sync=s - dtx=jpk/6000.0 - 1.0 - ipk=ip - f0=ip*df3 - endif - call timer('sync64_2',1) - enddo - - s0a=s0a+2.0 -! write(17) ia,ib,s0a(ia:ib) !Save data for red curve -! close(17) - - nskip=50 - call lorentzian(s0a(ia+nskip:ib-nskip),iz-2*nskip,a) - f0a=(a(3)+ia+49)*df3 - w1=df3*a(4) - w2=2*nadd*df3 - width=w1 - if(w1.gt.1.2*w2) width=sqrt(w1**2 - w2**2) - - sq=0. - do i=1,20 - j=ia+nskip+1 - k=ib-nskip-21+i - sq=sq + (s0a(j)-a(1))**2 + (s0a(k)-a(1))**2 - enddo - rms2=sqrt(sq/40.0) - sync2=10.0*log10(a(2)/rms2) - - slimit=6.0 - rewind 17 - write(17,1110) 0.0,0.0 - rewind 17 -! rewind 76 - do i=2,iz-2*nskip-1,3 - x=i - z=(x-a(3))/(0.5*a(4)) - yfit=a(1) - if(abs(z).lt.3.0) then - d=1.0 + z*z - yfit=a(1) + a(2)*(1.0/d - 0.1) - endif - j=i+ia+49 - freq=j*df3 - ss=(s0a(j-1)+s0a(j)+s0a(j+1))/3.0 - if(ss.gt.slimit) write(17,1110) freq,ss -1110 format(3f10.3) -! write(76,1110) freq,ss,yfit - enddo - flush(17) - close(17) -! flush(76) - - return -end subroutine sync64 diff --git a/lib/sync65.f90 b/lib/sync65.f90 deleted file mode 100644 index e0bc924..0000000 --- a/lib/sync65.f90 +++ /dev/null @@ -1,96 +0,0 @@ -subroutine sync65(nfa,nfb,naggressive,ntol,nqsym,ca,ncand,nrobust, & - bVHF) - - parameter (NSZ=3413,NFFT=8192,MAXCAND=300) - real ss(552,NSZ) - real ccfblue(-32:82) !CCF with pseudorandom sequence - real ccfred(NSZ) !Peak of ccfblue, as function of freq - logical bVHF - - type candidate - real freq - real dt - real sync - real flip - end type candidate - type(candidate) ca(MAXCAND) - - common/steve/thresh0 - common/sync/ss - - if(ntol.eq.-99) stop !Silence compiler warning - call setup65 - - df=12000.0/NFFT !df = 12000.0/8192 = 1.465 Hz - ia=max(2,nint(nfa/df)) - ib=min(NSZ-1,nint(nfb/df)) -! lag1=-11 -! lag2=59 -! lag1=-22 -! lag2=118 - lag1=-32 - lag2=82 !may need to be extended for EME - nsym=126 - ncand=0 - fdot=0. - ccfred=0. - ccfblue=0. - ccfmax=0. - ipk=0 - do i=ia,ib - call xcor(i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk0,flip,fdot,nrobust) -! Remove best-fit slope from ccfblue and normalize so baseline rms=1.0 - if(.not.bVHF) call slope(ccfblue(lag1),lag2-lag1+1, & - lagpk0-lag1+1.0) - ccfred(i)=ccfblue(lagpk0) - if(ccfred(i).gt.ccfmax) then - ccfmax=ccfred(i) - ipk=i - endif - enddo - call pctile(ccfred(ia:ib),ib-ia+1,35,xmed) - ccfred(ia:ib)=ccfred(ia:ib)-xmed - ccfred(ia-1)=ccfred(ia) - ccfred(ib+1)=ccfred(ib) - - do i=ia,ib - freq=i*df - itry=0 -! if(naggressive.gt.0 .and. ntol.lt.1000 .and. ccfmax.ge.thresh0) then - if(naggressive.gt.0 .and. ccfmax.ge.thresh0) then - if(i.ne.ipk) cycle - itry=1 - ncand=ncand+1 - else - if(ccfred(i).ge.thresh0 .and. ccfred(i).gt.ccfred(i-1) .and. & - ccfred(i).gt.ccfred(i+1)) then - itry=1 - ncand=ncand+1 - endif - endif - if(itry.ne.0) then - call xcor(i,nqsym,nsym,lag1,lag2,ccfblue,ccf0,lagpk,flip,fdot,nrobust) - if(.not.bVHF) call slope(ccfblue(lag1),lag2-lag1+1, & - lagpk-lag1+1.0) - xlag=lagpk - if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then - call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2) - xlag=lagpk+dx2 - endif - dtx=xlag*1024.0/11025.0 - ccfblue(lag1)=0. - ccfblue(lag2)=0. - ca(ncand)%freq=freq - ca(ncand)%dt=dtx - ca(ncand)%flip=flip - if(bVHF) then - ca(ncand)%sync=db(ccfred(i)) - 16.0 - else - ca(ncand)%sync=ccfred(i) - endif - endif - if(ncand.eq.MAXCAND) exit - enddo - - return -end subroutine sync65 diff --git a/lib/sync9.f90 b/lib/sync9.f90 deleted file mode 100644 index 635c1b5..0000000 --- a/lib/sync9.f90 +++ /dev/null @@ -1,96 +0,0 @@ -subroutine sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipkbest) - - include 'constants.f90' - real ss(184,NSMAX) - real ss1(184) - real ccfred(NSMAX) - real savg(NSMAX) - real savg2(NSMAX) - real smo(-5:25) - real sq(NSMAX) - real red2(NSMAX) - character*27 cr - data cr/'(C) 2016, Joe Taylor - K1JT'/ - include 'jt9sync.f90' - - ipk=0 - ipkbest=0 - sbest=0. - ccfred=0. - - do i=ia,ib !Loop over freq range - ss1=ss(1:184,i) - call pctile(ss1,nzhsym,40,xmed) - - ss1=ss1/xmed - 1.0 - do j=1,nzhsym - if(ss1(j).gt.3.0) ss1(j)=3.0 - enddo - - call pctile(ss1,nzhsym,45,sbase) - ss1=ss1-sbase - sq0=dot_product(ss1(1:nzhsym),ss1(1:nzhsym)) - rms=sqrt(sq0/(nzhsym-1)) - - smax=0. - do lag=lag1,lag2 !DT = 2.5 to 5.0 s - sum1=0. - sq2=sq0 - nsum=nzhsym - do j=1,16 !Sum over 16 sync symbols - k=ii2(j) + lag - if(k.ge.1 .and. k.le.nzhsym) then - sum1=sum1 + ss1(k) - sq2=sq2 - ss1(k)*ss1(k) - nsum=nsum-1 - endif - enddo - if(sum1.gt.smax) then - smax=sum1 - ipk=i - endif - rms=sqrt(sq2/(nsum-1)) - enddo - ccfred(i)=smax !Best at this freq, over all lags - if(smax.gt.sbest) then - sbest=smax - ipkbest=ipk - endif - enddo - - call pctile(ccfred(ia),ib-ia+1,50,xmed) - if(xmed.le.0.0) xmed=1.0 - ccfred=2.0*ccfred/xmed - - savg=0. - do j=1,nzhsym - savg(ia:ib)=savg(ia:ib) + ss(j,ia:ib) - enddo - savg(ia:ib)=savg(ia:ib)/nzhsym - smo(0:20)=1.0/21.0 - smo(-5:-1)=-(1.0/21.0)*(21.0/10.0) - smo(21:25)=smo(-5) - - do i=ia,ib - sm=0. - do j=-5,25 - if(i+j.ge.1 .and. i+j.lt.NSMAX) sm=sm + smo(j)*savg(i+j) - enddo - savg2(i)=sm - sq(i)=sm*sm - enddo - - call pctile(sq(ia:ib),ib-ia+1,20,sq0) - rms=sqrt(sq0) - savg2(ia:ib)=savg2(ia:ib)/(5.0*rms) - - red2=0. - do i=ia+11,ib-10 - ref=max(savg2(i-10),savg2(i+10)) - red2(i)=savg2(i)-ref - if(red2(i).lt.-99.0) red2(i)=-99.0 - if(red2(i).gt.99.0) red2(i)=99.0 - enddo - - return -end subroutine sync9 diff --git a/lib/sync9f.f90 b/lib/sync9f.f90 deleted file mode 100644 index 8aca06b..0000000 --- a/lib/sync9f.f90 +++ /dev/null @@ -1,55 +0,0 @@ -subroutine sync9f(s2,nq,nfa,nfb,ss2,ss3,lagpk,ipk,ccfbest) - -! Look for JT9 sync pattern in the folded symbol spectra, s2. -! Frequency search extends from nfa to nfb. Synchronized symbol -! spectra are put into ss2() and ss3(). - - integer ii4(16) - real s2(240,340) - real ss2(0:8,85) - real ss3(0:7,69) - include 'jt9sync.f90' - - ii4=4*ii-3 - ccf=0. - ccfbest=0. - nfft=4*nq - df=12000.0/nfft - ia=nfa/df - ib=nfb/df + 0.9999 - - do i=ia,ib - do lag=0,339 - t=0. - do n=1,16 - j=ii4(n)+lag - if(j.gt.340) j=j-340 - t=t + s2(i,j) - enddo - if(t.gt.ccfbest) then - lagpk=lag - ipk=i - ccfbest=t - endif - enddo - enddo - - do i=0,8 - j4=lagpk-4 - i2=2*i + ipk - if(i2.lt.1) i2=1 - m=0 - do j=1,85 - j4=j4+4 - if(j4.gt.340) j4=j4-340 - if(j4.lt.1) j4=j4+340 - ss2(i,j)=s2(i2,j4) - if(i.ge.1 .and. isync(j).eq.0) then - m=m+1 - ss3(i-1,m)=ss2(i,j) - endif - enddo - enddo - - return -end subroutine sync9f diff --git a/lib/sync9w.f90 b/lib/sync9w.f90 deleted file mode 100644 index f69720d..0000000 --- a/lib/sync9w.f90 +++ /dev/null @@ -1,81 +0,0 @@ -subroutine sync9w(ss,nzhsym,lag1,lag2,ia,ib,ccfred,ccfblue,ipkbest,lagpk,nadd) - - include 'constants.f90' - real ss(184,NSMAX) - real ss1(184),ss1save(184) - real ccfred(NSMAX) - real ccfblue(-9:18) - real sa(NSMAX),sb(NSMAX) - include 'jt9sync.f90' - -! Smooth the symbol spectra (by an amount consistent with measured width??) - do j=1,nzhsym - sa=ss(j,1:NSMAX) - call smo(sa,NSMAX,sb,nadd) - call smo(sb,NSMAX,sa,nadd) - ss(j,1:NSMAX)=sa - enddo - - ipk=0 - ipkbest=0 - sbest=0. - ccfred=0. - df=12000.0/16384.0 - - do i=ia,ib !Loop over specified freq range - ss1=ss(1:184,i) !Symbol amplitudes at this freq - call pctile(ss1,nzhsym,50,xmed) !Median level at this freq - ss1=ss1/xmed - 1.0 - - smax=0. !Find DT in specified range - do lag=lag1,lag2 - sum1=0. - nsum=nzhsym - do j=1,16 !Sum over 16 sync symbols - k=ii2(j) + lag - if(k.ge.1 .and. k.le.nzhsym) then - sum1=sum1 + ss1(k) - nsum=nsum-1 - endif - enddo - if(sum1.gt.smax) then - smax=sum1 - ipk=i - endif - enddo - - ccfred(i)=smax !Best at this freq, over all lags - if(smax.gt.sbest) then - sbest=smax - ipkbest=ipk - ss1save=ss1 - endif - enddo - - call pctile(ccfred(ia),ib-ia+1,50,xmed) - if(xmed.le.0.0) xmed=1.0 - ccfred=ccfred/xmed - - ss1=ss1save - smax=0. !Find DT in specified range - do lag=lag1,lag2 - sum1=0. - nsum=nzhsym - do j=1,16 !Sum over 16 sync symbols - k=ii2(j) + lag - if(k.ge.1 .and. k.le.nzhsym) then - sum1=sum1 + ss1(k) - nsum=nsum-1 - endif - enddo - ccfblue(lag)=sum1 - if(sum1.gt.smax) then - smax=sum1 - lagpk=lag - endif - enddo - if(lagpk.eq.-9) lagpk=-8 !Protect the ends of ccfblue() - if(lagpk.eq.18) lagpk=17 - - return -end subroutine sync9w diff --git a/lib/synciscat.f90 b/lib/synciscat.f90 deleted file mode 100644 index 5ce27ac..0000000 --- a/lib/synciscat.f90 +++ /dev/null @@ -1,185 +0,0 @@ -subroutine synciscat(cdat,npts,nh,npct,s0,jsym,df,ntol,NFreeze, & - MouseDF,mousebutton,mode4,nafc,psavg,xsync,sig,ndf0,msglen, & - ipk,jpk,idf,df1) - -! Synchronize an ISCAT signal -! cdat() is the downsampled analytic signal. -! Sample rate = fsample = BW = 11025 * (9/32) = 3100.78125 Hz -! npts, nsps, etc., are all reduced by 9/32 - - parameter (NMAX=30*3101) - parameter (NSZ=4*1400) - complex cdat(NMAX) - complex c(288) - real s0(288,NSZ) - real fs0(288,96) !108 = 96 + 3*4 - real savg(288) - real sref(288) - real psavg(72) !Average spectrum of whole file - integer icos(4) - data icos/0,1,3,2/ - data nsync/4/,nlen/2/,ndat/18/ - -! Silence compiler warnings: - sigbest=-20.0 - ndf0best=0 - msglenbest=0 - ipkbest=0 - jpkbest=0 - ipk2=0 - idfbest=mousebutton - - fsample=3100.78125 !New sample rate - nsps=144/mode4 - nsym=npts/nsps - 1 - nblk=nsync+nlen+ndat - nfft=2*nsps !FFTs at twice the symbol length, - - kstep=nsps/4 ! stepped by 1/4 symbol - df=fsample/nfft - fac=1.0/1000.0 !Somewhat arbitrary - savg=0. - s0=0. - - ia=1-kstep - do j=1,4*nsym !Compute symbol spectra - ia=ia+kstep - ib=ia+nsps-1 - if(ib.gt.npts) exit - c(1:nsps)=fac*cdat(ia:ib) - c(nsps+1:nfft)=0. - call four2a(c,nfft,1,-1,1) - do i=1,nfft - s0(i,j)=real(c(i))**2 + aimag(c(i))**2 - savg(i)=savg(i) + s0(i,j) !Accumulate avg spectrum - enddo - i0=40 - enddo - - jsym=4*nsym - savg=savg/jsym - - do i=1,71 !Compute spectrum in dB, for plot - if(mode4.eq.1) then - psavg(i)=2*db(savg(4*i)+savg(4*i-1)+savg(4*i-2)+savg(4*i-3)) + 1.0 - else - psavg(i)=2*db(savg(2*i)+savg(2*i-1)) + 7.0 - endif - enddo - - do i=nh+1,nfft-nh - call pctile(savg(i-nh),2*nh+1,npct,sref(i)) - enddo - sref(1:nh)=sref(nh+11) - sref(nfft-nh+1:nfft)=sref(nfft-nh) - - do i=1,nfft !Normalize the symbol spectra - fac=1.0/sref(i) - if(i.lt.11) fac=1.0/savg(11) - do j=1,jsym - s0(i,j)=fac*s0(i,j) - enddo - enddo - - nfold=jsym/96 - jb=96*nfold - - ttot=npts/fsample !Length of record (s) - df1=df/ttot !Step size for f1=fdot - idf1=-25.0/df1 - idf2=5.0/df1 - if(nafc.eq.0) then - idf1=0 - idf2=0 - else if(mod(-idf1,2).eq.1) then - idf1=idf1-1 - endif - - xsyncbest=0. - do idf=idf1,idf2 !Loop over fdot - fs0=0. - do j=1,jb !Fold s0 into fs0, modulo 4*nblk - k=mod(j-1,4*nblk)+1 - ii=nint(idf*float(j-jb/2)/float(jb)) - ia=max(1-ii,1) - ib=min(nfft-ii,nfft) - do i=ia,ib - fs0(i,k)=fs0(i,k) + s0(i+ii,j) - enddo - enddo - ref=nfold*4 - - i0=27 - if(mode4.eq.1) i0=95 - ia=i0-nint(ntol/df) - ib=i0+nint(ntol/df) - if(ia.lt.1) ia=1 - if(ib.gt.nfft-3) ib=nfft-3 - - smax=0. - ipk=1 - jpk=1 - do j=0,4*nblk-1 !Find sync pattern: lags 0-95 - do i=ia,ib !Search specified freq range - ss=0. - do n=1,4 !Sum over 4 sync tones - k=j+4*n-3 - if(k.gt.96) k=k-96 - ss=ss + fs0(i+2*icos(n),k) - enddo - if(ss.gt.smax) then - smax=ss - ipk=i !Frequency offset, DF - jpk=j+1 !Time offset, DT - endif - enddo - enddo - - xsync=smax/ref - 1.0 - if(nfold.lt.26) xsync=xsync * sqrt(nfold/26.0) - xsync=xsync-0.5 !Empirical - - sig=db(smax/ref - 1.0) - 15.0 - if(mode4.eq.1) sig=sig-5.0 -! if(sig.lt.-20 .or. xsync.lt.1.0) sig=-20.0 -! if(sig.lt.-20) sig=-20.0 - ndf0=nint(df*(ipk-i0)) - - smax=0. - ja=jpk+16 - if(ja.gt.4*nblk) ja=ja-4*nblk - jj=jpk+20 - if(jj.gt.4*nblk) jj=jj-4*nblk - do i=ipk,ipk+60,2 !Find User's message length - ss=fs0(i,ja) + fs0(i+10,jj) - if(ss.gt.smax) then - smax=ss - ipk2=i - endif - enddo - - msglen=(ipk2-ipk)/2 - if(msglen.lt.2 .or. msglen.gt.29) cycle - - if(xsync.ge.xsyncbest) then - xsyncbest=xsync - sigbest=sig - ndf0best=ndf0 - msglenbest=msglen - ipkbest=ipk - jpkbest=jpk - idfbest=idf - endif - enddo - - xsync=xsyncbest - sig=sigbest - ndf0=ndf0best - msglen=msglenbest - ipk=ipkbest - jpk=jpkbest - idf=idfbest - if(nafc.eq.0) idf=0 - - return -end subroutine synciscat diff --git a/lib/syncmsk.f90 b/lib/syncmsk.f90 deleted file mode 100644 index be28a3b..0000000 --- a/lib/syncmsk.f90 +++ /dev/null @@ -1,304 +0,0 @@ -subroutine syncmsk(cdat,npts,jpk,ipk,idf,rmax,snr,metric,decoded) - -! Attempt synchronization, and if successful decode using Viterbi algorithm. - - use iso_c_binding, only: c_loc,c_size_t - use packjt - use hashing - use timer_module, only: timer - - parameter (NSPM=1404,NSAVE=2000) - complex cdat(npts) !Analytic signal - complex cb(66) !Complex waveform for Barker-11 code - complex cd(0:11,0:3) - complex c(0:NSPM-1) !Complex data for one message length - complex c2(0:NSPM-1) - complex cb3(1:NSPM,3) - real r(12000) - real rdat(12000) - real ss1(12000) - real symbol(234) - real rdata(198) - real rd2(198) - real rsave(NSAVE) - real xp(29) - complex z,z0,z1,z2,z3,cfac - integer*1 e1(198) - integer*1, target :: d8(13) - integer*1 i1hash(4) - integer*1 i1 - integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words - integer mettab(0:255,0:1) !Metric table for BPSK modulation - integer ipksave(NSAVE) - integer jpksave(NSAVE) - integer indx(NSAVE) - integer b11(11) !Barker-11 code - character*22 decoded - character*72 c72 - logical first - equivalence (i1,i4) - equivalence (ihash,i1hash) - data xp/0.500000, 0.401241, 0.309897, 0.231832, 0.168095, & - 0.119704, 0.083523, 0.057387, 0.039215, 0.026890, & - 0.018084, 0.012184, 0.008196, 0.005475, 0.003808, & - 0.002481, 0.001710, 0.001052, 0.000789, 0.000469, & - 0.000329, 0.000225, 0.000187, 0.000086, 0.000063, & - 0.000017, 0.000091, 0.000032, 0.000045/ - data first/.true./ - data b11/1,1,1,0,0,0,1,0,0,1,0/ - save first,cb,cd,twopi,dt,f0,f1,mettab - - phi=0. - if(first) then -! Get the metric table - bias=0.0 - scale=20.0 - xln2=log(2.0) - mettab=0 - do i=128,156 - x0=log(max(0.001,2.0*xp(i-127)))/xln2 - x1=log(max(0.001,2.0*(1.0-xp(i-127))))/xln2 - mettab(i,0)=nint(scale*(x0-bias)) - mettab(i,1)=nint(scale*(x1-bias)) - mettab(256-i,0)=mettab(i,1) - mettab(256-i,1)=mettab(i,0) - enddo - do i=157,255 - mettab(i,0)=mettab(156,0) - mettab(i,1)=mettab(156,1) - mettab(256-i,0)=mettab(i,1) - mettab(256-i,1)=mettab(i,0) - enddo - j=0 - twopi=8.0*atan(1.0) - dt=1.0/12000.0 - f0=1000.0 - f1=2000.0 - dphi=0 - do i=1,11 - if(b11(i).eq.0) dphi=twopi*f0*dt - if(b11(i).eq.1) dphi=twopi*f1*dt - do n=1,6 - j=j+1 - phi=phi+dphi - cb(j)=cmplx(cos(phi),sin(phi)) - enddo - enddo - cb3=0. - cb3(1:66,1)=cb - cb3(283:348,1)=cb - cb3(769:834,1)=cb - - cb3(1:66,2)=cb - cb3(487:552,2)=cb - cb3(1123:1188,2)=cb - - cb3(1:66,3)=cb - cb3(637:702,3)=cb - cb3(919:984,3)=cb - - phi=0. - do n=0,3 - k=-1 - dphi=twopi*f0*dt - if(n.ge.2) dphi=twopi*f1*dt - do i=0,5 - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - cd(k,n)=cmplx(cos(phi),sin(phi)) - enddo - - dphi=twopi*f0*dt - if(mod(n,2).eq.1) dphi=twopi*f1*dt - do i=6,11 - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - cd(k,n)=cmplx(cos(phi),sin(phi)) - enddo - enddo - - first=.false. - endif - - nfft=NSPM - jz=npts-nfft - decoded=" " - ipk=0 - jpk=0 - metric=-9999 - r=0. - - call timer('sync1 ',0) - do j=1,jz !Find the Barker-11 sync vectors - z=0. - ss=0. - do i=1,66 - ss=ss + real(cdat(j+i-1))**2 + aimag(cdat(j+i-1))**2 - z=z + cdat(j+i-1)*conjg(cb(i)) !Signal matching Barker 11 - enddo - ss=sqrt(ss/66.0)*66.0 - r(j)=abs(z)/(0.908*ss) !Goodness-of-fit to Barker 11 - ss1(j)=ss - enddo - call timer('sync1 ',1) - - call timer('sync2 ',0) - jz=npts-nfft - rmax=0. -! n1=35, n2=69, n3=94 - k=0 - do j=1,jz !Find best full-message sync - if(ss1(j).lt.85.0) cycle - r1=r(j) + r(j+282) + r(j+768) ! 6*(12+n1) 6*(24+n1+n2) - r2=r(j) + r(j+486) + r(j+1122) ! 6*(12+n2) 6*(24+n2+n3) - r3=r(j) + r(j+636) + r(j+918) ! 6*(12+n3) 6*(24+n3+n1) - if(r1.gt.rmax) then - rmax=r1 - jpk=j - ipk=1 - endif - if(r2.gt.rmax) then - rmax=r2 - jpk=j - ipk=2 - endif - if(r3.gt.rmax) then - rmax=r3 - jpk=j - ipk=3 - endif - rrmax=max(r1,r2,r3) - if(rrmax.gt.1.9) then - k=min(k+1,NSAVE) - if(r1.eq.rrmax) ipksave(k)=1 - if(r2.eq.rrmax) ipksave(k)=2 - if(r3.eq.rrmax) ipksave(k)=3 - jpksave(k)=j - rsave(k)=rrmax - endif - enddo - call timer('sync2 ',1) - kmax=k - - call indexx(rsave,kmax,indx) - - call timer('sync3 ',0) - do kk=1,kmax - k=indx(kmax+1-kk) - ipk=ipksave(k) - jpk=jpksave(k) - rmax=rsave(k) - - c=conjg(cb3(1:NSPM,ipk))*cdat(jpk:jpk+nfft-1) - smax=0. - dfx=0. - idfbest=0 - do itry=1,25 - idf=itry/2 - if(mod(itry,2).eq.0) idf=-idf - idf=4*idf - twk=idf - call tweak1(c,NSPM,-twk,c2) - z=sum(c2) - if(abs(z).gt.smax) then - dfx=twk - smax=abs(z) - phi=atan2(aimag(z),real(z)) !Carrier phase offset - idfbest=idf - endif - enddo - idf=idfbest - call tweak1(cdat,npts,-dfx,cdat) - cfac=cmplx(cos(phi),-sin(phi)) - cdat=cfac*cdat - - sig=0. - ref=0. - rdat(1:npts)=cdat - iz=11 - do k=1,234 !Compute soft symbols - j=jpk+6*(k-1) - - z0=2.0*dot_product(cdat(j:j+iz),cd(0:iz,0)) - z1=2.0*dot_product(cdat(j:j+iz),cd(0:iz,1)) - z2=2.0*dot_product(cdat(j:j+iz),cd(0:iz,2)) - z3=2.0*dot_product(cdat(j:j+iz),cd(0:iz,3)) - -!### Maybe these should be weighted by yellow() ? - if(j+1404+iz.lt.npts) then - z0=z0 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,0)) - z1=z1 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,1)) - z2=z2 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,2)) - z3=z3 + dot_product(cdat(j+1404:j+1404+iz),cd(0:iz,3)) - endif - - if(j-1404.ge.1) then - z0=z0 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,0)) - z1=z1 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,1)) - z2=z2 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,2)) - z3=z3 + dot_product(cdat(j-1404:j-1404+iz),cd(0:iz,3)) - endif - - sym=max(abs(real(z2)),abs(real(z3))) - max(abs(real(z0)),abs(real(z1))) - - if(sym.lt.0.0) then - phi=atan2(aimag(z0),real(z0)) - sig=sig + real(z0)**2 - ref=ref + aimag(z0)**2 - else - phi=atan2(aimag(z1),real(z1)) - sig=sig + real(z1)**2 - ref=ref + aimag(z1)**2 - endif - n=k - if(ipk.eq.2) n=k+47 - if(ipk.eq.3) n=k+128 - if(n.gt.234) n=n-234 - ibit=0 - if(sym.ge.0) ibit=1 - symbol(n)=sym - enddo - snr=db(sig/ref-1.0) - - rdata(1:35)=symbol(12:46) - rdata(36:104)=symbol(59:127) - rdata(105:198)=symbol(140:233) - -! Re-order the symbols and make them i*1 - j=0 - do i=1,99 - i4=128+rdata(i) !### Should be nint() ??? ### - if(i4.gt.255) i4=255 - if(i4.lt.0) i4=0 - j=j+1 - e1(j)=i1 - rd2(j)=rdata(i) - i4=128+rdata(i+99) - if(i4.gt.255) i4=255 - if(i4.lt.0) i4=0 - j=j+1 - e1(j)=i1 - rd2(j)=rdata(i+99) - enddo - -! Decode the message - nb1=87 - call vit213(e1,nb1,mettab,d8,metric) - ihash=nhash(c_loc(d8),int(9,c_size_t),146) - ihash=2*iand(ihash,32767) - decoded=' ' - if(d8(10).eq.i1hash(2) .and. d8(11).eq.i1hash(1)) then - write(c72,1012) d8(1:9) -1012 format(9b8.8) - read(c72,1014) i4Msg6BitWords -1014 format(12b6.6) - call unpackmsg(i4Msg6BitWords,decoded,.false.,' ') !Unpack to get msgsent - endif - if(decoded.ne.' ') exit - enddo - call timer('sync3 ',1) - - return -end subroutine syncmsk diff --git a/lib/to_contest_msg.f90 b/lib/to_contest_msg.f90 deleted file mode 100644 index 4269195..0000000 --- a/lib/to_contest_msg.f90 +++ /dev/null @@ -1,27 +0,0 @@ -subroutine to_contest_msg(msg0,msg) - -! If the message has "R grid4" istead of "grid4", remove the "R " -! and substitute the diametrically opposite grid. - - character*6 g1,g2 - character*22 msg0,msg - logical isgrid - isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & - g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & - g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' - - i0=index(msg0,' R ') + 3 !Check for ' R ' in message - g1=msg0(i0:i0+3)//' ' - if(isgrid(g1)) then !Check for ' R grid' - call grid2deg(g1,dlong,dlat) - dlong=dlong+180.0 - if(dlong.gt.180.0) dlong=dlong-360.0 - dlat=-dlat - call deg2grid(dlong,dlat,g2) !g2=antipodes grid - msg=msg0(1:i0-3)//g2(1:4) !Send message with g2 - else - msg=msg0 - endif - - return -end subroutine to_contest_msg diff --git a/lib/twkfreq65.f90 b/lib/twkfreq65.f90 deleted file mode 100644 index 85847c7..0000000 --- a/lib/twkfreq65.f90 +++ /dev/null @@ -1,25 +0,0 @@ -subroutine twkfreq65(c4aa,n5,a) - - complex c4aa(n5) - real a(5) - complex w,wstep - data twopi/6.283185307/ - -! Apply AFC corrections to the c4aa data - w=1.0 - wstep=1.0 - x0=0.5*(n5+1) - s=2.0/n5 - do i=1,n5 - x=s*(i-x0) - if(mod(i,100).eq.1) then - p2=1.5*x*x - 0.5 - dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/1378.125) - wstep=cmplx(cos(dphi),sin(dphi)) - endif - w=w*wstep - c4aa(i)=w*c4aa(i) - enddo - - return -end subroutine twkfreq65 diff --git a/lib/unpackmsg144.f90 b/lib/unpackmsg144.f90 deleted file mode 100644 index 96423ff..0000000 --- a/lib/unpackmsg144.f90 +++ /dev/null @@ -1,117 +0,0 @@ - subroutine unpackmsg144(dat,msg,c1,c2) -! special unpackmsg for MSK144 - returns call1 and call2 to enable -! maintenance of a recent-calls-heard list - - use packjt - parameter (NBASE=37*36*10*27*27*27) - parameter (NGBASE=180*180) - integer dat(12) - character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4 - logical cqnnn - - cqnnn=.false. - nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ & - ishft(dat(4),4) + iand(ishft(dat(5),-2),15) - - nc2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) + & - ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) + & - iand(ishft(dat(10),-4),3) - - ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12) - - if(ng.ge.32768) then - call unpacktext(nc1,nc2,ng,msg) - c1(1:12)=' ' - c2(1:12)=' ' - go to 100 - endif - - call unpackcall(nc1,c1,iv2,psfx) - if(iv2.eq.0) then - ! This is an "original JT65" message - if(nc1.eq.NBASE+1) c1='CQ ' - if(nc1.eq.NBASE+2) c1='QRZ ' - nfreq=nc1-NBASE-3 - if(nfreq.ge.0 .and. nfreq.le.999) then - write(c1,1002) nfreq - 1002 format('CQ ',i3.3) - cqnnn=.true. - endif - endif - - call unpackcall(nc2,c2,junk1,junk2) - call unpackgrid(ng,grid) - - if(iv2.gt.0) then - ! This is a JT65v2 message - do i=1,4 - if(ichar(psfx(i:i)).eq.0) psfx(i:i)=' ' - enddo - - n1=len_trim(psfx) - n2=len_trim(c2) - if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid - if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid - if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid - if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid - if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid - if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid - if(iv2.eq.7) msg='DE '//c2(:n2)//' '//grid - if(iv2.eq.8) msg=' ' - go to 100 - else - - endif - - grid6=grid//'ma' - call grid2k(grid6,k) - if(k.ge.1 .and. k.le.450) call getpfx2(k,c1) - if(k.ge.451 .and. k.le.900) call getpfx2(k,c2) - - i=index(c1,char(0)) - if(i.ge.3) c1=c1(1:i-1)//' ' - i=index(c2,char(0)) - if(i.ge.3) c2=c2(1:i-1)//' ' - - msg=' ' - j=0 - if(cqnnn) then - msg=c1//' ' - j=7 !### ??? ### - go to 10 - endif - - do i=1,12 - j=j+1 - msg(j:j)=c1(i:i) - if(c1(i:i).eq.' ') go to 10 - enddo - j=j+1 - msg(j:j)=' ' - - 10 do i=1,12 - if(j.le.21) j=j+1 - msg(j:j)=c2(i:i) - if(c2(i:i).eq.' ') go to 20 - enddo - if(j.le.21) j=j+1 - msg(j:j)=' ' - - 20 if(k.eq.0) then - do i=1,4 - if(j.le.21) j=j+1 - msg(j:j)=grid(i:i) - enddo - if(j.le.21) j=j+1 - msg(j:j)=' ' - endif - - 100 continue - if(msg(1:6).eq.'CQ9DX ') msg(3:3)=' ' - if(msg(1:2).eq.'E9' .and. & - msg(3:3).ge.'A' .and. msg(3:3).le.'Z' .and. & - msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. & - msg(5:5).eq.' ') msg='CQ '//msg(3:) - - return - end subroutine unpackmsg144 diff --git a/lib/wspr_downsample.f90 b/lib/wspr_downsample.f90 deleted file mode 100644 index 22cc478..0000000 --- a/lib/wspr_downsample.f90 +++ /dev/null @@ -1,76 +0,0 @@ -subroutine wspr_downsample(id2,k) - -! Input: -! id2 raw 16-bit integer data, 12000 Hz sample rate -! k pointer to the most recent new data - -! Output (in common/c0com) -! c0 complex data downsampled to 1500 Hz - - parameter (NMAX=120*12000) !Total sample intervals per 30 minutes - parameter (NDMAX=120*1500) !Sample intervals at 1500 Hz rate - parameter (NSMAX=1366) !Max length of saved spectra - parameter (NFFT1=1024) - parameter (MAXFFT3=32768) - real*4 w3(MAXFFT3) - real*4 x0(NFFT1) - real*4 x2(NFFT1+105) - real*4 ssum(NSMAX) - integer*2 id2(NMAX) - complex c0 - common/c0com/c0(NDMAX) - data rms/999.0/,k0/99999999/,nfft3z/0/,nsps/8192/,nbfo/1500/ - save - - nfft3=nsps/4 - jstep=nsps/16 - if(k.gt.NMAX) go to 999 - if(k.lt.nfft3) go to 999 !Wait for enough samples to start - if(nfft3.ne.nfft3z) then - pi=4.0*atan(1.0) - do i=1,nfft3 - w3(i)=2.0*(sin(i*pi/nfft3))**2 !Window for nfft3 - enddo - nfft3z=nfft3 - endif - - if(k.lt.k0) then - ja=0 - ssum=0. - k1=0 - k8=0 - x2=0. -! if(ndiskdat.eq.0) then -! id2(k+1:)=0 -! c0=0. !This is necessary to prevent "ghosts". Not sure why. -! endif - endif - k0=k - - nzap=0 - nbslider=0 - sigmas=1.0*(10.0**(0.01*nbslider)) + 0.7 - peaklimit=sigmas*max(10.0,rms) - px=0. - - nwindow=2 - kstep1=NFFT1 - if(nwindow.ne.0) kstep1=NFFT1/2 - fac=2.0/NFFT1 - nblks=(k-k1)/kstep1 - gain=1.0 - nb=0 - do nblk=1,nblks - do i=1,NFFT1 - x0(i)=gain*id2(k1+i) - enddo -! call timf2(x0,k,NFFT1,nwindow,nb,peaklimit,x1, & -! slimit,lstrong,px,nzap) -! Mix at nbfo Hz, lowpass at +/-750 Hz, and downsample to 1500 Hz complex. - call mixlpf(x0,nbfo,c0(k8+1)) - k1=k1+kstep1 - k8=k8+kstep1/8 - enddo - -999 return -end subroutine wspr_downsample diff --git a/lib/zplot9.f90 b/lib/zplot9.f90 deleted file mode 100644 index 6c56c9f..0000000 --- a/lib/zplot9.f90 +++ /dev/null @@ -1,31 +0,0 @@ -subroutine zplot9(s,freq,drift) - - real s(0:8,85) - character*1 line(85),mark(0:6) - data mark/' ',' ','.','-','+','X','$'/ - include 'jt9sync.f90' - - write(32,1000) freq,drift -1000 format('Freq:',f7.1,' Drift:',f5.1,' ',60('-')) - do j=8,0,-1 - do i=1,85 - n=(s(j,i)) - if(n.lt.0) n=0 - if(n.gt.6) n=6 - line(i)=mark(n) - enddo - write(32,1010) j,line -1010 format(i1,1x,85a1) - enddo - do i=1,85 - line(i)=' ' - if(isync(i).eq.1) line(i)='@' - enddo - write(32,1015) -1015 format(87('-')) - write(32,1020) line -1020 format(2x,85a1) - call flush(32) - - return -end subroutine zplot9 diff --git a/mainwindow.cpp b/mainwindow.cpp index 0f71452..ecc1273 100644 --- a/mainwindow.cpp +++ b/mainwindow.cpp @@ -53,7 +53,6 @@ #include "StationList.hpp" #include "LiveFrequencyValidator.hpp" #include "MessageClient.hpp" -#include "wsprnet.h" #include "signalmeter.h" #include "HelpTextWindow.hpp" #include "Audio/BWFFile.hpp" @@ -271,8 +270,6 @@ MainWindow::MainWindow(QDir const& temp_directory, bool multiple, m_settings_read {false}, ui(new Ui::MainWindow), m_config {temp_directory, m_settings, this}, - m_WSPR_band_hopping {m_settings, &m_config, this}, - m_WSPR_tx_next {false}, m_rigErrorMessageBox {MessageBox::Critical, tr ("Rig Control Error") , MessageBox::Cancel | MessageBox::Ok | MessageBox::Retry}, m_isWideGraphMDI {false}, @@ -311,7 +308,6 @@ MainWindow::MainWindow(QDir const& temp_directory, bool multiple, m_nclearave {1}, m_pctx {0}, m_nseq {0}, - m_nWSPRdecodes {0}, m_k0 {9999999}, m_nPick {0}, m_frequency_list_fcal_iter {m_config.frequencies ()->begin ()}, @@ -557,14 +553,6 @@ MainWindow::MainWindow(QDir const& temp_directory, bool multiple, connect (m_messageClient, &MessageClient::error, this, &MainWindow::udpNetworkError); connect (m_messageClient, &MessageClient::message, this, &MainWindow::networkMessage); -#if 0 - // Hook up WSPR band hopping - connect (ui->band_hopping_schedule_push_button, &QPushButton::clicked - , &m_WSPR_band_hopping, &WSPRBandHopping::show_dialog); - connect (ui->sbTxPercent, static_cast (&QSpinBox::valueChanged) - , &m_WSPR_band_hopping, &WSPRBandHopping::set_tx_percent); -#endif - // decoder queue handler //connect (&m_decodeThread, &QThread::finished, m_notification, &QObject::deleteLater); //connect(this, &MainWindow::decodedLineReady, this, &MainWindow::processDecodedLine); @@ -13617,14 +13605,6 @@ void MainWindow::WSPR_history(Frequency dialFreq, int ndecodes) void MainWindow::uploadResponse(QString response) { - if (response == "done") { - m_uploading=false; - } else { - if (response.startsWith ("Upload Failed")) { - m_uploading=false; - } - qDebug () << "WSPRnet.org status:" << response; - } } void MainWindow::on_TxPowerComboBox_currentIndexChanged(const QString &arg1) diff --git a/mainwindow.h b/mainwindow.h index 0ea4268..f0400f4 100644 --- a/mainwindow.h +++ b/mainwindow.h @@ -33,7 +33,6 @@ #include "Modes.hpp" #include "FrequencyList.hpp" #include "Configuration.hpp" -#include "WSPRBandHopping.hpp" #include "Transceiver.hpp" #include "DisplayManual.hpp" #include "psk_reporter.h" @@ -58,7 +57,6 @@ #define NUM_JT4_SYMBOLS 206 //(72+31)*2, embedded sync #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 @@ -86,9 +84,7 @@ class Transceiver; class MessageAveraging; class MessageClient; class QTime; -class WSPRBandHopping; class HelpTextWindow; -class WSPRNet; class SoundOutput; class Modulator; class SoundInput; @@ -513,8 +509,6 @@ private: // other windows Configuration m_config; - WSPRBandHopping m_WSPR_band_hopping; - bool m_WSPR_tx_next; MessageBox m_rigErrorMessageBox; QScopedPointer m_equalizationToolsDialog; @@ -591,7 +585,6 @@ private: qint32 m_dBm; qint32 m_pctx; qint32 m_nseq; - qint32 m_nWSPRdecodes; qint32 m_k0; qint32 m_kdone; qint32 m_nPick; diff --git a/wsprnet.cpp b/wsprnet.cpp deleted file mode 100644 index 9e66608..0000000 --- a/wsprnet.cpp +++ /dev/null @@ -1,230 +0,0 @@ -// Interface to WSPRnet website -// -// by Edson Pereira - PY2SDR - -#include "wsprnet.h" - -#include - -#include -#include -#include -#include -#include -#include -#include - -#include "moc_wsprnet.cpp" - -namespace -{ - char const * const wsprNetUrl = "http://wsprnet.org/post?"; - // char const * const wsprNetUrl = "http://127.0.0.1/post?"; -}; - -WSPRNet::WSPRNet(QNetworkAccessManager * manager, QObject *parent) - : QObject{parent} - , networkManager {manager} - , uploadTimer {new QTimer {this}} - , m_urlQueueSize {0} -{ - connect(networkManager, SIGNAL(finished(QNetworkReply*)), this, SLOT(networkReply(QNetworkReply*))); - connect( uploadTimer, SIGNAL(timeout()), this, SLOT(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) -{ - 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; - - // 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; - } - - // Read the contents - while (!wsprdOutFile.atEnd()) { - QHash 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; - } - } - } - m_urlQueueSize = urlQueue.size(); - uploadTimer->start(200); -} - -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 (urlQueue.isEmpty()) { - emit uploadStatus("done"); - QFile::remove(m_file); - uploadTimer->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, QHash &query) -{ - // 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; - } - return true; -} - -QString WSPRNet::urlEncodeNoSpot() -{ - 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 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; -} - -void WSPRNet::work() -{ - if (!urlQueue.isEmpty()) { - if (QNetworkAccessManager::Accessible != networkManager->networkAccessible ()) { - // try and recover network access for QNAM - networkManager->setNetworkAccessible (QNetworkAccessManager::Accessible); - } - 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(); - } -} - -void WSPRNet::abortOutstandingRequests () { - urlQueue.clear (); - for (auto& request : m_outstandingRequests) { - request->abort (); - } - m_urlQueueSize = 0; -} diff --git a/wsprnet.h b/wsprnet.h deleted file mode 100644 index d712d52..0000000 --- a/wsprnet.h +++ /dev/null @@ -1,46 +0,0 @@ -#ifndef WSPRNET_H -#define WSPRNET_H - -#include -#include -#include -#include -#include - -class QNetworkAccessManager; -class QTimer; -class QNetworkReply; - -class WSPRNet : public QObject -{ - Q_OBJECT; - -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 &query); - -signals: - void uploadStatus(QString); - -public slots: - void networkReply(QNetworkReply *); - void work(); - void abortOutstandingRequests (); - -private: - QNetworkAccessManager *networkManager; - QList m_outstandingRequests; - QString m_call, m_grid, m_rfreq, m_tfreq, m_mode, m_tpct, m_dbm, m_vers, m_file; - QQueue urlQueue; - QTimer *uploadTimer; - int m_urlQueueSize; - int m_uploadType; - - QString urlEncodeNoSpot(); - QString urlEncodeSpot(QHash const& spot); -}; - -#endif // WSPRNET_H