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

Reintegrate Joe's experimental VHF & up features 

As at ^/branches/wsjtx_exp@5271



git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@5272 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Bill Somerville 2015-04-22 17:48:03 +00:00
parent 2dfc14b69e
commit a51c5c4251
108 changed files with 7203 additions and 5099 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
CMakeLists.txt
View File

@ -227,6 +227,7 @@ set (wsjtx_CXXSRCS
widegraph.cpp
about.cpp
astro.cpp
messageaveraging.cpp
mainwindow.cpp
Configuration.cpp
main.cpp
@ -251,6 +252,7 @@ set (wsjt_FSRCS
lib/astro.f90
lib/astrosub.f90
lib/astro0.f90
lib/avg4.f90
lib/azdist.f90
lib/baddata.f90
lib/ccf2.f90
@ -265,17 +267,22 @@ set (wsjt_FSRCS
lib/decode65b.f90
lib/fftw3mod.f90
lib/jt9fano.f90
lib/decode4.f90
lib/decoder.f90
lib/decjt9.f90
lib/deep4.f90
lib/deg2grid.f90
lib/demod64a.f90
lib/determ.f90
lib/dot.f90
lib/downsam9.f90
lib/encode232.f90
lib/encode4.f90
lib/entail.f90
lib/extract.F90
lib/extract4.f90
lib/geocentric.f90
lib/getmet4.f90
lib/fano232.f90
lib/fchisq.f90
lib/fchisq65.f90
@ -285,47 +292,45 @@ set (wsjt_FSRCS
lib/filbig.f90
lib/fillcom.f90
lib/flat1.f90
lib/flat1a.f90
lib/flat2.f90
lib/flat4.f90
lib/flat65.f90
lib/four2a.f90
lib/fmtmsg.f90
lib/gen4.f90
lib/gen65.f90
lib/genjt9.f90
lib/gen9.f90
lib/geodist.f90
lib/getlags.f90
lib/getpfx1.f90
lib/getpfx2.f90
lib/graycode.f90
lib/graycode65.f90
lib/grid2deg.f90
lib/grid2k.f90
lib/grid2n.f90
lib/image.f90
lib/indexx.f90
lib/interleave4.f90
lib/interleave63.f90
lib/interleave9.f90
lib/jt4.f90
lib/jt4a.f90
lib/jt65a.f90
lib/k2grid.f90
lib/lpf1.f90
lib/moon2.f90
lib/moondop.f90
lib/morse.f90
lib/move.f90
lib/n2grid.f90
lib/nchar.f90
lib/options.f90
lib/packbits.f90
lib/packcall.f90
lib/packgrid.f90
lib/packmsg.f90
lib/packtext.f90
lib/packjt.f90
lib/pctile.f90
lib/peakdt9.f90
lib/pfxdump.f90
lib/polfit.f90
lib/peakup.f90
lib/polyfit.f90
lib/prog_args.f90
lib/ps4.f90
lib/sec_midn.f90
lib/setup65.f90
lib/sleep_msec.f90
lib/slope.f90
lib/smo.f90
lib/smo121.f90
lib/softsym.f90
@ -335,17 +340,19 @@ set (wsjt_FSRCS
lib/symspec.f90
lib/symspec2.f90
lib/symspec65.f90
lib/sync4.f90
lib/sync9.f90
lib/timer.f90
lib/tm2.f90
lib/toxyz.f90
lib/twkfreq.f90
lib/twkfreq65.f90
lib/unpackbits.f90
lib/unpackcall.f90
lib/unpackgrid.f90
lib/unpackmsg.f90
lib/unpacktext.f90
lib/wav11.f90
lib/wav12.f90
lib/wavhdr.f90
lib/wsjt4.f90
lib/xcor4.f90
lib/zplt.f90
lib/wavhdr.f90
lib/zplot9.f90
)
@ -370,6 +377,7 @@ set (wsjtx_UISRCS
mainwindow.ui
about.ui
astro.ui
messageaveraging.ui
widegraph.ui
logqso.ui
Configuration.ui
@ -542,7 +550,7 @@ endif (APPLE)
#
# Fortran setup
#
set (General_FFLAGS "-Wall -Wno-conversion -fno-second-underscore")
set (General_FFLAGS "-Wall -Wno-conversion -fbounds-check -fno-second-underscore")
# FFLAGS depend on the compiler
get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER} NAME)
@ -648,7 +656,6 @@ endif ()
#
find_package (OpenMP)
#
# fftw3 single precsion library
#
@ -824,6 +831,9 @@ target_link_libraries (jt65code wsjt_fort wsjt_cxx)
add_executable (jt9code lib/jt9code.f90 wsjtx.rc)
target_link_libraries (jt9code wsjt_fort wsjt_cxx)
add_executable (jt4code lib/jt4code.f90 wsjtx.rc)
target_link_libraries (jt4code wsjt_fort wsjt_cxx)
add_executable (jt9 lib/jt9.f90 lib/jt9a.f90 lib/jt9b.f90 lib/jt9c.f90 ${jt9_CXXSRCS} wsjtx.rc)
if (${OPENMP_FOUND} OR APPLE)
if (APPLE)
@ -925,7 +935,7 @@ install (TARGETS wsjtx
BUNDLE DESTINATION . COMPONENT runtime
)
install (TARGETS jt9 jt65code jt9code message_aggregator
install (TARGETS jt9 jt65code jt9code jt4code message_aggregator
RUNTIME DESTINATION ${WSJT_BIN_DESTINATION} COMPONENT runtime
BUNDLE DESTINATION ${WSJT_BIN_DESTINATION} COMPONENT runtime
)

34
Configuration.cpp
View File

@ -566,6 +566,8 @@ private:
bool disable_TX_on_73_;
bool watchdog_;
bool TX_messages_;
bool enable_VHF_features_;
bool decode_at_52s_;
QString udp_server_name_;
port_type udp_server_port_;
bool accept_udp_requests_;
@ -636,6 +638,8 @@ bool Configuration::quick_call () const {return m_->quick_call_;}
bool Configuration::disable_TX_on_73 () const {return m_->disable_TX_on_73_;}
bool Configuration::watchdog () const {return m_->watchdog_;}
bool Configuration::TX_messages () const {return m_->TX_messages_;}
bool Configuration::enable_VHF_features () const {return m_->enable_VHF_features_;}
bool Configuration::decode_at_52s () const {return m_->decode_at_52s_;}
bool Configuration::split_mode () const
{
return !m_->rig_is_dummy_ && m_->rig_params_.split_mode_ != TransceiverFactory::split_mode_none;
@ -675,7 +679,6 @@ void Configuration::transceiver_frequency (Frequency f)
#if WSJT_TRACE_CAT
qDebug () << "Configuration::transceiver_frequency:" << f << m_->cached_rig_state_;
#endif
m_->transceiver_frequency (f);
}
@ -727,23 +730,10 @@ Configuration::impl::impl (Configuration * self, QSettings * settings, QWidget *
, ui_ {new Ui::configuration_dialog}
, settings_ {settings}
, frequencies_ {
{
136130,
474200,
1838000,
3576000,
5357000,
7076000,
10138000,
14076000,
18102000,
21076000,
24917000,
28076000,
50276000,
70091000,
144489000,
}
{ 136130, 474200, 1838000, 3576000, 5357000, 7076000, 10138000, 14076000, 18102000,
21076000, 24917000, 28076000, 50276000, 70091000, 144000000, 144489000, 222000000,
432000000, 902000000, 1296000000, 2301000000, 2304000000, 2320000000, 3400000000,
3456000000, 5760000000,10368000000, 24048000000 }
}
, stations_ {&bands_}
, next_stations_ {&bands_}
@ -1036,6 +1026,8 @@ void Configuration::impl::initialise_models ()
ui_->disable_TX_on_73_check_box->setChecked (disable_TX_on_73_);
ui_->watchdog_check_box->setChecked (watchdog_);
ui_->TX_messages_check_box->setChecked (TX_messages_);
ui_->enable_VHF_features_check_box->setChecked(enable_VHF_features_);
ui_->decode_at_52s_check_box->setChecked(decode_at_52s_);
ui_->jt9w_bandwidth_mult_combo_box->setCurrentText (QString::number (jt9w_bw_mult_));
ui_->jt9w_min_dt_double_spin_box->setValue (jt9w_min_dt_);
ui_->jt9w_max_dt_double_spin_box->setValue (jt9w_max_dt_);
@ -1231,6 +1223,8 @@ void Configuration::impl::read_settings ()
disable_TX_on_73_ = settings_->value ("73TxDisable", false).toBool ();
watchdog_ = settings_->value ("Runaway", false).toBool ();
TX_messages_ = settings_->value ("Tx2QSO", false).toBool ();
enable_VHF_features_ = settings_->value("VHFUHF",false).toBool ();
decode_at_52s_ = settings_->value("Decode52",false).toBool ();
rig_params_.CAT_poll_interval_ = settings_->value ("Polling", 0).toInt ();
rig_params_.split_mode_ = settings_->value ("SplitMode", QVariant::fromValue (TransceiverFactory::split_mode_none)).value<TransceiverFactory::SplitMode> ();
udp_server_name_ = settings_->value ("UDPServer", "localhost").toString ();
@ -1315,6 +1309,8 @@ void Configuration::impl::write_settings ()
settings_->setValue ("TXAudioSource", QVariant::fromValue (rig_params_.TX_audio_source_));
settings_->setValue ("Polling", rig_params_.CAT_poll_interval_);
settings_->setValue ("SplitMode", QVariant::fromValue (rig_params_.split_mode_));
settings_->setValue ("VHFUHF", enable_VHF_features_);
settings_->setValue ("Decode52", decode_at_52s_);
settings_->setValue ("UDPServer", udp_server_name_);
settings_->setValue ("UDPServerPort", udp_server_port_);
settings_->setValue ("AcceptUDPRequests", accept_udp_requests_);
@ -1670,6 +1666,8 @@ void Configuration::impl::accept ()
TX_messages_ = ui_->TX_messages_check_box->isChecked ();
data_mode_ = static_cast<DataMode> (ui_->TX_mode_button_group->checkedId ());
save_directory_ = ui_->save_path_display_label->text ();
enable_VHF_features_ = ui_->enable_VHF_features_check_box->isChecked ();
decode_at_52s_ = ui_->decode_at_52s_check_box->isChecked ();
auto new_server = ui_->udp_server_line_edit->text ();
if (new_server != udp_server_name_)

4
Configuration.hpp
View File

@ -2,6 +2,7 @@
#define CONFIGURATION_HPP_
#include <QObject>
#include <QFont>
#include "Radio.hpp"
#include "AudioDevice.hpp"
@ -14,7 +15,6 @@ class QWidget;
class QAudioDeviceInfo;
class QString;
class QDir;
class QFont;
class Bands;
class FrequencyList;
class StationList;
@ -107,6 +107,8 @@ public:
bool watchdog () const;
bool TX_messages () const;
bool split_mode () const;
bool enable_VHF_features () const;
bool decode_at_52s () const;
bool post_decodes () const;
QString udp_server_name () const;
port_type udp_server_port () const;

14
Configuration.ui
View File

@ -396,6 +396,20 @@ quiet period when decoding is done.</string>
</property>
</widget>
</item>
<item row="2" column="1">
<widget class="QCheckBox" name="enable_VHF_features_check_box">
<property name="text">
<string>Enable VHF/UHF/Microwave features</string>
</property>
</widget>
</item>
<item row="3" column="1">
<widget class="QCheckBox" name="decode_at_52s_check_box">
<property name="text">
<string>Decode at t = 52 s</string>
</property>
</widget>
</item>
</layout>
</widget>
</item>

72
Detector.cpp
View File

@ -11,16 +11,16 @@ extern "C" {
}
Detector::Detector (unsigned frameRate, unsigned periodLengthInSeconds,
unsigned framesPerSignal, unsigned downSampleFactor,
unsigned samplesPerFFT, unsigned downSampleFactor,
QObject * parent)
: AudioDevice (parent)
, m_frameRate (frameRate)
, m_period (periodLengthInSeconds)
, m_downSampleFactor (downSampleFactor)
, m_framesPerSignal (framesPerSignal)
, m_starting (false)
, m_samplesPerFFT (samplesPerFFT)
, m_ns (999)
, m_buffer ((downSampleFactor > 1) ?
new short [framesPerSignal * downSampleFactor] : 0)
new short [samplesPerFFT * downSampleFactor] : 0)
, m_bufferPos (0)
{
(void)m_frameRate; // quell compiler warning
@ -50,31 +50,41 @@ void Detector::clear ()
qint64 Detector::writeData (char const * data, qint64 maxSize)
{
// no torn frames
Q_ASSERT (!(maxSize % static_cast<qint64> (bytesPerFrame ())));
// these are in terms of input frames (not down sampled)
size_t framesAcceptable ((sizeof (jt9com_.d2) /
sizeof (jt9com_.d2[0]) - jt9com_.kin) * m_downSampleFactor);
size_t framesAccepted (qMin (static_cast<size_t> (maxSize /
bytesPerFrame ()), framesAcceptable));
int ns=secondInPeriod();
if(ns < m_ns) { // When ns has wrapped around to zero, restart the buffers
jt9com_.kin = 0;
m_bufferPos = 0;
}
m_ns=ns;
if (framesAccepted < static_cast<size_t> (maxSize / bytesPerFrame ())) {
qDebug () << "dropped " << maxSize / bytesPerFrame () - framesAccepted
<< " frames of data on the floor!";
// no torn frames
Q_ASSERT (!(maxSize % static_cast<qint64> (bytesPerFrame ())));
// these are in terms of input frames (not down sampled)
size_t framesAcceptable ((sizeof (jt9com_.d2) /
sizeof (jt9com_.d2[0]) - jt9com_.kin) * m_downSampleFactor);
size_t framesAccepted (qMin (static_cast<size_t> (maxSize /
bytesPerFrame ()), framesAcceptable));
if (framesAccepted < static_cast<size_t> (maxSize / bytesPerFrame ())) {
qDebug () << "dropped " << maxSize / bytesPerFrame () - framesAccepted
<< " frames of data on the floor!"
<< jt9com_.kin << ns;
}
for (unsigned remaining = framesAccepted; remaining; ) {
size_t numFramesProcessed (qMin (m_framesPerSignal *
size_t numFramesProcessed (qMin (m_samplesPerFFT *
m_downSampleFactor - m_bufferPos, remaining));
if(m_downSampleFactor > 1) {
store (&data[(framesAccepted - remaining) * bytesPerFrame ()],
numFramesProcessed, &m_buffer[m_bufferPos]);
m_bufferPos += numFramesProcessed;
if(m_bufferPos==m_framesPerSignal*m_downSampleFactor) {
qint32 framesToProcess (m_framesPerSignal * m_downSampleFactor);
qint32 framesAfterDownSample;
if(framesToProcess==13824 and jt9com_.kin>=0 and jt9com_.kin<1440000) {
if(m_bufferPos==m_samplesPerFFT*m_downSampleFactor) {
qint32 framesToProcess (m_samplesPerFFT * m_downSampleFactor);
qint32 framesAfterDownSample (m_samplesPerFFT);
if(framesToProcess==13824 and jt9com_.kin>=0 and
jt9com_.kin < (NTMAX*12000 - framesAfterDownSample)) {
fil4_(&m_buffer[0], &framesToProcess, &jt9com_.d2[jt9com_.kin],
&framesAfterDownSample);
jt9com_.kin += framesAfterDownSample;
@ -82,6 +92,7 @@ qint64 Detector::writeData (char const * data, qint64 maxSize)
qDebug() << "framesToProcess = " << framesToProcess;
qDebug() << "jt9com_.kin = " << jt9com_.kin;
qDebug() << "secondInPeriod = " << secondInPeriod();
qDebug() << "framesAfterDownSample" << framesAfterDownSample;
}
Q_EMIT framesWritten (jt9com_.kin);
m_bufferPos = 0;
@ -92,32 +103,15 @@ qint64 Detector::writeData (char const * data, qint64 maxSize)
numFramesProcessed, &jt9com_.d2[jt9com_.kin]);
m_bufferPos += numFramesProcessed;
jt9com_.kin += numFramesProcessed;
if (m_bufferPos == static_cast<unsigned> (m_framesPerSignal)) {
if (m_bufferPos == static_cast<unsigned> (m_samplesPerFFT)) {
Q_EMIT framesWritten (jt9com_.kin);
m_bufferPos = 0;
}
}
if (!secondInPeriod ()) {
if (!m_starting) {
// next samples will be in new period so wrap around to
// start of buffer
//
// we don't bother calling reset () since we expect to fill
// the whole buffer and don't need to waste cycles zeroing
jt9com_.kin = 0;
m_bufferPos = 0;
m_starting = true;
}
} else if(m_starting) {
m_starting = false;
}
remaining -= numFramesProcessed;
}
// } else {
// jt9com_.kin = 0;
// m_bufferPos = 0;
// }
return maxSize; // we drop any data past the end of the buffer on
// the floor until the next period starts

8
Detector.hpp
View File

@ -22,9 +22,9 @@ public:
//
// we down sample by a factor of 4
//
// the framesPerSignal argument is the number after down sampling
// the samplesPerFFT argument is the number after down sampling
//
Detector (unsigned frameRate, unsigned periodLengthInSeconds, unsigned framesPerSignal, unsigned downSampleFactor = 4u, QObject * parent = 0);
Detector (unsigned frameRate, unsigned periodLengthInSeconds, unsigned samplesPerFFT, unsigned downSampleFactor = 4u, QObject * parent = 0);
Q_SIGNAL void framesWritten (qint64) const;
@ -45,8 +45,8 @@ private:
unsigned m_frameRate;
unsigned m_period;
unsigned m_downSampleFactor;
qint32 m_framesPerSignal; // after any down sampling
bool m_starting;
qint32 m_samplesPerFFT; // after any down sampling
qint32 m_ns;
QScopedArrayPointer<short> m_buffer; // de-interleaved sample buffer
// big enough for all the
// samples for one increment of

46
Modulator.cpp
View File

@ -37,8 +37,8 @@ Modulator::Modulator (unsigned frameRate, unsigned periodLengthInSeconds, QObjec
, m_tuning {false}
, m_cwLevel {false}
{
qsrand (QDateTime::currentMSecsSinceEpoch()); // Initialize random
// seed
qsrand (QDateTime::currentMSecsSinceEpoch()); // Initialize random seed
m_itone0=0;
}
void Modulator::start (unsigned symbolsLength, double framesPerSymbol, unsigned frequency, double toneSpacing, SoundOutput * stream, Channel channel, bool synchronize, double dBSNR)
@ -58,8 +58,7 @@ void Modulator::start (unsigned symbolsLength, double framesPerSymbol, unsigned
m_quickClose = false;
m_symbolsLength = symbolsLength;
m_isym0 = std::numeric_limits<unsigned>::max (); // Arbitrary big
// number
m_isym0 = std::numeric_limits<unsigned>::max (); // big number
m_frequency0 = 0.;
m_addNoise = dBSNR < 0.;
m_nsps = framesPerSymbol;
@ -84,25 +83,20 @@ void Modulator::start (unsigned symbolsLength, double framesPerSymbol, unsigned
m_silentFrames = m_ic + m_frameRate - (mstr * m_frameRate / 1000);
}
// qDebug () << "Modulator: starting at " << m_ic / m_frameRate << " sec, sending " << m_silentFrames << " silent frames";
// qDebug () << "Modulator: starting at " << m_ic / m_frameRate
// << " sec, sending " << m_silentFrames << " silent frames";
initialize (QIODevice::ReadOnly, channel);
Q_EMIT stateChanged ((m_state = (synchronize && m_silentFrames) ?
Synchronizing : Active));
m_stream = stream;
if (m_stream)
{
m_stream->restart (this);
}
if (m_stream) m_stream->restart (this);
}
void Modulator::tune (bool newState)
{
m_tuning = newState;
if (!m_tuning)
{
stop (true);
}
if (!m_tuning) stop (true);
}
void Modulator::stop (bool quick)
@ -218,24 +212,23 @@ qint64 Modulator::readData (char * data, qint64 maxSize)
double const baud (12000.0 / m_nsps);
// fade out parameters (no fade out for tuning)
unsigned const i0 = m_tuning ? 999 * m_nsps :
(m_symbolsLength - 0.017) * 4.0 * m_nsps;
unsigned const i1 = m_tuning ? 999 * m_nsps :
m_symbolsLength * 4.0 * m_nsps;
unsigned const i0 = m_tuning ? 9999 * m_nsps : (m_symbolsLength - 0.017) * 4.0 * m_nsps;
unsigned const i1 = m_tuning ? 9999 * m_nsps : m_symbolsLength * 4.0 * m_nsps;
for (unsigned i = 0; i < numFrames && m_ic <= i1; ++i) {
isym = m_tuning ? 0 : m_ic / (4.0 * m_nsps); //Actual fsample=48000
if (isym != m_isym0 || m_frequency != m_frequency0) {
// qDebug () << "@m_ic:" << m_ic << "itone[" << isym << "] =" << itone[isym] << "@" << i << "in numFrames:" << numFrames;
if(m_toneSpacing==0.0) {
toneFrequency0=m_frequency + itone[isym]*baud;
if(itone[0]>=100) {
toneFrequency0=itone[0];
} else {
toneFrequency0=m_frequency + itone[isym]*m_toneSpacing;
if(m_toneSpacing==0.0) {
toneFrequency0=m_frequency + itone[isym]*baud;
} else {
toneFrequency0=m_frequency + itone[isym]*m_toneSpacing;
}
}
m_dphi = m_twoPi * toneFrequency0 / m_frameRate;
m_isym0 = isym;
m_frequency0 = m_frequency;
}
int j=m_ic/480;
@ -263,9 +256,14 @@ qint64 Modulator::readData (char * data, qint64 maxSize)
Q_EMIT stateChanged ((m_state = Idle));
return framesGenerated * bytesPerFrame ();
}
m_phi = 0.0;
}
/*
if(m_frequency != m_frequency0 or itone[0] != m_itone0) qDebug() << "Modulator B:" << itone[0] << m_frequency
<< m_dphi*m_frameRate/m_twoPi ;
m_itone0=itone[0];
*/
m_frequency0 = m_frequency;
// done for this chunk - continue on next call
return framesGenerated * bytesPerFrame ();

3
Modulator.hpp
View File

@ -67,6 +67,8 @@ private:
double m_fSpread;
qint64 m_silentFrames;
qint32 m_itone0;
qint16 m_ramp;
unsigned m_frameRate;
unsigned m_period;
@ -78,7 +80,6 @@ private:
bool m_cwLevel;
unsigned m_ic;
unsigned m_isym0;
qint16 m_ramp;
};
#endif

2
Versions.cmake
View File

@ -1,6 +1,6 @@
# Version number components
set (WSJTX_VERSION_MAJOR 1)
set (WSJTX_VERSION_MINOR 5)
set (WSJTX_VERSION_MINOR 6)
set (WSJTX_VERSION_PATCH 0)
set (WSJTX_RC 0) # release candidate number, comment out or zero for development versions
set (WSJTX_VERSION_IS_RELEASE 0) # set to 1 for final release build

163
astro.cpp
View File

@ -8,8 +8,6 @@
#include <QMessageBox>
#include <QSettings>
#include <QDateTime>
#include <QFont>
#include <QFontDialog>
#include <QStandardPaths>
#include <QDir>
#include <QDebug>
@ -27,22 +25,16 @@ Astro::Astro(QSettings * settings, QWidget * parent)
, ui_ {new Ui::Astro}
{
ui_->setupUi(this);
setWindowFlags (Qt::Dialog | Qt::WindowCloseButtonHint | Qt::WindowMinimizeButtonHint);
setWindowTitle(QApplication::applicationName () + " - " + tr ("Astronomical Data"));
setStyleSheet ("QWidget {background: cyan;}");
setStyleSheet ("QWidget {background: white;}");
read_settings ();
ui_->text_label->clear();
}
Astro::~Astro ()
{
if (isVisible ())
{
write_settings ();
}
if (isVisible ()) write_settings ();
}
void Astro::closeEvent (QCloseEvent * e)
@ -54,52 +46,47 @@ void Astro::closeEvent (QCloseEvent * e)
void Astro::read_settings ()
{
settings_->beginGroup ("Astro");
restoreGeometry (settings_->value ("geometry", saveGeometry ()).toByteArray ());
m_bDopplerTracking=settings_->value("DopplerTracking",false).toBool();
ui_->cbDopplerTracking->setChecked(m_bDopplerTracking);
m_DopplerMethod=settings_->value("DopplerMethod",0).toInt();
if(m_DopplerMethod==0) ui_->rbNoDoppler->setChecked(true);
if(m_DopplerMethod==1) ui_->rbFullTrack->setChecked(true);
if(m_DopplerMethod==2) ui_->rbConstFreqOnMoon->setChecked(true);
m_stepHz=settings_->value("StepHz",1).toInt();
if(m_stepHz==1) ui_->rb1Hz->setChecked(true);
if(m_stepHz==10) ui_->rb10Hz->setChecked(true);
if(m_stepHz==100) ui_->rb100Hz->setChecked(true);
m_kHz=settings_->value("kHzAdd",100).toInt();
ui_->kHzSpinBox->setValue(m_kHz);
m_bRxAudioTrack=settings_->value("RxAudioTrack",false).toBool();
ui_->cbRxTrack->setChecked(m_bRxAudioTrack);
m_bTxAudioTrack=settings_->value("TxAudioTrack",false).toBool();
ui_->cbTxTrack->setChecked(m_bTxAudioTrack);
move (settings_->value ("window/pos", pos ()).toPoint ());
QFont font;
if (font.fromString (settings_->value ("font", ui_->text_label->font ().toString ()).toString ()))
{
ui_->text_label->setStyleSheet ("QLabel {" + font_as_stylesheet (font) + '}');
adjustSize ();
}
settings_->endGroup ();
}
void Astro::write_settings ()
{
settings_->beginGroup ("Astro");
settings_->setValue ("geometry", saveGeometry ());
settings_->setValue ("DopplerTracking",m_bDopplerTracking);
settings_->setValue ("DopplerMethod",m_DopplerMethod);
settings_->setValue ("StepHz",m_stepHz);
settings_->setValue ("kHzAdd",m_kHz);
settings_->setValue ("RxAudioTrack",m_bRxAudioTrack);
settings_->setValue ("TxAudioTrack",m_bTxAudioTrack);
settings_->setValue ("window/pos", pos ());
settings_->setValue ("font", ui_->text_label->font ().toString ());
settings_->endGroup ();
}
void Astro::on_font_push_button_clicked (bool /* checked */)
void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid, qint64 freqMoon,
qint32* ndop, qint32* ndop00)
{
bool changed;
auto ss = styleSheet ();
setStyleSheet ("");
auto font = QFontDialog::getFont (&changed
, ui_->text_label->font ()
, this
, tr ("WSJT-X Astro Text Font Chooser")
#if QT_VERSION >= 0x050201
, QFontDialog::MonospacedFonts
#endif
);
if (changed)
{
ui_->text_label->setStyleSheet ("QLabel {" + font_as_stylesheet (font) + '}');
adjustSize ();
}
setStyleSheet (ss);
}
void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq)
{
static int ntxFreq0=-99;
double azsun,elsun,azmoon,elmoon,azmoondx,elmoondx;
double ramoon,decmoon,dgrd,poloffset,xnr,techo;
int ntsky,ndop,ndop00;
int ntsky;
QString date = t.date().toString("yyyy MMM dd").trimmed ();
QString utc = t.time().toString().trimmed ();
int nyear=t.date().year();
@ -110,13 +97,13 @@ void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
double sec=t.time().second() + 0.001*t.time().msec();
int isec=sec;
double uth=nhr + nmin/60.0 + sec/3600.0;
// int nfreq=(int)datcom_.fcenter;
int nfreq=10368;
if(nfreq<10 or nfreq > 50000) nfreq=144;
if(freqMoon < 1) freqMoon=144000000;
int nfreq=freqMoon/1000000;
double freq8=(double)freqMoon;
astrosub_(&nyear, &month, &nday, &uth, &nfreq, mygrid.toLatin1(),
astrosub_(&nyear, &month, &nday, &uth, &freq8, mygrid.toLatin1(),
hisgrid.toLatin1(), &azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &ndop, &ndop00,&ramoon, &decmoon,
&azmoondx, &elmoondx, &ntsky, ndop, ndop00, &ramoon, &decmoon,
&dgrd, &poloffset, &xnr, &techo, 6, 6);
QString message;
@ -130,13 +117,13 @@ void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
<< qSetRealNumberPrecision (1)
<< "Az: " << azmoon << "\n"
"El: " << elmoon << "\n"
"MyDop: " << ndop00 << "\n"
"MyDop: " << *ndop00 << "\n"
<< qSetRealNumberPrecision (2)
<< "Delay: " << techo << "\n"
<< qSetRealNumberPrecision (1)
<< "DxAz: " << azmoondx << "\n"
"DxEl: " << elmoondx << "\n"
"DxDop: " << ndop << "\n"
"DxDop: " << *ndop << "\n"
"Dec: " << decmoon << "\n"
"SunAz: " << azsun << "\n"
"SunEl: " << elsun << "\n"
@ -147,17 +134,14 @@ void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
}
ui_->text_label->setText(message);
static QFile f {QDir {QStandardPaths::writableLocation (QStandardPaths::DataLocation)}.absoluteFilePath ("azel.dat")};
if (!f.open (QIODevice::WriteOnly | QIODevice::Text))
{
static QFile f {QDir {QStandardPaths::writableLocation (
QStandardPaths::DataLocation)}.absoluteFilePath ("azel.dat")};
if (!f.open (QIODevice::WriteOnly | QIODevice::Text)) {
QMessageBox mb;
mb.setText ("Cannot open \"" + f.fileName () + "\" for writing:" + f.errorString ());
mb.exec();
return;
}
int ndiff=0;
if(ntxFreq != ntxFreq0) ndiff=1;
ntxFreq0=ntxFreq;
{
QTextStream out {&f};
out << fixed
@ -198,15 +182,66 @@ void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
<< qSetFieldWidth (4) << nfreq
<< qSetFieldWidth (0) << ','
<< qSetFieldWidth (6) << ndop
<< qSetFieldWidth (0) << ",Doppler\n"
<< qSetFieldWidth (3) << fQSO
<< qSetFieldWidth (0) << ','
<< qSetFieldWidth (1) << nsetftx
<< qSetFieldWidth (0) << ",fQSO\n"
<< qSetFieldWidth (3) << ntxFreq
<< qSetFieldWidth (0) << ','
<< qSetFieldWidth (1) << ndiff
<< qSetFieldWidth (0) << ",fQSO2";
<< qSetFieldWidth (0) << ",Doppler";
}
f.close();
}
void Astro::on_cbDopplerTracking_toggled(bool b)
{
QRect g=this->geometry();
if(b) {
g.setWidth(460);
} else {
g.setWidth(200);
}
this->setGeometry(g);
m_bDopplerTracking=b;
}
void Astro::on_rbFullTrack_clicked()
{
m_DopplerMethod=1;
}
void Astro::on_rbConstFreqOnMoon_clicked()
{
m_DopplerMethod=2;
}
void Astro::on_rbNoDoppler_clicked()
{
m_DopplerMethod=0;
}
void Astro::on_rb1Hz_clicked()
{
m_stepHz=1;
}
void Astro::on_rb10Hz_clicked()
{
m_stepHz=10;
}
void Astro::on_rb100Hz_clicked()
{
m_stepHz=100;
}
void Astro::on_cbRxTrack_toggled(bool b)
{
m_bRxAudioTrack=b;
}
void Astro::on_cbTxTrack_toggled(bool b)
{
m_bTxAudioTrack=b;
}
void Astro::on_kHzSpinBox_valueChanged(int n)
{
m_kHz=n;
}

28
astro.h
View File

@ -22,25 +22,43 @@ private:
public:
explicit Astro(QSettings * settings, QWidget * parent = nullptr);
~Astro ();
void astroUpdate(QDateTime t, QString mygrid, QString hisgrid, qint64 freqMoon,
qint32* ndop, qint32 *ndop00);
void astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq);
bool m_bDopplerTracking;
bool m_bRxAudioTrack;
bool m_bTxAudioTrack;
Q_SLOT void on_font_push_button_clicked (bool);
qint32 m_DopplerMethod;
qint32 m_kHz;
qint32 m_stepHz;
protected:
void closeEvent (QCloseEvent *) override;
private slots:
void on_cbDopplerTracking_toggled(bool b);
void on_rbConstFreqOnMoon_clicked();
void on_rbFullTrack_clicked();
void on_rbNoDoppler_clicked();
void on_rb1Hz_clicked();
void on_rb10Hz_clicked();
void on_rb100Hz_clicked();
void on_cbRxTrack_toggled(bool b);
void on_cbTxTrack_toggled(bool b);
void on_kHzSpinBox_valueChanged(int n);
private:
void read_settings ();
void write_settings ();
QSettings * settings_;
QScopedPointer<Ui::Astro> ui_;
// QScopedPointer<Ui::Astro> ui_;
Ui::Astro *ui_;
};
extern "C" {
void astrosub_(int* nyear, int* month, int* nday, double* uth, int* nfreq,
void astrosub_(int* nyear, int* month, int* nday, double* uth, double* freqMoon,
const char* mygrid, const char* hisgrid, double* azsun,
double* elsun, double* azmoon, double* elmoon, double* azmoondx,
double* elmoondx, int* ntsky, int* ndop, int* ndop00,

366
astro.ui
View File

@ -6,8 +6,8 @@
<rect>
<x>0</x>
<y>0</y>
<width>169</width>
<height>79</height>
<width>460</width>
<height>420</height>
</rect>
</property>
<property name="sizePolicy">
@ -16,87 +16,317 @@
<verstretch>0</verstretch>
</sizepolicy>
</property>
<property name="minimumSize">
<size>
<width>200</width>
<height>420</height>
</size>
</property>
<property name="styleSheet">
<string notr="true"/>
</property>
<layout class="QVBoxLayout" name="verticalLayout">
<property name="leftMargin">
<number>0</number>
<widget class="QLabel" name="text_label">
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>201</width>
<height>361</height>
</rect>
</property>
<property name="topMargin">
<number>0</number>
<property name="sizePolicy">
<sizepolicy hsizetype="MinimumExpanding" vsizetype="MinimumExpanding">
<horstretch>0</horstretch>
<verstretch>0</verstretch>
</sizepolicy>
</property>
<property name="rightMargin">
<number>0</number>
<property name="maximumSize">
<size>
<width>300</width>
<height>16777215</height>
</size>
</property>
<property name="bottomMargin">
<number>9</number>
<property name="font">
<font>
<family>Courier New</family>
<pointsize>14</pointsize>
<weight>75</weight>
<italic>false</italic>
<bold>true</bold>
</font>
</property>
<item>
<widget class="QLabel" name="text_label">
<property name="sizePolicy">
<sizepolicy hsizetype="MinimumExpanding" vsizetype="MinimumExpanding">
<horstretch>0</horstretch>
<verstretch>0</verstretch>
</sizepolicy>
</property>
<property name="styleSheet">
<string notr="true">QLabel {
font: 18pt &quot;Courier&quot;;
}</string>
</property>
<property name="frameShadow">
<enum>QFrame::Sunken</enum>
</property>
<property name="text">
<string>Astro Data</string>
</property>
<property name="alignment">
<set>Qt::AlignCenter</set>
</property>
<property name="margin">
<number>6</number>
</property>
</widget>
</item>
<item>
<layout class="QHBoxLayout" name="horizontalLayout">
<item>
<spacer name="horizontalSpacer">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
<item>
<widget class="QPushButton" name="font_push_button">
<property name="styleSheet">
<string notr="true"/>
</property>
<property name="frameShadow">
<enum>QFrame::Sunken</enum>
</property>
<property name="text">
<string>Astro Data</string>
</property>
<property name="alignment">
<set>Qt::AlignCenter</set>
</property>
<property name="margin">
<number>6</number>
</property>
</widget>
<widget class="QFrame" name="frame">
<property name="geometry">
<rect>
<x>219</x>
<y>19</y>
<width>221</width>
<height>361</height>
</rect>
</property>
<property name="frameShape">
<enum>QFrame::StyledPanel</enum>
</property>
<property name="frameShadow">
<enum>QFrame::Raised</enum>
</property>
<widget class="QGroupBox" name="groupBox">
<property name="geometry">
<rect>
<x>20</x>
<y>20</y>
<width>185</width>
<height>96</height>
</rect>
</property>
<property name="minimumSize">
<size>
<width>185</width>
<height>0</height>
</size>
</property>
<property name="title">
<string>Doppler tracking</string>
</property>
<layout class="QGridLayout" name="gridLayout">
<item row="0" column="0">
<widget class="QRadioButton" name="rbFullTrack">
<property name="text">
<string>Font</string>
<string>Full Doppler to DX Grid</string>
</property>
<property name="checked">
<bool>true</bool>
</property>
</widget>
</item>
<item>
<spacer name="horizontalSpacer_2">
<property name="orientation">
<enum>Qt::Horizontal</enum>
<item row="1" column="0">
<widget class="QRadioButton" name="rbConstFreqOnMoon">
<property name="text">
<string>Constant frequency on Moon</string>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
<property name="checked">
<bool>false</bool>
</property>
</spacer>
</widget>
</item>
<item row="2" column="0">
<widget class="QRadioButton" name="rbNoDoppler">
<property name="text">
<string>None</string>
</property>
<property name="checked">
<bool>false</bool>
</property>
</widget>
</item>
</layout>
</item>
</layout>
</widget>
<widget class="QGroupBox" name="groupBox_2">
<property name="geometry">
<rect>
<x>20</x>
<y>130</y>
<width>185</width>
<height>96</height>
</rect>
</property>
<property name="minimumSize">
<size>
<width>185</width>
<height>0</height>
</size>
</property>
<property name="title">
<string>Transceiver step size</string>
</property>
<widget class="QRadioButton" name="rb1Hz">
<property name="geometry">
<rect>
<x>10</x>
<y>23</y>
<width>61</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>1 Hz</string>
</property>
<property name="checked">
<bool>true</bool>
</property>
</widget>
<widget class="QRadioButton" name="rb10Hz">
<property name="geometry">
<rect>
<x>10</x>
<y>46</y>
<width>71</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>10 Hz</string>
</property>
</widget>
<widget class="QRadioButton" name="rb100Hz">
<property name="geometry">
<rect>
<x>10</x>
<y>69</y>
<width>71</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>100 Hz</string>
</property>
</widget>
</widget>
<widget class="QGroupBox" name="groupBox_3">
<property name="enabled">
<bool>false</bool>
</property>
<property name="geometry">
<rect>
<x>20</x>
<y>230</y>
<width>185</width>
<height>73</height>
</rect>
</property>
<property name="minimumSize">
<size>
<width>185</width>
<height>0</height>
</size>
</property>
<property name="title">
<string>Audio frequency tracking</string>
</property>
<widget class="QCheckBox" name="cbRxTrack">
<property name="geometry">
<rect>
<x>10</x>
<y>23</y>
<width>36</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>Rx</string>
</property>
</widget>
<widget class="QCheckBox" name="cbTxTrack">
<property name="geometry">
<rect>
<x>10</x>
<y>46</y>
<width>35</width>
<height>17</height>
</rect>
</property>
<property name="text">
<string>Tx</string>
</property>
</widget>
</widget>
<widget class="QGroupBox" name="groupBox_4">
<property name="geometry">
<rect>
<x>20</x>
<y>310</y>
<width>185</width>
<height>51</height>
</rect>
</property>
<property name="minimumSize">
<size>
<width>185</width>
<height>0</height>
</size>
</property>
<property name="title">
<string>kHz above nominal band edge</string>
</property>
<widget class="QSpinBox" name="kHzSpinBox">
<property name="geometry">
<rect>
<x>50</x>
<y>20</y>
<width>51</width>
<height>22</height>
</rect>
</property>
<property name="maximum">
<number>999</number>
</property>
<property name="value">
<number>100</number>
</property>
</widget>
</widget>
</widget>
<widget class="QWidget" name="layoutWidget">
<property name="geometry">
<rect>
<x>1</x>
<y>386</y>
<width>195</width>
<height>22</height>
</rect>
</property>
<layout class="QHBoxLayout" name="horizontalLayout">
<item>
<spacer name="horizontalSpacer">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
<item>
<widget class="QCheckBox" name="cbDopplerTracking">
<property name="text">
<string>Doppler tracking</string>
</property>
</widget>
</item>
<item>
<spacer name="horizontalSpacer_2">
<property name="orientation">
<enum>Qt::Horizontal</enum>
</property>
<property name="sizeHint" stdset="0">
<size>
<width>40</width>
<height>20</height>
</size>
</property>
</spacer>
</item>
</layout>
</widget>
</widget>
<resources/>
<connections/>

14
commons.h
View File

@ -2,7 +2,7 @@
#define COMMONS_H
#define NSMAX 6827
#define NTMAX 120
#define NTMAX 60
#define RX_SAMPLE_RATE 12000
extern struct FortranCommon {
@ -21,12 +21,22 @@ extern struct FortranCommon {
int ntol; //+/- decoding range around fQSO (Hz)
int kin;
int nzhsym;
int nsave;
int nsubmode;
int nagain;
int ndepth;
int ntxmode;
int nmode;
int minw;
int nclearave;
float emedelay;
float dttol;
int nlist;
int listutc[10];
char datetime[20];
char mycall[12];
char mygrid[6];
char hiscall[12];
char hisgrid[6];
} jt9com_;
extern "C" {

6
decodedtext.cpp
View File

@ -54,6 +54,11 @@ int DecodedText::snr()
return _string.mid(column_snr,3).toInt();
}
float DecodedText::dt()
{
return _string.mid(column_dt,5).toFloat();
}
/*
2343 -11 0.8 1259 # YV6BFE F6GUU R-08
2343 -19 0.3 718 # VE6WQ SQ2NIJ -14
@ -67,6 +72,7 @@ int DecodedText::snr()
bool DecodedText::report(QString const& myBaseCall, QString const& dxBaseCall, /*mod*/QString& report)
{
QString msg=_string.mid(column_qsoText);
if(msg.trimmed().length() < 1) return false;
int i1=msg.indexOf("\r");
if (i1>0)
msg=msg.mid(0,i1-1) + " ";

2
decodedtext.h
View File

@ -31,6 +31,7 @@ public:
// We rely on these columns being the same in the fortran code (lib/decode.f90) that formats the decoded text
enum Columns { column_time = 0,
column_snr = 5,
column_dt = 9,
column_freq = 14,
column_mode = 19,
column_qsoText = 21 };
@ -65,6 +66,7 @@ public:
bool isTX();
int frequencyOffset(); // hertz offset from the tuned dial or rx frequency, aka audio frequency
int snr();
float dt();
// find and extract any report. Returns true if this is a standard message
bool report(QString const& myBaseCall, QString const& dxBaseCall, /*mod*/QString& report);

31
getfile.cpp
View File

@ -18,6 +18,21 @@
void getfile(QString fname, int ntrperiod)
{
struct WAVHDR {
char ariff[4];
int lenfile;
char awave[4];
char afmt[4];
int lenfmt;
short nfmt2;
short nchan2;
int nsamrate;
int nbytesec;
short nbytesam2;
short nbitsam2;
char adata[4];
int ndata;
} hdr;
char name[512];
strncpy(name,fname.toLatin1(), sizeof (name) - 1);
@ -25,17 +40,25 @@ void getfile(QString fname, int ntrperiod)
FILE* fp=fopen(name,"rb");
int i0=fname.indexOf(".wav");
int i1=fname.lastIndexOf("/");
QString baseName=fname.mid(i1+1);
// qDebug() << baseName << baseName.length();
int i0=fname.indexOf(".wav",0,Qt::CaseInsensitive);
jt9com_.nutc=0;
if(i0>0) jt9com_.nutc=100*fname.mid(i0-4,2).toInt() +
fname.mid(i0-2,2).toInt();
if(i0>0) {
int n=4;
if(baseName.length()!=15) n=6;
jt9com_.nutc=100*fname.mid(i0-n,2).toInt() + fname.mid(i0-n+2,2).toInt();
}
int npts=ntrperiod*12000;
memset(jt9com_.d2,0,2*npts);
if(fp != NULL) {
// Read (and ignore) a 44-byte WAV header; then read data
int n=fread(jt9com_.d2,1,44,fp);
int n=fread(&hdr,1,44,fp);
n=fread(jt9com_.d2,2,npts,fp);
if(hdr.nsamrate==11025) wav12_(jt9com_.d2,jt9com_.d2,&n,&hdr.nbitsam2);
fclose(fp);
jt9com_.newdat=1;
if(n==-99999) jt9com_.newdat=2; //Silence compiler warning

1
getfile.h
View File

@ -13,6 +13,7 @@ int ptt(int nport, int ntx, int* iptt, int* nopen);
extern "C" {
int ptt_(int nport, int ntx, int* iptt, int* nopen);
void wav12_(short d2[], short d1[], int* nbytes, short* nbitsam2);
}

5
lib/afc9.f90
View File

@ -1,7 +1,8 @@
subroutine afc9(c3a,npts,fsample,a,syncpk)
complex c3a(0:npts-1)
complex c3(0:1360-1)
parameter (NZ2=1512)
complex c3a(0:NZ2-1)
complex c3(0:NZ2-1)
real a(3),deltaa(3)
a(1)=0. !f0

17
lib/astro.f90
View File

@ -1,4 +1,4 @@
subroutine astro(nyear,month,nday,uth,nfreq,Mygrid, &
subroutine astro(nyear,month,nday,uth,freq8,Mygrid, &
NStation,MoonDX,AzSun,ElSun,AzMoon0,ElMoon0, &
ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd, &
poloffset,xnr,day,lon,lat,LST,techo)
@ -7,6 +7,7 @@ subroutine astro(nyear,month,nday,uth,nfreq,Mygrid, &
! NB: may want to smooth the Tsky map to 10 degrees or so.
character*6 MyGrid,HisGrid
real*8 freq8
real LST
real lat,lon
integer*2 nt144(180)
@ -41,9 +42,9 @@ subroutine astro(nyear,month,nday,uth,nfreq,Mygrid, &
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST, &
AzSun,ElSun,mjd,day)
freq=nfreq*1.e6
if(nfreq.eq.2) freq=1.8e6
if(nfreq.eq.4) freq=3.5e6
! freq=nfreq*1.e6
! if(nfreq.eq.2) freq=1.8e6
! if(nfreq.eq.4) freq=3.5e6
call MoonDop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon, &
LST,HA,AzMoon,ElMoon,vr,dist)
@ -55,14 +56,14 @@ subroutine astro(nyear,month,nday,uth,nfreq,Mygrid, &
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
techo=2.0 * dist/2.99792458e5 !Echo delay time
doppler=-freq*vr/2.99792458e5 !One-way Doppler
techo=2.0 * dist/2.99792458e5 !Echo delay time
doppler=-freq8*vr/2.99792458e5 !One-way Doppler
call coord(0.,0.,-1.570796,1.161639,RAMoon/rad,DecMoon/rad,el,eb)
longecl_half=nint(rad*el/2.0)
if(longecl_half.lt.1 .or. longecl_half.gt.180) longecl_half=180
t144=nt144(longecl_half)
tsky=(t144-2.7)*(144.0/nfreq)**2.6 + 2.7 !Tsky for obs freq
tsky=(t144-2.7)*(144.0/freq8)**2.6 + 2.7 !Tsky for obs freq
xdop(NStation)=doppler
if(NStation.eq.2) then
@ -88,7 +89,7 @@ subroutine astro(nyear,month,nday,uth,nfreq,Mygrid, &
endif
tr=80.0 !Good preamp
tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature
tskymin=13.0*(408.0/freq8)**2.6 !Cold sky temperature
tsysmin=tskymin+tr
tsys=tsky+tr
dgrd=-10.0*log10(tsys/tsysmin) + dbMoon

8
lib/astro0.f90
View File

@ -1,4 +1,4 @@
subroutine astro0(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
subroutine astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
width1,width2,w501,w502,xlst8,techo8)
@ -8,18 +8,18 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0,dt
real*8 sd8,poloffset8,day8,width1,width2,w501,w502,xlst8
real*8 uth8,techo8
real*8 uth8,techo8,freq8
data uth8z/0.d0/
save
uth=uth8
call astro(nyear,month,nday,uth,nfreq,hisgrid,2,1, &
call astro(nyear,month,nday,uth,freq8,hisgrid,2,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon2,xlat2,xlst,techo)
AzMoonB8=AzMoon
ElMoonB8=ElMoon
call astro(nyear,month,nday,uth,nfreq,mygrid,1,1, &
call astro(nyear,month,nday,uth,freq8,mygrid,1,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon1,xlat1,xlst,techo)

4
lib/astrosub.f90
View File

@ -1,11 +1,11 @@
subroutine astrosub(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
subroutine astrosub(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8,techo8)
implicit real*8 (a-h,o-z)
character*6 mygrid,hisgrid
call astro0(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
call astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
width1,width2,w501,w502,xlst8,techo8)

141
lib/avg4.f90 Normal file
View File

@ -0,0 +1,141 @@
subroutine avg4(nutc,snrsync,dtxx,flip,nfreq,mode4,ntol,ndepth,neme, &
mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ichbest,ndeepave)
! Decodes averaged JT4 data
use jt4
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(nhz-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 (odd/even) 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
! rewind 80
do i=1,nsave
csync='*'
if(flipsave(i).lt.0.0) csync='#'
write(14,1000) cused(i),iutc(i),syncsave(i),dtsave(i),nfsave(i),csync
1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
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='#'
! write(80,3001) i,iutc(i),syncsave(i),dtsave(i),nfsave(i),csync
!3001 format(i3,i6.4,f6.1,f6.2,i6,1x,a1)
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
! write(80,3002)
!3002 format(16x,'----- -----')
! write(80,3003) dtave,nint(fave)
! write(80,3003) rmst,nint(rmsf)
!3003 format(15x,f6.2,i6)
! flush(80)
! nadd=nused*mode4
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(ndepth.ge.3) 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)
! write(82,3101) nutc,sym(51:53,k),flipx,k,qave,deepave
!3101 format(i4.4,4f8.1,i3,f7.2,2x,a22)
if(qave.gt.qbest) then
qbest=qave
deepbest=deepave
kbest=k
ndeepave=nsum
! print*,'b',qbest,k,deepbest
endif
if(nch(k).ge.mode4) exit
enddo
deepave=deepbest
qave=qbest
ichbest=kbest
endif
900 return
end subroutine avg4

57
lib/code426.f90 Normal file
View File

@ -0,0 +1,57 @@
program code426
parameter (MZ=26) !Number of 4-FSK symbols
parameter (JZMAX=64) !Desired number of codewords
integer ic(MZ,JZMAX),icsave(MZ)
real c(MZ)
character*12 arg
nargs=iargc()
if(nargs.ne.2) then
print*,'Usage: code426 <nmsgs> <iters>'
print*,'Example: code426 64 10000000'
go to 999
endif
call getarg(1,arg)
read(arg,*) nmsgs
call getarg(2,arg)
read(arg,*) iters
open(13,file='code426.out',status='unknown')
write(*,1002) nmsgs,iters
write(13,1002) nmsgs,iters
1002 format('Nmsgs:',i4,' Iters:',i10/(66('-')))
do i=1,MZ !Create 4 mutually orthogonal codewords
ic(i,1)=mod(i-1,4)
ic(i,2)=mod(i,4)
ic(i,3)=mod(i+1,4)
ic(i,4)=mod(i+2,4)
enddo
do j=1,4 !Write them out
write(*,1000) j,MZ,ic(1:MZ,j)
write(13,1000) j,MZ,ic(1:MZ,j)
1000 format(2i5,3x,26i2)
enddo
do j=5,nmsgs !Find codewords up to j=nmsgs with maximum
npk=0 !distance from all the rest
do i=1,iters
call random_number(c)
ic(1:MZ,j)=int(4*c)
nd=MZ
do k=1,j-1 !Test candidate against all others in list
nd=min(nd,count(ic(1:MZ,j).ne.ic(1:MZ,k)))
enddo
if(nd.gt.npk) then
npk=nd
icsave=ic(1:MZ,j) !Best candidate so far, save it
endif
enddo
write(*,1000) j,npk,ic(1:MZ,j)
write(13,1000) j,npk,ic(1:MZ,j)
enddo
999 end program code426

4
lib/constants.f90
View File

@ -1,5 +1,5 @@
parameter (NTMAX=120)
parameter (NMAX=NTMAX*12000) !Total sample intervals per 30 minutes
parameter (NTMAX=60)
parameter (NMAX=NTMAX*12000) !Total sample intervals (one minute)
parameter (NDMAX=NTMAX*1500) !Sample intervals at 1500 Hz rate
parameter (NSMAX=6827) !Max length of saved spectra
parameter (MAXFFT3=16384)

5
lib/decjt9.f90
View File

@ -87,9 +87,6 @@ subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
if(nqd.eq.1 .or. &
(ccfred(i).ge.ccflim .and. abs(f-fgood).gt.10.0*df8)) then
if(nqd.eq.0) nfreqs0=nfreqs0+1
if(nqd.eq.1) nfreqs1=nfreqs1+1
call timer('softsym ',0)
fpk=nf0 + df3*(i-1)
call softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, &
@ -113,8 +110,6 @@ subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
if(msg.ne.' ') then
numfano=numfano+1
if(nqd.eq.0) ndecodes0=ndecodes0+1
if(nqd.eq.1) ndecodes1=ndecodes1+1
!$omp critical(decode_results) ! serialize writes - see also jt65a.f90
write(*,1000) nutc,nsnr,xdt,nint(freq),msg

110
lib/decode4.f90 Normal file
View File

@ -0,0 +1,110 @@
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.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=nch(ich)
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
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

2
lib/decode65a.f90
View File

@ -37,8 +37,6 @@ subroutine decode65a(dd,npts,newdat,nqd,f0,nflip,mode65,sync2,a,dt, &
a(5)=dt00
i0=nint((a(5)+0.5)*fsample) - 2 + nadd
if(i0.lt.1) then
! write(23,*) 'i0 too small in decode1a:',i0,f0,a(5),fsample,nadd
! flush(23)
i0=1
endif
nz=n6+1-i0

60
lib/decoder.f90
View File

@ -1,16 +1,18 @@
subroutine decoder(ss,id2)
subroutine decoder(ss,id2,nfsample)
use prog_args
!$ use omp_lib
include 'constants.f90'
real ss(184,NSMAX)
character*20 datetime
logical baddata
integer*2 id2(NTMAX*12000)
real*4 dd(NTMAX*12000)
character datetime*20,mycall*12,mygrid*6,hiscall*12,hisgrid*6
common/npar/nutc,ndiskdat,ntrperiod,nfqso,newdat,npts8,nfa,nfsplit,nfb, &
ntol,kin,nzhsym,nsave,nagain,ndepth,ntxmode,nmode,datetime
ntol,kin,nzhsym,nsubmode,nagain,ndepth,ntxmode,nmode,minw,nclearave, &
emedelay,dttol,nlist,listutc(10),datetime,mycall,mygrid,hiscall,hisgrid
common/tracer/limtrace,lu
integer onlevel(0:10)
common/tracer_priv/level,onlevel
@ -21,20 +23,30 @@ subroutine decoder(ss,id2)
float(id2(300000:310000)))/10000.0)
if(rms.lt.2.0) go to 800
nfreqs0=0
nfreqs1=0
ndecodes0=0
ndecodes1=0
if (nagain .eq. 0) then
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown')
else
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown', &
position='append')
end if
open(22,file=trim(temp_dir)//'/kvasd.dat',access='direct',recl=1024, &
if(nmode.eq.4 .or. nmode.eq.65) open(14,file=trim(temp_dir)//'/avemsg.txt', &
status='unknown')
if(nmode.eq.65 .or. nmode.eq.(65+9)) open(22,file=trim(temp_dir)// &
'/kvasd.dat',access='direct',recl=1024,status='unknown')
if(nmode.eq.4) then
jz=52*nfsample
if(newdat.ne.0) then
if(nfsample.eq.12000) call wav11(id2,jz,dd)
if(nfsample.eq.11025) dd(1:jz)=id2(1:jz)
endif
call jt4a(dd,jz,nutc,nfqso,newdat,nfa,nfb,ntol,emedelay,dttol, &
nagain,ndepth,nclearave,minw,nsubmode,mycall,mygrid,hiscall, &
hisgrid,nlist,listutc)
go to 800
endif
npts65=52*12000
if(baddata(id2,npts65)) then
nsynced=0
@ -46,34 +58,37 @@ subroutine decoder(ss,id2)
newdat65=newdat
newdat9=newdat
!$ call omp_set_dynamic(.true.)
!$omp parallel sections num_threads(2) copyin(/tracer_priv/) shared(ndecoded) if(.true.) !iif() needed on Mac
!$ call omp_set_dynamic(.true.)
!$omp parallel sections num_threads(2) copyin(/tracer_priv/) shared(ndecoded) if(.true.) !iif() needed on Mac
!$omp section
if(nmode.eq.65 .or. (nmode.gt.65 .and. ntxmode.eq.65)) then
! We're decoding JT65 or should do this mode first
!$omp section
if(nmode.eq.65 .or. (nmode.eq.(65+9) .and. ntxmode.eq.65)) then
! We're in JT65 mode, or should do JT65 first
if(newdat65.ne.0) dd(1:npts65)=id2(1:npts65)
nf1=nfa
nf2=nfb
call timer('jt65a ',0)
call jt65a(dd,npts65,newdat65,nutc,nf1,nf2,nfqso,ntol65,nagain,ndecoded)
call jt65a(dd,npts65,newdat65,nutc,nf1,nf2,nfqso,ntol65,nsubmode, &
nagain,ndecoded)
call timer('jt65a ',1)
else
! We're decoding JT9 or should do this mode first
else if(nmode.eq.9 .or. (nmode.eq.(65+9) .and. ntxmode.eq.9)) then
! We're in JT9 mode, or should do JT9 first
call timer('decjt9 ',0)
call decjt9(ss,id2,nutc,nfqso,newdat9,npts8,nfa,nfsplit,nfb,ntol,nzhsym, &
nagain,ndepth,nmode)
call timer('decjt9 ',1)
endif
!$omp section
if(nmode.gt.65) then ! do the other mode in dual mode
!$omp section
if(nmode.eq.(65+9)) then !Do the other mode (we're in dual mode)
if (ntxmode.eq.9) then
if(newdat65.ne.0) dd(1:npts65)=id2(1:npts65)
nf1=nfa
nf2=nfb
call timer('jt65a ',0)
call jt65a(dd,npts65,newdat65,nutc,nf1,nf2,nfqso,ntol65,nagain,ndecoded)
call jt65a(dd,npts65,newdat65,nutc,nf1,nf2,nfqso,ntol65,nsubmode, &
nagain,ndecoded)
call timer('jt65a ',1)
else
call timer('decjt9 ',0)
@ -83,13 +98,14 @@ subroutine decoder(ss,id2)
end if
endif
!$omp end parallel sections
!$omp end parallel sections
! JT65 is not yet producing info for nsynced, ndecoded.
800 write(*,1010) nsynced,ndecoded
1010 format('<DecodeFinished>',2i4)
call flush(6)
close(13)
close(13)
if(nmode.eq.4 .or. nmode.eq.65) close(14)
close(22)
return

366
lib/deep24.f90 → lib/deep4.f90
View File

@ -1,182 +1,184 @@
subroutine deep24(sym,neme,flip,mycall,hiscall,hisgrid,decoded,qual)
! Have barely begun converting this from JT65 to JT4
parameter (MAXCALLS=7000,MAXRPT=63)
real*4 sym(206)
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
character*12 mycall,hiscall
character mycall0*12,hiscall0*12,hisgrid0*6
character*22 decoded
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*180 line
character*4 rpt(MAXRPT)
integer ncode(206)
real*4 code(206,2*MAXCALLS + 2 + MAXRPT)
real pp(2*MAXCALLS + 2 + MAXRPT)
! common/c3com/ mcall3a
data neme0/-99/
data rpt/'-01','-02','-03','-04','-05', &
'-06','-07','-08','-09','-10', &
'-11','-12','-13','-14','-15', &
'-16','-17','-18','-19','-20', &
'-21','-22','-23','-24','-25', &
'-26','-27','-28','-29','-30', &
'R-01','R-02','R-03','R-04','R-05', &
'R-06','R-07','R-08','R-09','R-10', &
'R-11','R-12','R-13','R-14','R-15', &
'R-16','R-17','R-18','R-19','R-20', &
'R-21','R-22','R-23','R-24','R-25', &
'R-26','R-27','R-28','R-29','R-30', &
'RO','RRR','73'/
save
if(mycall.eq.mycall0 .and. hiscall.eq.hiscall0 .and. &
hisgrid.eq.hisgrid0 .and. mcall3a.eq.0 .and. neme.eq.neme0) go to 30
mcall3a=0
rewind 23
k=0
icall=0
do n=1,MAXCALLS
if(n.eq.1) then
callsign=hiscall
do i=4,12
if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' '
enddo
grid=hisgrid(1:4)
if(ichar(grid(3:3)).eq.0) grid(3:3)=' '
if(ichar(grid(4:4)).eq.0) grid(4:4)=' '
else
read(23,1002,end=20) line
1002 format (A80)
if(line(1:4).eq.'ZZZZ') go to 20
if(line(1:2).eq.'//') go to 10
i1=index(line,',')
if(i1.lt.4) go to 10
i2=index(line(i1+1:),',')
if(i2.lt.5) go to 10
i2=i2+i1
i3=index(line(i2+1:),',')
if(i3.lt.1) i3=index(line(i2+1:),' ')
i3=i2+i3
callsign=line(1:i1-1)
grid=line(i1+1:i2-1)
ceme=line(i2+1:i3-1)
if(neme.eq.1 .and. ceme.ne.'EME') go to 10
endif
icall=icall+1
j1=index(mycall,' ') - 1
if(j1.le.-1) j1=12
if(j1.lt.3) j1=6
j2=index(callsign,' ') - 1
if(j2.le.-1) j2=12
if(j2.lt.3) j2=6
j3=index(mycall,'/') ! j3>0 means compound mycall
j4=index(callsign,'/') ! j4>0 means compound hiscall
callgrid(icall)=callsign(1:j2)
mz=1
! Allow MyCall + HisCall + rpt (?)
if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and. &
flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1
do m=1,mz
if(m.gt.1) grid=rpt(m-1)
if(j3.lt.1 .and.j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid
message=mycall(1:j1)//' '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode4(message,ncode)
code(1:206,k)=2*ncode(1:206)-1
if(n.ge.2) then
! Insert CQ message
if(j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode4(message,ncode)
code(1:206,k)=2*ncode(1:206)-1
endif
enddo
10 continue
enddo
20 continue
ntot=k
neme0=neme
30 mycall0=mycall
hiscall0=hiscall
hisgrid0=hisgrid
sq=0.
do j=1,206
sq=sq + sym(j)**2
enddo
rms=sqrt(sq/206.0)
sym=sym/rms
p1=-1.e30
p2=-1.e30
do k=1,ntot
pp(k)=0.
! Test all messages if flip=+1; skip the CQ messages if flip=-1.
if(flip.gt.0.0 .or. testmsg(k)(1:3).ne.'CQ ') then
p=0.
do j=1,206
i=code(j,k)+1
p=p + code(j,k)*sym(j)
enddo
pp(k)=p
if(p.gt.p1) then
p1=p
ip1=k
endif
endif
enddo
do i=1,ntot
if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i)
enddo
! ### DO NOT REMOVE ###
! rewind 77
! write(77,*) p1,p2
! ### Works OK without it (in both Windows and Linux) if compiled
! ### without optimization. However, in Windows this is a colossal
! ### pain because of the way F2PY wants to run the compile step.
bias=1.1*p2
! if(mode65.eq.1) bias=max(1.12*p2,0.335)
! if(mode65.eq.2) bias=max(1.08*p2,0.405)
! if(mode65.ge.4) bias=max(1.04*p2,0.505)
if(p2.eq.p1 .and. p1.ne.-1.e30) stop 'Error in deep24'
qual=10.0*(p1-bias)
decoded=' '
c=' '
if(qual.gt.1.0) then
if(qual.lt.6.0) c='?'
decoded=testmsg(ip1)
else
qual=0.
endif
decoded(22:22)=c
! Make sure everything is upper case.
do i=1,22
if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z') &
decoded(i:i)=char(ichar(decoded(i:i))-32)
enddo
! write(*,3010) p1,p2,p1-p2,p1/p2,qual,decoded
!3010 format('DS:',5f9.1,2x,a22)
return
end subroutine deep24
subroutine deep4(sym0,neme,flip,mycall,hiscall,hisgrid,decoded,qual)
! Deep search routine for JT4
use prog_args
parameter (MAXCALLS=7000,MAXRPT=63)
real*4 sym0(206),sym(206)
character callsign*12,grid*4,message*22,hisgrid*6,ceme*3
character*12 mycall,hiscall
character mycall0*12,hiscall0*12,hisgrid0*6
character*22 decoded
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*180 line
character*4 rpt(MAXRPT)
integer ncode(206)
real*4 code(206,2*MAXCALLS + 2 + MAXRPT)
real pp(2*MAXCALLS + 2 + MAXRPT)
data neme0/-99/
data rpt/'-01','-02','-03','-04','-05', &
'-06','-07','-08','-09','-10', &
'-11','-12','-13','-14','-15', &
'-16','-17','-18','-19','-20', &
'-21','-22','-23','-24','-25', &
'-26','-27','-28','-29','-30', &
'R-01','R-02','R-03','R-04','R-05', &
'R-06','R-07','R-08','R-09','R-10', &
'R-11','R-12','R-13','R-14','R-15', &
'R-16','R-17','R-18','R-19','R-20', &
'R-21','R-22','R-23','R-24','R-25', &
'R-26','R-27','R-28','R-29','R-30', &
'RO','RRR','73'/
save mycall0,hiscall0,hisgrid0,neme0,ntot,code,testmsg
sym=sym0
if(mycall.eq.mycall0 .and. hiscall.eq.hiscall0 .and. &
hisgrid.eq.hisgrid0 .and. neme.eq.neme0) go to 30
open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown')
k=0
icall=0
do n=1,MAXCALLS
if(n.eq.1) then
callsign=hiscall
do i=4,12
if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' '
enddo
grid=hisgrid(1:4)
if(ichar(grid(3:3)).eq.0) grid(3:3)=' '
if(ichar(grid(4:4)).eq.0) grid(4:4)=' '
else
read(23,1002,end=20) line
1002 format (A80)
if(line(1:4).eq.'ZZZZ') go to 20
if(line(1:2).eq.'//') go to 10
i1=index(line,',')
if(i1.lt.4) go to 10
i2=index(line(i1+1:),',')
if(i2.lt.5) go to 10
i2=i2+i1
i3=index(line(i2+1:),',')
if(i3.lt.1) i3=index(line(i2+1:),' ')
i3=i2+i3
callsign=line(1:i1-1)
grid=line(i1+1:i2-1)
ceme=line(i2+1:i3-1)
if(neme.eq.1 .and. ceme.ne.'EME') go to 10
endif
icall=icall+1
j1=index(mycall,' ') - 1
if(j1.le.-1) j1=12
if(j1.lt.3) j1=6
j2=index(callsign,' ') - 1
if(j2.le.-1) j2=12
if(j2.lt.3) j2=6
j3=index(mycall,'/') ! j3>0 means compound mycall
j4=index(callsign,'/') ! j4>0 means compound hiscall
callgrid(icall)=callsign(1:j2)
mz=1
! Allow MyCall + HisCall + rpt (?)
if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and. callsign(1:6).ne.' ') &
mz=MAXRPT+1
do m=1,mz
if(m.gt.1) grid=rpt(m-1)
if(j3.lt.1 .and.j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid
message=mycall(1:j1)//' '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode4(message,ncode)
code(1:206,k)=2*ncode(1:206)-1
if(n.ge.2) then
! Insert CQ message
if(j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode4(message,ncode)
code(1:206,k)=2*ncode(1:206)-1
endif
enddo
10 continue
enddo
20 continue
close(23)
ntot=k
30 mycall0=mycall
hiscall0=hiscall
hisgrid0=hisgrid
neme0=neme
sq=0.
do j=1,206
sq=sq + sym(j)**2
enddo
rms=sqrt(sq/206.0)
sym=sym/rms
p1=-1.e30
p2=-1.e30
do k=1,ntot
pp(k)=0.
! Should re-instate the following:
! if(k.ge.2 .and. k.le.64 .and. flip.gt.0.0) cycle
! Test all messages if flip=+1; skip the CQ messages if flip=-1.
if(flip.gt.0.0 .or. testmsg(k)(1:3).ne.'CQ ') then
p=0.
do j=1,206
p=p + code(j,k)*sym(j)
enddo
pp(k)=p
if(p.gt.p1) then
p1=p
ip1=k
endif
! write(78,3001) k,pp(k),testmsg(k)
!3001 format(i6,f10.3,2x,a22)
endif
enddo
! flush(78)
do i=1,ntot
if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i)
enddo
! qual=p1-max(1.15*p2,80.0)
qual=p1-max(1.15*p2,70.0)
! ### DO NOT REMOVE ###
rewind 77
if(ip1.ge.1 .and. ip1.le.2*MAXCALLS+2+MAXRPT) write(77,1001) p1,p2,ntot, &
rms,qual,ip1,testmsg(ip1)
1001 format(2f8.2,i8,2f8.2,i6,2x,a22)
call flush(77)
! ### Works OK without it (in both Windows and Linux) if compiled
! ### without optimization. However, in Windows this is a colossal
! ### pain because of the way F2PY wants to run the compile step.
! write(71,3001) p1,p2,qual,testmsg(ip1)
!3001 format(3f10.3,2x,a22)
! call flush(71)
if(qual.gt.1.0) then
decoded=testmsg(ip1)
else
decoded=' '
qual=0.
endif
! Make sure everything is upper case.
do i=1,22
if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z') &
decoded(i:i)=char(ichar(decoded(i:i))-32)
enddo
! write(79,1001) p1,p2,ntot,rms,qual,ip1,testmsg(ip1)
! call flush(79)
return
end subroutine deep4

29
lib/downsam9.f90
View File

@ -1,4 +1,4 @@
subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
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.
@ -8,21 +8,22 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
include 'constants.f90'
integer(C_SIZE_T) NMAX1
parameter (NMAX1=604800)
parameter (NMAX1=653184)
parameter (NFFT1=653184,NFFT2=1512)
type(C_PTR) :: plan !Pointers plan for big FFT
integer*2 id2(0:8*npts8-1)
real*4, pointer :: x1(:)
complex c1(0:NMAX1/2)
complex c2(0:1440-1)
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
nfft1=NMAX1 !Forward FFT length
df1=12000.0/nfft1
df1=12000.0/NFFT1
npts=8*npts8
if(npts.gt.NFFT1) npts=NFFT1 !### Fix! ###
if(first) then
nflags=FFTW_ESTIMATE
@ -37,7 +38,7 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
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)
plan=fftwf_plan_dft_r2c_1d(NFFT1,x1,c1,nflags)
call fftwf_plan_with_nthreads(1)
!$omp end critical(fftw)
@ -46,7 +47,7 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
if(newdat.eq.1) then
x1(0:npts-1)=id2(0:npts-1)
x1(npts:nfft1-1)=0. !Zero the rest of x1
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)
@ -63,9 +64,8 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
newdat=0
endif
ndown=8*nsps8/nspsd !Downsample factor
nfft2=nfft1/ndown !Backward FFT length
nh2=nfft2/2
ndown=8*nsps8/nspsd !Downsample factor = 432
nh2=NFFT2/2
nf=nint(fpk)
i0=int(fpk/df1)
@ -75,13 +75,12 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
call pctile(s(ia),ib-ia+1,40,avenoise)
fac=sqrt(1.0/avenoise)
do i=0,nfft2-1
do i=0,NFFT2-1
j=i0+i
if(i.gt.nh2) j=j-nfft2
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
nz2=8*npts8/ndown
call four2a(c2,NFFT2,1,1,1) !FFT back to time domain
return
end subroutine downsam9

20
lib/encode4.f90 Normal file
View File

@ -0,0 +1,20 @@
subroutine encode4(message,ncode)
use packjt
parameter (MAXCALLS=7000,MAXRPT=63)
integer ncode(206)
character*22 message !Message to be generated
character*3 cok !' ' or 'OOO'
integer dgen(13)
integer*1 data0(13),symbol(216)
call chkmsg(message,cok,nspecial,flip)
call packmsg(message,dgen,itype) !Pack 72-bit message into 12 six-bit symbols
call entail(dgen,data0)
call encode232(data0,206,symbol) !Convolutional encoding
call interleave4(symbol,1) !Apply JT4 interleaving
do i=1,206
ncode(i)=symbol(i)
enddo
end subroutine encode4

7
lib/extract.F90
View File

@ -6,13 +6,14 @@ subroutine extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv)
! nqd 0/1 to indicate decode attempt at QSO frequency
! Output:
! ncount number of symbols requiring correction
! 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
! nbmkv 0=no decode; 1=BM decode; 2=KV decode
use prog_args !shm_key, exe_dir, data_dir
use packjt
real s3(64,63)
character decoded*22
@ -55,8 +56,8 @@ subroutine extract(s3,nadd,nqd,ncount,nhist,decoded,ltext,nbmkv)
go to 1
endif
call graycode65(mrsym,63,-1) !Remove gray code and interleaving
call interleave63(mrsym,-1) !from most reliable symbols
call graycode65(mrsym,63,-1) !Remove gray code
call interleave63(mrsym,-1) !Remove interleaving
call interleave63(mrprob,-1)
num65=num65+1

130
lib/extract4.f90
View File

@ -1,61 +1,69 @@
subroutine extract4(sym,nadd,ncount,decoded)
real sym(207)
character decoded*22, submode*1
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(0:255,0:1) !Metric table
logical first
data first/.true./
save first,mettab
if(first) then
call getmet24(mode,mettab)
first=.false.
endif
do j=1,207
r=sym(j) + 128.
if(r.gt.255.0) r=255.0
if(r.lt.0.0) r=0.0
i4=nint(r)
if(i4.gt.127) i4=i4-256
symbol(j)=i4
enddo
nbits=72+31
ndelta=50
limit=100000
ncycles=0
ncount=-1
decoded=' '
submode=' '
call interleave24(symbol(2),-1) !Remove the interleaving
call fano232(symbol(2),nbits,mettab,ndelta,limit,data1,ncycles,metric,ncount)
nlim=ncycles/nbits
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)
submode=char(ichar('A')+ich-1)
if(decoded(1:6).eq.'000AAA') then
decoded='***WRONG MODE?***'
ncount=-1
endif
endif
return
end subroutine extract4
subroutine extract4(sym0,ncount,decoded)
use packjt
real sym0(207)
real sym(207)
character decoded*22
character*72 c72
integer*1 symbol(207)
integer*1 data1(13) !Decoded data (8-bit bytes)
integer data4a(9) !Decoded data (8-bit bytes)
integer data4(12) !Decoded data (6-bit bytes)
integer mettab(-128:127,0:1) !Metric table
logical first
data first/.true./
save first,mettab,ndelta
if(first) then
call getmet4(mettab,ndelta)
first=.false.
endif
!### Optimize these params: ...
amp=30.0
limit=10000
ave0=sum(sym0)/207.0
sym=sym0-ave0
sq=dot_product(sym,sym)
rms0=sqrt(sq/206.0)
sym=sym/rms0
do j=1,207
n=nint(amp*sym(j))
if(n.lt.-127) n=-127
if(n.gt.127) n=127
symbol(j)=n
enddo
nbits=72
ncycles=0
ncount=-1
decoded=' '
call interleave4(symbol(2),-1) !Remove the interleaving
call fano232(symbol(2),nbits+31,mettab,ndelta,limit,data1, &
ncycles,metric,ncount)
nlim=ncycles/(nbits+31)
!### Make usage here like that in jt9fano...
if(ncount.ge.0) then
do i=1,9
i4=data1(i)
if(i4.lt.0) i4=i4+256
data4a(i)=i4
enddo
write(c72,1100) (data4a(i),i=1,9)
1100 format(9b8.8)
read(c72,1102) data4
1102 format(12b6)
call unpackmsg(data4,decoded)
if(decoded(1:6).eq.'000AAA') then
! decoded='***WRONG MODE?***'
decoded=' '
ncount=-1
endif
endif
return
end subroutine extract4

45
lib/f77_wisdom.f90
View File

@ -1,45 +0,0 @@
subroutine write_char(c, iunit)
character c
integer iunit
write(iunit,1000) c
1000 format(a,$)
end subroutine write_char
subroutine export_wisdom_to_file(iunit)
integer iunit
external write_char
! call dfftw_export_wisdom(write_char, iunit)
call sfftw_export_wisdom(write_char, iunit)
end subroutine export_wisdom_to_file
subroutine read_char(ic, iunit)
integer ic
integer iunit
character*256 buf
save buf
integer ibuf
data ibuf/257/
save ibuf
if (ibuf .lt. 257) then
ic = ichar(buf(ibuf:ibuf))
ibuf = ibuf + 1
return
endif
read(iunit,1000,end=10) buf
1000 format(a256)
ic = ichar(buf(1:1))
ibuf = 2
return
10 ic = -1
ibuf = 257
rewind iunit
return
end subroutine read_char
subroutine import_wisdom_from_file(isuccess, iunit)
integer isuccess
integer iunit
external read_char
! call dfftw_import_wisdom(isuccess, read_char, iunit)
call sfftw_import_wisdom(isuccess, read_char, iunit)
end subroutine import_wisdom_from_file

15
lib/fillcom.f90
View File

@ -1,9 +1,11 @@
subroutine fillcom(nutc0,ndepth0,nrxfreq,mode,tx9,flow,fsplit,fhigh)
character*20 datetime
integer mode,flow,fsplit,fhigh
logical tx9
common/npar/nutc,ndiskdat,ntrperiod,nfqso,newdat,npts8,nfa,nfsplit,nfb, &
ntol,kin,nzhsym,nsave,nagain,ndepth,ntxmode,nmode,datetime
character datetime*20,mycall*12,mygrid*6,hiscall*12,hisgrid*6
common/npar/nutc,ndiskdat,ntrperiod,nfqso,newdat,npts8,nfa,nfsplit,nfb, &
ntol,kin,nzhsym,nsubmode,nagain,ndepth,ntxmode,nmode,minw,nclearave, &
emedelay,dttol,nlist,listutc(10),datetime,mycall,mygrid,hiscall,hisgrid
save
nutc=nutc0
@ -17,20 +19,19 @@ subroutine fillcom(nutc0,ndepth0,nrxfreq,mode,tx9,flow,fsplit,fhigh)
nfb=fhigh
ntol=3
kin=1024
nzhsym=173
nsave=0
nzhsym=181
ndepth=ndepth0
if (tx9) then
ntxmode=9
else
ntxmode=65
end if
if (mode.lt.9) then
if (mode.eq.0) then
nmode=65+9
else
nmode=mode
end if
datetime="2013-Apr-16 15:13"
datetime="2013-Apr-16 15:13" !### Temp
if(mode.eq.9 .and. nfsplit.ne.2700) nfa=nfsplit
return

29
lib/flat1a.f90 Normal file
View File

@ -0,0 +1,29 @@
subroutine flat1a(psavg,nsmo,s2,nh,nsteps,nhmax,nsmax)
real psavg(nh)
real s2(nhmax,nsmax)
real x(8192)
ia=nsmo/2 + 1
ib=nh - nsmo/2 - 1
do i=ia,ib
call pctile(psavg(i-nsmo/2),nsmo,50,x(i))
enddo
do i=1,ia-1
x(i)=x(ia)
enddo
do i=ib+1,nh
x(i)=x(ib)
enddo
do i=1,nh
psavg(i)=psavg(i)/x(i)
do j=1,nsteps
s2(i,j)=s2(i,j)/x(i)
enddo
enddo
return
end subroutine flat1a

5
lib/flat4.f90
View File

@ -1,4 +1,4 @@
subroutine flat4(s,npts,nflatten)
subroutine flat4(s,npts0,nflatten)
! Flatten a spectrum for optimum display
! Input: s(npts) Linear scale in power
@ -12,6 +12,7 @@ subroutine flat4(s,npts,nflatten)
real*8 x(1000),y(1000),a(5)
data nseg/10/,npct/10/
npts=min(6827,npts0)
if(s(1).gt.1.e29) go to 900 !Boundary between Rx intervals: do nothing
do i=1,npts
s(i)=10.0*log10(s(i)) !Convert to dB scale
@ -38,7 +39,7 @@ subroutine flat4(s,npts,nflatten)
a=0.
nterms=3
call polfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial
call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial
do i=1,npts
t=i-i0

43
lib/gen4.f90 Normal file
View File

@ -0,0 +1,43 @@
subroutine gen4(msg0,ichk,msgsent,itone,itype)
! Encode a JT4 message. Returns msgsent, the message as it will be
! decoded, an integer array itone(206) of 4-FSK tons values in the
! range 0-3; and itype, the JT message type.
use jt4
use packjt
character*22 msg0
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
character*1 c
integer itone(206)
integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words
integer mettab(-128:127,0:1)
save
if(msg0(1:1).eq.'@') then
read(msg0(2:5),*,end=1,err=1) nfreq
go to 2
1 nfreq=1000
2 itone(1)=nfreq
msgsent=msg0
else
call getmet4(mettab,ndelta)
message=msg0
call fmtmsg(message,iz)
call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
if(ichk.ne.0) go to 999
call encode4(message,itone) !Encode the information bits
i1=index(message,'-')
c=message(i1+1:i1+1)
if(i1.ge.9 .and. c.ge.'0' .and. c.le.'3') then
itone=2*itone + (1-npr(2:)) !Inverted '#' sync
else
itone=2*itone + npr(2:) !Data = MSB, sync = LSB
endif
endif
999 return
end subroutine gen4

74
lib/gen65.f90
View File

@ -3,6 +3,7 @@ subroutine gen65(msg0,ichk,msgsent,itone,itype)
! Encodes a JT65 message to yieild itone(1:126)
! Temporarily, does not implement EME shorthands
use packjt
character*22 msg0
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
@ -20,43 +21,50 @@ subroutine gen65(msg0,ichk,msgsent,itone,itype)
1,1,1,1,1,1/
save
message=msg0
do i=1,22
if(ichar(message(i:i)).eq.0) then
message(i:)=' '
exit
endif
enddo
do i=1,22 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
nspecial=0
! call chkmsg(message,cok,nspecial,flip)
if(nspecial.eq.0) then
call packmsg(message,dgen,itype) !Pack message into 72 bits
call unpackmsg(dgen,msgsent) !Unpack to get message sent
if(ichk.ne.0) go to 999 !Return if checking only
call rs_encode(dgen,sent) !Apply Reed-Solomon code
call interleave63(sent,1) !Apply interleaving
call graycode65(sent,63,1) !Apply Gray code
nsym=126 !Symbols per transmission
if(msg0(1:1).eq.'@') then
read(msg0(2:5),*,end=1,err=1) nfreq
go to 2
1 nfreq=1000
2 itone(1)=nfreq
else
nsym=32
endif
message=msg0
do i=1,22
if(ichar(message(i:i)).eq.0) then
message(i:)=' '
exit
endif
enddo
k=0
do j=1,nsym
if(nprc(j).eq.0) then
k=k+1
itone(j)=sent(k)+2
do i=1,22 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
nspecial=0
! call chkmsg(message,cok,nspecial,flip)
if(nspecial.eq.0) then
call packmsg(message,dgen,itype) !Pack message into 72 bits
call unpackmsg(dgen,msgsent) !Unpack to get message sent
if(ichk.ne.0) go to 999 !Return if checking only
call rs_encode(dgen,sent) !Apply Reed-Solomon code
call interleave63(sent,1) !Apply interleaving
call graycode65(sent,63,1) !Apply Gray code
nsym=126 !Symbols per transmission
else
itone(j)=0
nsym=32
endif
enddo
k=0
do j=1,nsym
if(nprc(j).eq.0) then
k=k+1
itone(j)=sent(k)+2
else
itone(j)=0
endif
enddo
endif
999 return
end subroutine gen65

63
lib/gen9.f90 Normal file
View File

@ -0,0 +1,63 @@
subroutine gen9(msg0,ichk,msgsent,i4tone,itype)
! Encodes a JT9 message and returns msgsent, the message as it will
! be decoded, and an integer array i4tone(85) of 9-FSK tone values
! in the range 0-8.
use packjt
character*22 msg0
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words
integer*1 i1Msg8BitBytes(13) !72 bits and zero tail as 8-bit bytes
integer*1 i1EncodedBits(207) !Encoded information-carrying bits
integer*1 i1ScrambledBits(207) !Encoded bits after interleaving
integer*4 i4DataSymbols(69) !Data symbols (values 0-7)
integer*4 i4GrayCodedSymbols(69) !Gray-coded symbols (values 0-7)
integer*4 i4tone(85) !Tone #s, data and sync (values 0-8)
include 'jt9sync.f90'
save
if(msg0(1:1).eq.'@') then
read(msg0(2:5),*,end=1,err=1) nfreq
go to 2
1 nfreq=1000
2 i4tone(1)=nfreq
else
message=msg0
do i=1,22
if(ichar(message(i:i)).eq.0) then
message(i:)=' '
exit
endif
enddo
do i=1,22 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
if(ichk.ne.0) go to 999
call entail(i4Msg6BitWords,i1Msg8BitBytes) !Add tail, make 8-bit bytes
nsym2=206
call encode232(i1Msg8BitBytes,nsym2,i1EncodedBits) !Encode K=32, r=1/2
call interleave9(i1EncodedBits,1,i1ScrambledBits) !Interleave bits
call packbits(i1ScrambledBits,nsym2,3,i4DataSymbols) !Pk 3-bits into words
call graycode(i4DataSymbols,69,1,i4GrayCodedSymbols) !Apply Gray code
! Insert sync symbols at ntone=0 and add 1 to the data-tone numbers.
j=0
do i=1,85
if(isync(i).eq.1) then
i4tone(i)=0
else
j=j+1
i4tone(i)=i4GrayCodedSymbols(j)+1
endif
enddo
endif
999 return
end subroutine gen9

55
lib/genjt9.f90
View File

@ -1,55 +0,0 @@
subroutine genjt9(msg0,ichk,msgsent,i4tone,itype)
! Encodes a JT9 message and returns msgsent, the message as it will
! be decoded, and an integer array i4tone(85) of 9-FSK tone values
! in the range 0-8.
character*22 msg0
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
integer*4 i4Msg6BitWords(13) !72-bit message as 6-bit words
integer*1 i1Msg8BitBytes(13) !72 bits and zero tail as 8-bit bytes
integer*1 i1EncodedBits(207) !Encoded information-carrying bits
integer*1 i1ScrambledBits(207) !Encoded bits after interleaving
integer*4 i4DataSymbols(69) !Data symbols (values 0-7)
integer*4 i4GrayCodedSymbols(69) !Gray-coded symbols (values 0-7)
integer*4 i4tone(85) !Tone #s, data and sync (values 0-8)
include 'jt9sync.f90'
save
message=msg0
do i=1,22
if(ichar(message(i:i)).eq.0) then
message(i:)=' '
exit
endif
enddo
do i=1,22 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
call packmsg(message,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
if(ichk.ne.0) go to 999
call entail(i4Msg6BitWords,i1Msg8BitBytes) !Add tail, convert to 8-bit bytes
nsym2=206
call encode232(i1Msg8BitBytes,nsym2,i1EncodedBits) !Encode K=32, r=1/2
call interleave9(i1EncodedBits,1,i1ScrambledBits) !Interleave the bits
call packbits(i1ScrambledBits,nsym2,3,i4DataSymbols) !Pack 3-bits into words
call graycode(i4DataSymbols,69,1,i4GrayCodedSymbols) !Apply Gray code
! Insert sync symbols at ntone=0 and add 1 to the data-tone numbers.
j=0
do i=1,85
if(isync(i).eq.1) then
i4tone(i)=0
else
j=j+1
i4tone(i)=i4GrayCodedSymbols(j)+1
endif
enddo
999 return
end subroutine genjt9

108
lib/getmet24.f90 → lib/getmet4.f90
View File

@ -1,52 +1,56 @@
subroutine getmet24(mode,mettab)
! Return appropriate metric table for soft-decision convolutional decoder.
! Metric table (RxSymbol,TxSymbol)
integer mettab(0:255,0:1)
real*4 xx0(0:255)
data xx0/ &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
0.988, 1.000, 0.991, 0.993, 1.000, 0.995, 1.000, 0.991, &
1.000, 0.991, 0.992, 0.991, 0.990, 0.990, 0.992, 0.996, &
0.990, 0.994, 0.993, 0.991, 0.992, 0.989, 0.991, 0.987, &
0.985, 0.989, 0.984, 0.983, 0.979, 0.977, 0.971, 0.975, &
0.974, 0.970, 0.970, 0.970, 0.967, 0.962, 0.960, 0.957, &
0.956, 0.953, 0.942, 0.946, 0.937, 0.933, 0.929, 0.920, &
0.917, 0.911, 0.903, 0.895, 0.884, 0.877, 0.869, 0.858, &
0.846, 0.834, 0.821, 0.806, 0.790, 0.775, 0.755, 0.737, &
0.713, 0.691, 0.667, 0.640, 0.612, 0.581, 0.548, 0.510, &
0.472, 0.425, 0.378, 0.328, 0.274, 0.212, 0.146, 0.075, &
0.000,-0.079,-0.163,-0.249,-0.338,-0.425,-0.514,-0.606, &
-0.706,-0.796,-0.895,-0.987,-1.084,-1.181,-1.280,-1.376, &
-1.473,-1.587,-1.678,-1.790,-1.882,-1.992,-2.096,-2.201, &
-2.301,-2.411,-2.531,-2.608,-2.690,-2.829,-2.939,-3.058, &
-3.164,-3.212,-3.377,-3.463,-3.550,-3.768,-3.677,-3.975, &
-4.062,-4.098,-4.186,-4.261,-4.472,-4.621,-4.623,-4.608, &
-4.822,-4.870,-4.652,-4.954,-5.108,-5.377,-5.544,-5.995, &
-5.632,-5.826,-6.304,-6.002,-6.559,-6.369,-6.658,-7.016, &
-6.184,-7.332,-6.534,-6.152,-6.113,-6.288,-6.426,-6.313, &
-9.966,-6.371,-9.966,-7.055,-9.966,-6.629,-6.313,-9.966, &
-5.858,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966/
save
bias=0.5
scale=10.0
do i=0,255
mettab(i,0)=nint(scale*(xx0(i)-bias))
if(i.ge.1) mettab(256-i,1)=mettab(i,0)
enddo
return
end subroutine getmet24
subroutine getmet4(mettab,ndelta)
! Return appropriate metric table for soft-decision convolutional decoder.
! Metric table (RxSymbol,TxSymbol)
! integer mettab(0:255,0:1)
integer mettab(-128:127,0:1)
real*4 xx0(0:255)
data xx0/ &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
0.988, 1.000, 0.991, 0.993, 1.000, 0.995, 1.000, 0.991, &
1.000, 0.991, 0.992, 0.991, 0.990, 0.990, 0.992, 0.996, &
0.990, 0.994, 0.993, 0.991, 0.992, 0.989, 0.991, 0.987, &
0.985, 0.989, 0.984, 0.983, 0.979, 0.977, 0.971, 0.975, &
0.974, 0.970, 0.970, 0.970, 0.967, 0.962, 0.960, 0.957, &
0.956, 0.953, 0.942, 0.946, 0.937, 0.933, 0.929, 0.920, &
0.917, 0.911, 0.903, 0.895, 0.884, 0.877, 0.869, 0.858, &
0.846, 0.834, 0.821, 0.806, 0.790, 0.775, 0.755, 0.737, &
0.713, 0.691, 0.667, 0.640, 0.612, 0.581, 0.548, 0.510, &
0.472, 0.425, 0.378, 0.328, 0.274, 0.212, 0.146, 0.075, &
0.000,-0.079,-0.163,-0.249,-0.338,-0.425,-0.514,-0.606, &
-0.706,-0.796,-0.895,-0.987,-1.084,-1.181,-1.280,-1.376, &
-1.473,-1.587,-1.678,-1.790,-1.882,-1.992,-2.096,-2.201, &
-2.301,-2.411,-2.531,-2.608,-2.690,-2.829,-2.939,-3.058, &
-3.164,-3.212,-3.377,-3.463,-3.550,-3.768,-3.677,-3.975, &
-4.062,-4.098,-4.186,-4.261,-4.472,-4.621,-4.623,-4.608, &
-4.822,-4.870,-4.652,-4.954,-5.108,-5.377,-5.544,-5.995, &
-5.632,-5.826,-6.304,-6.002,-6.559,-6.369,-6.658,-7.016, &
-6.184,-7.332,-6.534,-6.152,-6.113,-6.288,-6.426,-6.313, &
-9.966,-6.371,-9.966,-7.055,-9.966,-6.629,-6.313,-9.966, &
-5.858,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966, &
-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966,-9.966/
save
bias=0.5
scale=50
ndelta=nint(3.4*scale)
do i=0,255
xx=xx0(i)
if(i.ge.160) xx=xx0(160) - (i-160)*6.822/65.3
mettab(i-128,0)=nint(scale*(xx-bias))
if(i.ge.1) mettab(128-i,1)=mettab(i-128,0)
enddo
mettab(-128,1)=mettab(-127,1)
return
end subroutine getmet4

100
lib/getpfx1.f90
View File

@ -1,100 +0,0 @@
subroutine getpfx1(callsign,k,nv2)
character*12 callsign0,callsign,lof,rof
character*8 c
character addpfx*8,tpfx*4,tsfx*3
logical ispfx,issfx,invalid
common/pfxcom/addpfx
include 'pfx.f90'
callsign0=callsign
nv2=1
iz=index(callsign,' ') - 1
if(iz.lt.0) iz=12
islash=index(callsign(1:iz),'/')
k=0
! if(k.eq.0) go to 10 !Tnx to DL9RDZ for reminder:this was for tests only!
c=' '
if(islash.gt.0 .and. islash.le.(iz-4)) then
! Add-on prefix
c=callsign(1:islash-1)
callsign=callsign(islash+1:iz)
do i=1,NZ
if(pfx(i)(1:4).eq.c) then
k=i
nv2=2
go to 10
endif
enddo
if(addpfx.eq.c) then
k=449
nv2=2
go to 10
endif
else if(islash.eq.(iz-1)) then
! Add-on suffix
c=callsign(islash+1:iz)
callsign=callsign(1:islash-1)
do i=1,NZ2
if(sfx(i).eq.c(1:1)) then
k=400+i
nv2=3
go to 10
endif
enddo
endif
10 if(islash.ne.0 .and.k.eq.0) then
! Original JT65 would force this compound callsign to be treated as
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
! The task here is to compute the proper value of k.
lof=callsign0(:islash-1)
rof=callsign0(islash+1:)
llof=len_trim(lof)
lrof=len_trim(rof)
ispfx=(llof.gt.0 .and. llof.le.4)
issfx=(lrof.gt.0 .and. lrof.le.3)
invalid=.not.(ispfx.or.issfx)
if(ispfx.and.issfx) then
if(llof.lt.3) issfx=.false.
if(lrof.lt.3) ispfx=.false.
if(ispfx.and.issfx) then
i=ichar(callsign0(islash-1:islash-1))
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
issfx=.false.
else
ispfx=.false.
endif
endif
endif
if(invalid) then
k=-1
else
if(ispfx) then
tpfx=lof(1:4)
k=nchar(tpfx(1:1))
k=37*k + nchar(tpfx(2:2))
k=37*k + nchar(tpfx(3:3))
k=37*k + nchar(tpfx(4:4))
nv2=4
i=index(callsign0,'/')
callsign=callsign0(:i-1)
callsign=callsign0(i+1:)
endif
if(issfx) then
tsfx=rof(1:3)
k=nchar(tsfx(1:1))
k=37*k + nchar(tsfx(2:2))
k=37*k + nchar(tsfx(3:3))
nv2=5
i=index(callsign0,'/')
callsign=callsign0(:i-1)
endif
endif
endif
return
end subroutine getpfx1

24
lib/getpfx2.f90
View File

@ -1,24 +0,0 @@
subroutine getpfx2(k0,callsign)
character callsign*12
include 'pfx.f90'
character addpfx*8
common/pfxcom/addpfx
k=k0
if(k.gt.450) k=k-450
if(k.ge.1 .and. k.le.NZ) then
iz=index(pfx(k),' ') - 1
callsign=pfx(k)(1:iz)//'/'//callsign
else if(k.ge.401 .and. k.le.400+NZ2) then
iz=index(callsign,' ') - 1
callsign=callsign(1:iz)//'/'//sfx(k-400)
else if(k.eq.449) then
iz=index(addpfx,' ') - 1
if(iz.lt.1) iz=8
callsign=addpfx(1:iz)//'/'//callsign
endif
return
end subroutine getpfx2

12
lib/grid2k.f90
View File

@ -1,12 +0,0 @@
subroutine grid2k(grid,k)
character*6 grid
call grid2deg(grid,xlong,xlat)
nlong=nint(xlong)
nlat=nint(xlat)
k=0
if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84
return
end subroutine grid2k

10
lib/grid2n.f90
View File

@ -1,10 +0,0 @@
subroutine grid2n(grid,n)
character*4 grid
i1=ichar(grid(1:1))-ichar('A')
i2=ichar(grid(3:3))-ichar('0')
i=10*i1 + i2
n=-i - 31
return
end subroutine grid2n

336
lib/image.f90 Normal file
View File

@ -0,0 +1,336 @@
subroutine imopen(plotfile)
character*(*) plotfile
common/imcom/ lu,npage
lu=80
open(lu,file=plotfile,status='unknown')
write(lu,1000)
1000 format('%!PS-Adobe-2.0'/ &
'/rightshow { dup stringwidth pop neg 0 rmoveto show } def'/ &
'/centershow { dup stringwidth pop neg 2 div ', &
'0 rmoveto show } def'/ &
'/lt { lineto } def'/'%%Page: 1 1')
npage=1
return
end subroutine imopen
subroutine impalette(palette)
character*(*) palette
integer r(0:8),g(0:8),b(0:8)
integer rr,gg,bb
common/imcom/ lu,npage
common/imcom2/rr(0:255),gg(0:255),bb(0:255)
if(palette.eq.'afmhot') then
do i=0,255
j=255-i
rr(i)=min(255,2*j)
gg(i)=max(0,min(255,2*j-128))
bb(i)=max(0,min(255,2*j-256))
enddo
else if(palette.eq.'hot') then
do i=0,255
j=255-i
rr(i)=min(255,3*j)
gg(i)=max(0,min(255,3*j-256))
bb(i)=max(0,min(255,3*j-512))
enddo
else
open(11,file="Palettes/"//palette,status="old")
do j=0,8
read(11,*) r(j),g(j),b(j)
enddo
close(11)
do i=0,255
j0=i/32
j1=j0+1
k=i-32*j0
rr(i)=r(j0) + int((k*(r(j1)-r(j0)))/31 + 0.5)
gg(i)=g(j0) + int((k*(g(j1)-g(j0)))/31 + 0.5)
bb(i)=b(j0) + int((k*(b(j1)-b(j0)))/31 + 0.5)
enddo
endif
return
end subroutine impalette
subroutine imclose
common/imcom/ lu,npage
write(lu,1000)
1000 format('showpage'/'%%Trailer')
close(lu)
return
end subroutine imclose
subroutine imnewpage
common/imcom/ lu,npage
npage=npage+1
write(lu,1000) npage,npage
1000 format('showpage'/'%%Page:',2i4)
return
end subroutine imnewpage
subroutine imxline(x,y,dx)
! Draw a line from (x,y) to (x+dx,y) integer r,g,b
common/imcom/ lu,npage
write(lu,1000) 72.0*x,72.0*y,72.0*dx
1000 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto stroke')
return
end subroutine imxline
subroutine imyline(x,y,dy)
! Draw a line from (x,y) to (x,y+dy)
common/imcom/ lu,npage
write(lu,1000) 72.0*x,72.0*y,72.0*dy
1000 format('newpath',2f7.1,' moveto 0',f7.1,' rlineto stroke')
return
end subroutine imyline
subroutine imwidth(width)
common/imcom/ lu,npage
write(lu,1000) width
1000 format(f7.1,' setlinewidth')
return
end subroutine imwidth
subroutine imfont(fontname,npoints)
character*(*) fontname
common/imcom/ lu,npage
write(lu,1000) fontname,npoints
1000 format('/',a,' findfont',i4,' scalefont setfont')
return
end subroutine imfont
subroutine imstring(string,x,y,just,ndeg)
character*(*) string
common/imcom/ lu,npage
write(lu,1000) 72.0*x,72.0*y,ndeg,string
1000 format(2f7.1,' moveto',i4,' rotate'/'(',a,')')
if(just.eq.1) write(lu,*) 'rightshow'
if(just.eq.2) write(lu,*) 'centershow'
if(just.eq.3) write(lu,*) 'show'
write(lu,1010) -ndeg
1010 format(i4,' rotate'/)
return
end subroutine imstring
subroutine imr4mat(z,IP,JP,imax,jmax,zz1,zz2,x,y,dx,dy,nbox)
real z(IP,JP)
integer idat(2048)
common/imcom/ lu,npage
z1=zz1
z2=zz2
if(z1.eq.0.0 .and. z2.eq.0.0) then
z1=z(1,1)
z2=z1
do i=1,imax
do j=1,jmax
z1=min(z(i,j),z1)
z2=max(z(i,j),z2)
enddo
enddo
endif
scale=255.99/(z2-z1)
write(lu,1002) 72.0*x,72.0*y,72.0*dx,72.0*dy
1002 format(2f7.1,' translate',2f7.1,' scale')
write(lu,*) imax,jmax,8,' [',imax,0,0,jmax,0,0,']'
write(lu,*) '{<'
do j=1,jmax
do i=1,imax
idat(i)=scale*(z(i,j)-z1)
idat(i)=max(idat(i),0)
idat(i)=min(idat(i),255)
idat(i)=255-idat(i)
enddo
write(lu,1004) (idat(i),i=1,imax)
1004 format(30z2.2)
enddo
write(lu,*) '>} image'
write(lu,1006) 1.0/(72.0*dx),1.0/(72.0*dy),-72.0*x,-72.0*y
1006 format(2f9.6,' scale',2f7.1,' translate')
if(nbox.ne.0) then
write(lu,1010) 72.0*x,72.0*y,72.0*dx,72.0*dy,-72*dx
1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', &
f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke')
endif
return
end subroutine imr4mat
subroutine imr4mat_color(z,IP,JP,imax,jmax,zz1,zz2,x,y,dx,dy,nbox)
real z(IP,JP)
integer idat(2048,3)
integer rr,gg,bb
common/imcom/ lu,npage
common/imcom2/rr(0:255),gg(0:255),bb(0:255)
z1=zz1
z2=zz2
if(z1.eq.0.0 .and. z2.eq.0.0) then
z1=z(1,1)
z2=z1
do i=1,imax
do j=1,jmax
z1=min(z(i,j),z1)
z2=max(z(i,j),z2)
enddo
enddo
endif
scale=255.99/(z2-z1)
write(lu,1002) 72.0*x,72.0*y,72.0*dx,72.0*dy
1002 format(2f7.1,' translate',2f7.1,' scale')
write(lu,1003) imax,jmax,8,imax,0,0,jmax,0,0
1003 format(3i5,' [',6i4,']')
write(lu,1004) imax
1004 format('{currentfile 3',i4,' mul string readhexstring pop} bind'/ &
'false 3 colorimage')
do j=1,jmax
do i=1,imax
n=scale*(z(i,j)-z1)
n=max(n,0)
n=min(n,255)
idat(i,1)=rr(n)
idat(i,2)=gg(n)
idat(i,3)=bb(n)
enddo
write(lu,1005) (idat(i,1),idat(i,2),idat(i,3),i=1,imax)
1005 format(30z2.2)
enddo
write(lu,1006) 1.0/(72.0*dx),1.0/(72.0*dy),-72.0*x,-72.0*y
1006 format(2f9.6,' scale',2f7.1,' translate')
if(nbox.ne.0) then
write(lu,1010) 72.0*x,72.0*y,72.0*dx,72.0*dy,-72*dx
1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', &
f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke')
endif
return
end subroutine imr4mat_color
subroutine imr4pro(p,imax,yy1,yy2,x,y,dx,dy,nbox)
real p(imax)
common/imcom/ lu,npage
y1=yy1
y2=yy2
if(y1.eq.0.0 .and. y2.eq.0.0) then
y1=p(1)
y2=y1
do i=1,imax
y1=min(p(i),y1)
y2=max(p(i),y2)
enddo
endif
xscale=72.0*dx/imax
xoff=72.0*x
yscale=72.0*dy
if(y1.ne.y2) yscale=yscale/(y2-y1)
yoff=72.0*y
write(lu,*) '1.416 setmiterlimit'
write(lu,1002) xoff+0.5*xscale,yoff+yscale*(p(1)-y1)
1002 format('newpath',2f7.1,' moveto')
do i=2,imax
write(lu,1004) xoff+(i-0.5)*xscale,yoff+yscale*(p(i)-y1)
1004 format(2f6.1,' lt')
enddo
write(lu,*) 'stroke'
if(nbox.ne.0) then
write(lu,1010) xoff,yoff,72.0*dx,72.0*dy,-72*dx
1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', &
f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke')
endif
return
end subroutine imr4pro
subroutine imline(x1,y1,x2,y2)
common/imcom/ lu,npage
write(lu,1000) 72*x1,72*y1,72*x2,72*y2
1000 format('newpath',2f7.1,' moveto',2f7.1,' lineto stroke')
return
end subroutine imline
subroutine imcircle(x,y,radius,shade)
common/imcom/ lu,npage
write(lu,1000) shade
1000 format(f7.1,' setgray')
write(lu,1002) 72*x,72*y,72*radius
1002 format('newpath',3f7.1,' 0 360 arc fill')
write(lu,1000) 0.0
write(lu,1004) 72*x,72*y,72*radius
1004 format('newpath',3f7.1,' 0 360 arc stroke')
return
end subroutine imcircle
subroutine imtriangle(x,y,rr,shade)
common/imcom/ lu,npage
write(lu,1000) shade
1000 format(f7.1,' setgray')
write(lu,1002) 72*x,72*(y+rr)
1002 format('newpath',2f7.1,' moveto ')
write(lu,1004) 72*(x-rr),72*(y-rr)
1004 format(2f7.1,' lineto ')
write(lu,1004) 72*(x+rr),72*(y-rr)
write(lu,*) 'closepath fill 0 setgray'
write(lu,1002) 72*x,72*(y+rr)
write(lu,1004) 72*(x-rr),72*(y-rr)
write(lu,1004) 72*(x+rr),72*(y-rr)
write(lu,*) 'closepath stroke'
return
end subroutine imtriangle
subroutine imr4prov(p,jmax,xx1,xx2,x,y,dx,dy,nbox)
real p(jmax)
common/imcom/ lu,npage
x1=xx1
x2=xx2
if(x1.eq.0.0 .and. x2.eq.0.0) then
x1=p(1)
x2=x1
do j=1,jmax
x1=min(p(j),x1)
x2=max(p(j),x2)
enddo
endif
xscale=72.0*dx
xoff=72.0*x
if(x1.ne.x2) xscale=xscale/(x2-x1)
yscale=72.0*dy/jmax
yoff=72.0*y
write(lu,*) '1.416 setmiterlimit'
write(lu,1002) xoff+xscale*(x2-p(1)),yoff+0.5*yscale
1002 format('newpath',2f7.1,' moveto')
do j=2,jmax
write(lu,1004) xoff+xscale*(x2-p(j)),yoff+(j-0.5)*yscale
1004 format(2f6.1,' lt')
enddo
write(lu,*) 'stroke'
if(nbox.ne.0) then
write(lu,1010) xoff,yoff,72.0*dx,72.0*dy,-72*dx
1010 format('newpath',2f7.1,' moveto',f7.1,' 0 rlineto 0', &
f7.1,' rlineto',f7.1,' 0 rlineto closepath stroke')
endif
return
end subroutine imr4prov

86
lib/interleave24.f90 → lib/interleave4.f90
View File

@ -1,43 +1,43 @@
subroutine interleave24(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 interleave24
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

26
lib/jt4.f90 Normal file
View File

@ -0,0 +1,26 @@
module jt4
parameter (MAXAVE=64)
integer iutc(MAXAVE)
integer nfsave(MAXAVE)
integer listutc(10)
real ppsave(207,7,MAXAVE) !Accumulated data for message averaging
real rsymbol(207,7)
real dtsave(MAXAVE)
real syncsave(MAXAVE)
real flipsave(MAXAVE)
real zz(1260,65,7)
integer nsave,nlist,ich1,ich2
integer nch(7)
integer npr(207)
data rsymbol/1449*0.0/
data nch/1,2,4,9,18,36,72/
data npr/ &
0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, &
0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, &
1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, &
0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, &
0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, &
0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, &
1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/
end module jt4

43
lib/jt4a.f90 Normal file
View File

@ -0,0 +1,43 @@
subroutine jt4a(dd,jz,nutc,nfqso,newdat,nfa,nfb,ntol0,emedelay,dttol, &
nagain,ndepth,nclearave,minw,nsubmode,mycall,mygrid,hiscall,hisgrid, &
nlist0,listutc0)
use jt4
integer listutc0(10)
real*4 dd(jz)
real*4 dat(30*12000)
character*6 cfile6
character*12 mycall,hiscall
character*6 mygrid,hisgrid
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)
i=index(MyCall,char(0))
if(i.le.0) i=index(MyCall,' ')
mycall=MyCall(1:i-1)//' '
i=index(HisCall,char(0))
if(i.le.0) i=index(HisCall,' ')
hiscall=HisCall(1:i-1)//' '
write(cfile6(1:4),1000) nutc
1000 format(i4.4)
cfile6(5:6)=' '
call timer('wsjt4 ',0)
call wsjt4(dat,jz2,nutc,NClearAve,ntol,emedelay,dttol,mode4,minw, &
mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme)
call timer('wsjt4 ',1)
return
end subroutine jt4a

50
lib/jt4code.f90 Normal file
View File

@ -0,0 +1,50 @@
program jt4code
! Provides examples of message packing, bit and symbol ordering,
! convolutional encoding, and other necessary details of the JT4
! protocol.
use jt4
use packjt
character*22 msg,decoded,bad*1,msgtype*13
integer i4tone(206)
include 'testmsg.f90'
nargs=iargc()
if(nargs.ne.1) then
print*,'Usage: jt4code "message"'
print*,' jt4code -t'
go to 999
endif
call getarg(1,msg)
nmsg=1
if(msg(1:2).eq."-t") nmsg=NTEST
write(*,1010)
1010 format(" Message Decoded Err? Type"/ &
74("-"))
do imsg=1,nmsg
if(nmsg.gt.1) msg=testmsg(imsg)
call fmtmsg(msg,iz) !To upper case, collapse multiple blanks
ichk=0
call gen4(msg,ichk,decoded,i4tone,itype)
msgtype=""
if(itype.eq.1) msgtype="Std Msg"
if(itype.eq.2) msgtype="Type 1 prefix"
if(itype.eq.3) msgtype="Type 1 suffix"
if(itype.eq.4) msgtype="Type 2 prefix"
if(itype.eq.5) msgtype="Type 2 suffix"
if(itype.eq.6) msgtype="Free text"
bad=" "
if(decoded.ne.msg) bad="*"
write(*,1020) imsg,msg,decoded,bad,itype,msgtype
1020 format(i2,'.',2x,a22,2x,a22,3x,a1,i3,": ",a13)
enddo
if(nmsg.eq.1) write(*,1030) i4tone
1030 format(/'Channel symbols'/(30i2))
999 end program jt4code

5
lib/jt65a.f90
View File

@ -1,4 +1,5 @@
subroutine jt65a(dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nagain,ndecoded)
subroutine jt65a(dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nsubmode, &
nagain,ndecoded)
! Process dd() data to find and decode JT65 signals.
@ -29,7 +30,7 @@ subroutine jt65a(dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nagain,ndecoded)
df=12000.0/NFFT !df = 12000.0/16384 = 0.732 Hz
ftol=16.0 !Frequency tolerance (Hz)
mode65=1 !Decoding JT65A only, for now.
mode65=2**nsubmode
done=.false.
freq0=-999.

44
lib/jt65code.f90
View File

@ -4,9 +4,10 @@ program JT65code
! Reed Solomon encoding, and other necessary details of the JT65
! protocol.
character*22 testmsg(26)
use packjt
character*22 msg,msg0,msg1,decoded,cok*3,bad*1,msgtype*10
integer dgen(12),sent(63),recd(12),era(51)
include 'testmsg.f90'
nargs=iargc()
if(nargs.ne.1) then
@ -18,38 +19,17 @@ program JT65code
call getarg(1,msg) !Get message from command line
nmsg=1
if(msg(1:2).eq."-t") then
testmsg(1)="KA1ABC WB9XYZ EN34"
testmsg(2)="KA1ABC WB9XYZ EN34 OOO"
testmsg(3)="KA1ABC WB9XYZ RO"
testmsg(4)="KA1ABC WB9XYZ -21"
testmsg(5)="KA1ABC WB9XYZ R-19"
testmsg(6)="KA1ABC WB9XYZ RRR"
testmsg(7)="KA1ABC WB9XYZ 73"
testmsg(8)="KA1ABC WB9XYZ"
testmsg(9)="KA1ABC WB9XYZ OOO"
testmsg(10)="KA1ABC WB9XYZ RO"
testmsg(11)="ZL/KA1ABC WB9XYZ"
testmsg(12)="KA1ABC ZL/WB9XYZ"
testmsg(13)="KA1ABC/4 WB9XYZ"
testmsg(14)="KA1ABC WB9XYZ/4"
testmsg(15)="CQ ZL4/KA1ABC"
testmsg(16)="DE ZL4/KA1ABC"
testmsg(17)="QRZ ZL4/KA1ABC"
testmsg(18)="CQ WB9XYZ/VE4"
testmsg(19)="HELLO WORLD"
testmsg(20)="ZL4/KA1ABC 73"
testmsg(21)="RO"
testmsg(22)="RRR"
testmsg(23)="73"
testmsg(24)="KA1ABC XL/WB9XYZ"
testmsg(25)="KA1ABC WB9XYZ/W4"
testmsg(26)="123456789ABCDEFGH"
nmsg=26
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"
nmsg=NTEST+5
endif
write(*,1010)
1010 format("Message Decoded Err?"/ &
"-----------------------------------------------------------------")
1010 format(" Message Decoded Err? Type"/ &
74("-"))
do imsg=1,nmsg
if(nmsg.gt.1) msg=testmsg(imsg)
@ -89,8 +69,8 @@ program JT65code
10 bad=" "
if(decoded.ne.msg0) bad="*"
write(*,1020) msg0,decoded,bad,itype,msgtype
1020 format(a22,2x,a22,3x,a1,i3,": ",a10)
write(*,1020) imsg,msg0,decoded,bad,itype,msgtype
1020 format(i2,'.',2x,a22,2x,a22,3x,a1,i3,": ",a13)
enddo
if(nmsg.eq.1 .and. nspecial.eq.0) then

131
lib/jt9.f90
View File

@ -16,35 +16,53 @@ program jt9
character c
character(len=500) optarg, infile
character wisfile*80
integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700,fhigh=4007,nrxfreq=1500,ntrperiod=1,ndepth=1
logical :: shmem = .false., read_files = .false., have_args = .false., tx9 = .false., display_help = .false.
type (option) :: long_options(16) = [ &
option ('help', .false., 'h', 'Display this help message', ''), &
option ('shmem', .true., 's', 'Use shared memory for sample data', '<key>'), &
integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700, &
fhigh=4000,nrxfreq=1500,ntrperiod=1,ndepth=1
logical :: shmem = .false., read_files = .false., have_args = .false., &
tx9 = .false., display_help = .false.
type (option) :: long_options(17) = [ &
option ('help', .false., 'h', 'Display this help message', ''), &
option ('shmem',.true.,'s','Use shared memory for sample data','<key>'), &
option ('tr-period', .true., 'p', 'Tx/Rx period, default=1', '<minutes>'), &
option ('executable-path', .true., 'e', 'Location of subordinate executables (KVASD) default="."', '<path>'), &
option ('data-path', .true., 'a', 'Location of writeable data files, detfault="."', '<path>'), &
option ('temp-path', .true., 't', 'Temporary files path, default="."', '<path>'), &
option ('lowest', .true., 'L', 'Lowest frequency decoded (JT65), default=200Hz', '<hertz>'), &
option ('highest', .true., 'H', 'Highest frequency decoded, default=4007Hz', '<hertz>'), &
option ('split', .true., 'S', 'Lowest JT9 frequency decoded, default=2700Hz', '<hertz>'), &
option ('rx-frequency', .true., 'f', 'Receive frequency offset, default=1500', '<hertz>'), &
option ('patience', .true., 'w', 'FFTW3 planing patience (0-4), default=1', '<patience>'), &
option ('fft-threads', .true., 'm', 'Number of threads to process large FFTs, default=1', '<number>'), &
option ('jt65', .false., '6', 'JT65 mode', ''), &
option ('jt9', .false., '9', 'JT9 mode', ''), &
option ('depth', .true., 'd', 'JT9 decoding depth (1-3), default=1', '<number>'), &
option ('executable-path', .true., 'e', &
'Location of subordinate executables (KVASD) default="."', '<path>'), &
option ('data-path', .true., 'a', &
'Location of writeable data files, detfault="."', '<path>'), &
option ('temp-path', .true., 't', 'Temporary files path, default="."', &
'<path>'), &
option ('lowest', .true., 'L', &
'Lowest frequency decoded (JT65), default=200Hz', '<hertz>'), &
option ('highest', .true., 'H', &
'Highest frequency decoded, default=4007Hz', '<hertz>'), &
option ('split', .true., 'S', &
'Lowest JT9 frequency decoded, default=2700Hz', '<hertz>'), &
option ('rx-frequency', .true., 'f', &
'Receive frequency offset, default=1500', '<hertz>'), &
option ('patience', .true., 'w', &
'FFTW3 planing patience (0-4), default=1', '<patience>'), &
option ('fft-threads', .true., 'm', &
'Number of threads to process large FFTs, default=1', '<number>'), &
option ('jt65', .false., '6', 'JT65 mode', ''), &
option ('jt9', .false., '9', 'JT9 mode', ''), &
option ('jt4', .false., '4', 'JT4 mode', ''), &
option ('depth', .true., 'd', 'JT9 decoding depth (1-3), default=1', &
'<number>'), &
option ('tx-jt9', .false., 'T', 'Tx mode is JT9, default=JT65', '') ]
common/jt9com/ss(184,NSMAX),savg(NSMAX),id2(NMAX),nutc,ndiskdat,ntr, &
mousefqso,newdat,nfa,nfsplit,nfb,ntol,kin,nzhsym,nsynced,ndecoded
character datetime*20,mycall*12,mygrid*6,hiscall*12,hisgrid*6
common/jt9com/ss(184,NSMAX),savg(NSMAX),id2(NMAX),nutc,ndiskdat, &
ntr,mousefqso,newdat,npts8a,nfa,nfsplit,nfb,ntol,kin,nzhsym, &
nsubmode,nagain,ndepth,ntxmode,nmode,minw,nclearave,emedelay, &
dttol,nlist,listutc(10),datetime,mycall,mygrid,hiscall,hisgrid
common/tracer/limtrace,lu
common/patience/npatience,nthreads
common/decstats/num65,numbm,numkv,num9,numfano,infile
data npatience/1/,nthreads/1/
do
call getopt('hs:e:a:r:m:p:d:f:w:t:96TL:S:H:',long_options,c,optarg,arglen,stat, &
offset,remain)
call getopt('hs:e:a:r:m:p:d:f:w:t:964TL:S:H:',long_options,c, &
optarg,arglen,stat,offset,remain)
if (stat .ne. 0) then
exit
end if
@ -52,73 +70,63 @@ program jt9
select case (c)
case ('h')
display_help = .true.
case ('s')
shmem = .true.
shm_key = optarg(:arglen)
case ('e')
exe_dir = optarg(:arglen)
case ('a')
data_dir = optarg(:arglen)
case ('t')
temp_dir = optarg(:arglen)
case ('m')
read (optarg(:arglen), *) nthreads
case ('p')
read_files = .true.
read (optarg(:arglen), *) ntrperiod
case ('d')
read_files = .true.
read (optarg(:arglen), *) ndepth
case ('f')
read_files = .true.
read (optarg(:arglen), *) nrxfreq
case ('L')
read_files = .true.
read (optarg(:arglen), *) flow
case ('S')
read_files = .true.
read (optarg(:arglen), *) fsplit
case ('H')
read_files = .true.
read (optarg(:arglen), *) fhigh
case ('4')
read_files = .true.
mode = 4
case ('6')
read_files = .true.
if (mode.lt.65) mode = mode + 65
case ('9')
read_files = .true.
if (mode.lt.9.or.mode.eq.65) mode = mode + 9
case ('T')
read_files = .true.
tx9 = .true.
case ('w')
read (optarg(:arglen), *) npatience
end select
end do
if (display_help .or. .not. have_args .or. (stat .lt. 0 .or. (shmem .and. remain .gt. 0) &
if (display_help .or. .not. have_args .or. &
(stat .lt. 0 .or. (shmem .and. remain .gt. 0) &
.or. (read_files .and. remain .eq. 0) .or. &
(shmem .and. read_files))) then
print*,'Usage: jt9 -p <per> OPTIONS file1 [file2 ...]'
print*,' Reads data from *.wav files.'
print*,''
print*,' jt9 -s <key> [-w n] [-m n] [-e path] [-a path] [-t path]'
print*,' Gets data from shared memory region with key==<key>'
do i = 1, size (long_options)
print*,''
call long_options(i) % print (6)
@ -126,8 +134,11 @@ program jt9
go to 999
endif
iret=fftwf_init_threads() !Initialize FFTW threading
call fftwf_plan_with_nthreads(1) !Default to 1 thread but use nthreads for the big ones
iret=fftwf_init_threads() !Initialize FFTW threading
! Default to 1 thread, but use nthreads for the big ones
call fftwf_plan_with_nthreads(1)
! Import FFTW wisdom, if available
wisfile=trim(data_dir)//'/jt9_wisdom.dat'// C_NULL_CHAR
iret=fftwf_import_wisdom_from_filename(wisfile)
@ -139,11 +150,11 @@ program jt9
numfano=0
if (shmem) then
call jt9a()
call jt9a() !We're running under control of WSJT-X
go to 999
endif
limtrace=0
limtrace=0 !We're running jt9 in stand-alone mode
lu=12
nflatten=0
@ -152,15 +163,21 @@ program jt9
infile = optarg(:arglen)
open(10,file=infile,access='stream',status='old',err=998)
read(10) ihdr
nfsample=ihdr(7)
nutc0=ihdr(1) !Silence compiler warning
i1=index(infile,'.wav')
read(infile(i1-4:i1-1),*,err=1) nutc0
if(i1.lt.1) i1=index(infile,'.WAV')
if(infile(i1-5:i1-5).eq.'_') then
read(infile(i1-4:i1-1),*,err=1) nutc0
else
read(infile(i1-6:i1-3),*,err=1) nutc0
endif
go to 2
1 nutc0=0
2 nsps=0
if(ntrperiod.eq.1) then
nsps=6912
nzhsym=173
nzhsym=181
else if(ntrperiod.eq.2) then
nsps=15360
nzhsym=178
@ -190,24 +207,30 @@ program jt9
do iblk=1,npts/kstep
k=iblk*kstep
call timer('read_wav',0)
read(10,end=10) id2(k-kstep+1:k)
call timer('read_wav',1)
read(10,end=3) id2(k-kstep+1:k)
go to 4
3 call timer('read_wav',1)
print*,'EOF on input file ',infile
exit
4 call timer('read_wav',1)
nhsym=(k-2048)/kstep
if(nhsym.ge.1 .and. nhsym.ne.nhsym0) then
! Emit signal readyForFFT
ingain=0
call timer('symspec ',0)
call symspec(k,ntrperiod,nsps,ingain,nflatten,pxdb,s,df3,ihsym,npts8)
call timer('symspec ',1)
if(mode.eq.9 .or. mode.eq.74) then
! Compute rough symbol spectra for the JT9 decoder
ingain=0
call timer('symspec ',0)
call symspec(k,ntrperiod,nsps,ingain,pxdb,s,df3, &
ihsym,npts8)
call timer('symspec ',1)
endif
nhsym0=nhsym
if(ihsym.ge.173) go to 10
if(nhsym.ge.181) exit
endif
enddo
10 close(10)
call fillcom(nutc0,ndepth,nrxfreq,mode,tx9,flow,fsplit,fhigh)
call decoder(ss,id2)
call decoder(ss,id2,nfsample)
enddo
call timer('jt9 ',1)

1
lib/jt9a.f90
View File

@ -24,6 +24,7 @@ subroutine jt9a()
call getcwd(cwd)
open(12,file=trim(data_dir)//'/timer.out',status='unknown')
! open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown')
limtrace=0
! limtrace=-1 !Disable all calls to timer()

14
lib/jt9c.f90
View File

@ -4,20 +4,22 @@ subroutine jt9c(ss,savg,id2,nparams0)
real*4 ss(184*NSMAX),savg(NSMAX)
integer*2 id2(NTMAX*12000)
integer nparams0(22),nparams(22)
character*20 datetime
integer nparams0(46),nparams(46)
character datetime*20,mycall*12,mygrid*6,hiscall*12,hisgrid*6
common/npar/nutc,ndiskdat,ntrperiod,nfqso,newdat,npts8,nfa,nfsplit,nfb, &
ntol,kin,nzhsym,nsave,nagain,ndepth,ntxmode,nmode,datetime
ntol,kin,nzhsym,nsave,nagain,ndepth,ntxmode,nmode,minw,nclearave, &
emedelay,dttol,nlist,listutc(10),datetime,mycall,mygrid,hiscall,hisgrid
common/patience/npatience,nthreads
equivalence (nparams,nutc)
nutc=id2(1)+int(savg(1)) !Silence compiler warning
nparams=nparams0 !Copy parameters into common/npar/
if(ndiskdat.ne.0) npatience=2
! if(ndiskdat.ne.0) npatience=2
call flush(6)
! if(sum(nparams).ne.0) call decoder(ss,id2,ldir)
call decoder(ss,id2)
nfsample=12000
call decoder(ss,id2,nfsample)
return
end subroutine jt9c

52
lib/jt9code.f90
View File

@ -2,9 +2,9 @@ program jt9code
! Generate simulated data for testing of WSJT-X
character*22 testmsg(20)
character msg*22,msg0*22,decoded*22,bad*1,msgtype*10
character msg*22,decoded*22,bad*1,msgtype*13
integer*4 i4tone(85) !Channel symbols (values 0-8)
include 'testmsg.f90'
include 'jt9sync.f90'
nargs=iargc()
@ -16,53 +16,29 @@ program jt9code
call getarg(1,msg)
nmsg=1
if(msg(1:2).eq."-t") then
testmsg(1)="KA1ABC WB9XYZ EN34"
testmsg(2)="KA1ABC WB9XYZ RO"
testmsg(3)="KA1ABC WB9XYZ -21"
testmsg(4)="KA1ABC WB9XYZ R-19"
testmsg(5)="KA1ABC WB9XYZ RRR"
testmsg(6)="KA1ABC WB9XYZ 73"
testmsg(7)="KA1ABC WB9XYZ"
testmsg(8)="ZL/KA1ABC WB9XYZ"
testmsg(9)="KA1ABC ZL/WB9XYZ"
testmsg(10)="KA1ABC/4 WB9XYZ"
testmsg(11)="KA1ABC WB9XYZ/4"
testmsg(12)="CQ ZL4/KA1ABC"
testmsg(13)="DE ZL4/KA1ABC"
testmsg(14)="QRZ ZL4/KA1ABC"
testmsg(15)="CQ WB9XYZ/VE4"
testmsg(16)="HELLO WORLD"
testmsg(17)="ZL4/KA1ABC 73"
testmsg(18)="KA1ABC XL/WB9XYZ"
testmsg(19)="KA1ABC WB9XYZ/W4"
testmsg(20)="123456789ABCDEFGH"
nmsg=20
endif
if(msg(1:2).eq."-t") nmsg=NTEST
write(*,1010)
1010 format("Message Decoded Err?"/ &
"-----------------------------------------------------------------")
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 fmtmsg(msg,iz) !To upper case, collapse multiple blanks
ichk=0
call genjt9(msg,ichk,decoded,i4tone,itype) !Encode message into tone #s
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.2) msgtype="Type 1 prefix"
if(itype.eq.3) msgtype="Type 1 suffix"
if(itype.eq.4) msgtype="Type 2 prefix"
if(itype.eq.5) msgtype="Type 2 suffix"
if(itype.eq.6) msgtype="Free text"
bad=" "
if(decoded.ne.msg0) bad="*"
write(*,1020) msg0,decoded,bad,itype,msgtype
1020 format(a22,2x,a22,3x,a1,i3,": ",a10)
if(decoded.ne.msg) bad="*"
write(*,1020) imsg,msg,decoded,bad,itype,msgtype
1020 format(i2,'.',2x,a22,2x,a22,3x,a1,i3,": ",a13)
enddo
if(nmsg.eq.1) write(*,1030) i4tone

1
lib/jt9fano.f90
View File

@ -4,6 +4,7 @@ subroutine jt9fano(i1SoftSymbols,limit,nlim,msg)
! 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)

6
lib/jt9sim.f90
View File

@ -3,6 +3,7 @@ program jt9sim
! Generate simulated data for testing of WSJT-X
use wavhdr
use packjt
parameter (NTMAX=120)
parameter (NMAX=NTMAX*12000)
type(hdr) h
@ -58,7 +59,6 @@ program jt9sim
if(nsps.eq.0) stop 'Bad value for minutes.'
f0=1400.d0 !Center frequency (Hz)
if(snrdb.gt.90.0) f0=fspan
! f0=3000.d0 !Center frequency (Hz)
! f0=1500.0
@ -95,7 +95,7 @@ program jt9sim
endif
if(msg0.ne.' ') then
call genjt9(message,0,msgsent,i4tone,itype) !Encode message into tone #s
call gen9(message,0,msgsent,i4tone,itype) !Encode message into tone #s
endif
rewind 12
@ -104,7 +104,7 @@ program jt9sim
if(msg0.eq.' ') then
read(12,1004) message !Use pre-generated message texts
1004 format(a22)
call genjt9(message,0,msgsent,i4tone,itype)
call gen9(message,0,msgsent,i4tone,itype)
endif
f=f0

12
lib/k2grid.f90
View File

@ -1,12 +0,0 @@
subroutine k2grid(k,grid)
character grid*6
nlong=2*mod((k-1)/5,90)-179
if(k.gt.450) nlong=nlong+180
nlat=mod(k-1,5)+ 85
dlat=nlat
dlong=nlong
call deg2grid(dlong,dlat,grid)
return
end subroutine k2grid

29
lib/lpf1.f90 Normal file
View File

@ -0,0 +1,29 @@
subroutine lpf1(dd,jz,dat,jz2)
parameter (NFFT1=64*11025,NFFT2=32*11025)
real dd(jz)
real dat(jz)
real x(NFFT1)
complex cx(0:NFFT1/2)
equivalence (x,cx)
save x,cx
fac=1.0/float(NFFT1)
x(1:jz)=fac*dd(1:jz)
x(jz+1:NFFT1)=0.0
call four2a(x,NFFT1,1,-1,0) !Forwarxd FFT, r2c
cx(NFFT2/2:)=0.0
! df=11025.0/NFFT1
! do i=1,NFFT1/2
! sx=real(cx(i))**2 + aimag(cx(i))**2
! write(50,3000) i*df,sx
!3000 format(f15.6,e12.3)
! enddo
call four2a(cx,NFFT2,1,1,-1) !Inverse FFT, c2r
jz2=jz/2
dat(1:jz2)=x(1:jz2)
return
end subroutine lpf1

14
lib/n2grid.f90
View File

@ -1,14 +0,0 @@
subroutine n2grid(n,grid)
character*4 grid
if(n.gt.-31 .or. n.lt.-70) stop 'Error in n2grid'
i=-(n+31) !NB: 0 <= i <= 39
i1=i/10
i2=mod(i,10)
grid(1:1)=char(ichar('A')+i1)
grid(2:2)='A'
grid(3:3)=char(ichar('0')+i2)
grid(4:4)='0'
return
end subroutine n2grid

23
lib/nchar.f90
View File

@ -1,23 +0,0 @@
function nchar(c)
! Convert ascii number, letter, or space to 0-36 for callsign packing.
character c*1
n=0 !Silence compiler warning
if(c.ge.'0' .and. c.le.'9') then
n=ichar(c)-ichar('0')
else if(c.ge.'A' .and. c.le.'Z') then
n=ichar(c)-ichar('A') + 10
else if(c.ge.'a' .and. c.le.'z') then
n=ichar(c)-ichar('a') + 10
else if(c.ge.' ') then
n=36
else
Print*,'Invalid character in callsign ',c,' ',ichar(c)
stop
endif
nchar=n
return
end function nchar

21
lib/packbits.f90
View File

@ -1,21 +0,0 @@
subroutine packbits(dbits,nsymd,m0,sym)
! Pack 0s and 1s from dbits() into sym() with m0 bits per word.
! NB: nsymd is the number of packed output words.
integer sym(nsymd)
integer*1 dbits(*)
k=0
do i=1,nsymd
n=0
do j=1,m0
k=k+1
m=dbits(k)
n=ior(ishft(n,1),m)
enddo
sym(i)=n
enddo
return
end subroutine packbits

79
lib/packcall.f90
View File

@ -1,79 +0,0 @@
subroutine packcall(callsign,ncall,text)
! Pack a valid callsign into a 28-bit integer.
parameter (NBASE=37*36*10*27*27*27)
character callsign*6,c*1,tmp*6
logical text
text=.false.
! Work-around for Swaziland prefix:
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
if(callsign(1:3).eq.'CQ ') then
ncall=NBASE + 1
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. &
callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. &
callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
read(callsign(4:6),*) nfreq
ncall=NBASE + 3 + nfreq
endif
return
else if(callsign(1:4).eq.'QRZ ') then
ncall=NBASE + 2
return
else if(callsign(1:3).eq.'DE ') then
ncall=267796945
return
endif
tmp=' '
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
tmp=callsign
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
if(callsign(6:6).ne.' ') then
text=.true.
return
endif
tmp=' '//callsign(:5)
else
text=.true.
return
endif
do i=1,6
c=tmp(i:i)
if(c.ge.'a' .and. c.le.'z') &
tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
enddo
n1=0
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
n2=0
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
n3=0
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
n4=0
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
n5=0
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
n6=0
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
text=.true.
return
endif
ncall=nchar(tmp(1:1))
ncall=36*ncall+nchar(tmp(2:2))
ncall=10*ncall+nchar(tmp(3:3))
ncall=27*ncall+nchar(tmp(4:4))-10
ncall=27*ncall+nchar(tmp(5:5))-10
ncall=27*ncall+nchar(tmp(6:6))-10
return
end subroutine packcall

64
lib/packdxcc.f90
View File

@ -1,64 +0,0 @@
subroutine packdxcc(c,ng,ldxcc)
character*3 c
logical ldxcc
parameter (NZ=303)
character*5 pfx(NZ)
data pfx/ &
'1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', &
'3D2 ', '3DA ','3V ','3W ','3X ','3Y ', &
'4J ','4L ','4S ','4U1 ', '4W ', &
'4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ', &
'5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ', &
'7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ', &
'9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ', &
'9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ', &
'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ', &
'C3 ','C5 ','C6 ','C9 ','CE ','CE0 ', &
'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ', &
'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ', &
'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ', &
'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ', &
'F ','FG ','FH ','FJ ','FK ', 'FM ','FO ', &
'FP ','FR ', &
'FT5 ', 'FW ','FY ','M ','MD ','MI ', &
'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ', &
'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ', &
'HL ','HM ','HP ','HR ','HS ','HV ','HZ ', &
'I ','IG9 ','IS ','IT9 ','J2 ','J3 ','J5 ','J6 ', &
'J7 ','J8 ','JA ','JD ', 'JT ','JW ', &
'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ', &
'KH4 ','KH5 ', 'KH6 ','KH7 ','KH8 ','KH9 ','KL ', &
'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ', &
'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ', &
'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ', &
'PJ2 ','PJ7 ','PY ','PY0 ', 'PZ ','R1F ', &
'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ', &
'ST ','SU ','SV ', 'SV5 ','SV9 ','T2 ','T30 ', &
'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ', &
'TA1 ','TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ', &
'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ', &
'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ', &
'V6 ','V7 ','V8 ','VE ','VK ','VK0 ', 'VK9 ', &
'VP2 ', &
'VP5 ','VP6 ', 'VP8 ', &
'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ', &
'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ', &
'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ', &
'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ', &
'ZD9 ','ZF ','ZK1 ', 'ZK2 ','ZK3 ','ZL ','ZL7 ', &
'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 '/
ldxcc=.false.
ng=0
do i=1,NZ
if(pfx(i)(1:3).eq.c) go to 10
enddo
go to 20
10 ng=180*180+61+i
ldxcc=.true.
20 return
end subroutine packdxcc

76
lib/packgrid.f90
View File

@ -1,76 +0,0 @@
subroutine packgrid(grid,ng,text)
parameter (NGBASE=180*180)
character*4 grid
character*1 c1
logical text
text=.false.
if(grid.eq.' ') go to 90 !Blank grid is OK
! First, handle signal reports in the original range, -01 to -30 dB
if(grid(1:1).eq.'-') then
read(grid(2:3),*,err=800,end=800) n
if(n.ge.1 .and. n.le.30) then
ng=NGBASE+1+n
go to 900
endif
go to 10
else if(grid(1:2).eq.'R-') then
read(grid(3:4),*,err=800,end=800) n
if(n.ge.1 .and. n.le.30) then
ng=NGBASE+31+n
go to 900
endif
go to 10
! Now check for RO, RRR, or 73 in the message field normally used for grid
else if(grid(1:4).eq.'RO ') then
ng=NGBASE+62
go to 900
else if(grid(1:4).eq.'RRR ') then
ng=NGBASE+63
go to 900
else if(grid(1:4).eq.'73 ') then
ng=NGBASE+64
go to 900
endif
! Now check for extended-range signal reports: -50 to -31, and 0 to +49.
10 n=99
c1=grid(1:1)
read(grid,*,err=20,end=20) n
go to 30
20 read(grid(2:4),*,err=30,end=30) n
30 if(n.ge.-50 .and. n.le.49) then
if(c1.eq.'R') then
write(grid,1002) n+50
1002 format('LA',i2.2)
else
write(grid,1003) n+50
1003 format('KA',i2.2)
endif
go to 40
endif
! Maybe it's free text ?
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
if(text) go to 900
! OK, we have a properly formatted grid locator
40 call grid2deg(grid//'mm',dlong,dlat)
long=int(dlong)
lat=int(dlat+ 90.0)
ng=((long+180)/2)*180 + lat
go to 900
90 ng=NGBASE + 1
go to 900
800 text=.true.
900 continue
return
end subroutine packgrid

901
lib/packjt.f90 Normal file
View File

@ -0,0 +1,901 @@
module packjt
contains
subroutine packbits(dbits,nsymd,m0,sym)
! Pack 0s and 1s from dbits() into sym() with m0 bits per word.
! NB: nsymd is the number of packed output words.
integer sym(nsymd)
integer*1 dbits(*)
k=0
do i=1,nsymd
n=0
do j=1,m0
k=k+1
m=dbits(k)
n=ior(ishft(n,1),m)
enddo
sym(i)=n
enddo
return
end subroutine packbits
subroutine unpackbits(sym,nsymd,m0,dbits)
! Unpack bits from sym() into dbits(), one bit per byte.
! NB: nsymd is the number of input words, and m0 their length.
! there will be m0*nsymd output bytes, each 0 or 1.
integer sym(nsymd)
integer*1 dbits(*)
k=0
do i=1,nsymd
mask=ishft(1,m0-1)
do j=1,m0
k=k+1
dbits(k)=0
if(iand(mask,sym(i)).ne.0) dbits(k)=1
mask=ishft(mask,-1)
enddo
enddo
return
end subroutine unpackbits
subroutine packcall(callsign,ncall,text)
! Pack a valid callsign into a 28-bit integer.
parameter (NBASE=37*36*10*27*27*27)
character callsign*6,c*1,tmp*6
logical text
text=.false.
! Work-around for Swaziland prefix:
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
if(callsign(1:3).eq.'CQ ') then
ncall=NBASE + 1
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. &
callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. &
callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
read(callsign(4:6),*) nfreq
ncall=NBASE + 3 + nfreq
endif
return
else if(callsign(1:4).eq.'QRZ ') then
ncall=NBASE + 2
return
else if(callsign(1:3).eq.'DE ') then
ncall=267796945
return
endif
tmp=' '
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
tmp=callsign
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
if(callsign(6:6).ne.' ') then
text=.true.
return
endif
tmp=' '//callsign(:5)
else
text=.true.
return
endif
do i=1,6
c=tmp(i:i)
if(c.ge.'a' .and. c.le.'z') &
tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
enddo
n1=0
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
n2=0
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
n3=0
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
n4=0
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
n5=0
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
n6=0
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
text=.true.
return
endif
ncall=nchar(tmp(1:1))
ncall=36*ncall+nchar(tmp(2:2))
ncall=10*ncall+nchar(tmp(3:3))
ncall=27*ncall+nchar(tmp(4:4))-10
ncall=27*ncall+nchar(tmp(5:5))-10
ncall=27*ncall+nchar(tmp(6:6))-10
return
end subroutine packcall
subroutine unpackcall(ncall,word,iv2,psfx)
parameter (NBASE=37*36*10*27*27*27)
character word*12,c*37,psfx*4
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
word='......'
psfx=' '
n=ncall
iv2=0
if(n.ge.262177560) go to 20
word='......'
! if(n.ge.262177560) go to 999 !Plain text message ...
i=mod(n,27)+11
word(6:6)=c(i:i)
n=n/27
i=mod(n,27)+11
word(5:5)=c(i:i)
n=n/27
i=mod(n,27)+11
word(4:4)=c(i:i)
n=n/27
i=mod(n,10)+1
word(3:3)=c(i:i)
n=n/10
i=mod(n,36)+1
word(2:2)=c(i:i)
n=n/36
i=n+1
word(1:1)=c(i:i)
do i=1,4
if(word(i:i).ne.' ') go to 10
enddo
go to 999
10 word=word(i:)
go to 999
20 if(n.ge.267796946) go to 999
! We have a JT65v2 message
if((n.ge.262178563) .and. (n.le.264002071)) then
! CQ with prefix
iv2=1
n=n-262178563
i=mod(n,37)+1
psfx(4:4)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.264002072) .and. (n.le.265825580)) then
! QRZ with prefix
iv2=2
n=n-264002072
i=mod(n,37)+1
psfx(4:4)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.265825581) .and. (n.le.267649089)) then
! DE with prefix
iv2=3
n=n-265825581
i=mod(n,37)+1
psfx(4:4)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.267649090) .and. (n.le.267698374)) then
! CQ with suffix
iv2=4
n=n-267649090
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.267698375) .and. (n.le.267747659)) then
! QRZ with suffix
iv2=5
n=n-267698375
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.267747660) .and. (n.le.267796944)) then
! DE with suffix
iv2=6
n=n-267747660
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if(n.eq.267796945) then
! DE with no prefix or suffix
iv2=7
psfx = ' '
endif
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
return
end subroutine unpackcall
subroutine packgrid(grid,ng,text)
parameter (NGBASE=180*180)
character*4 grid
character*1 c1
logical text
text=.false.
if(grid.eq.' ') go to 90 !Blank grid is OK
! First, handle signal reports in the original range, -01 to -30 dB
if(grid(1:1).eq.'-') then
read(grid(2:3),*,err=800,end=800) n
if(n.ge.1 .and. n.le.30) then
ng=NGBASE+1+n
go to 900
endif
go to 10
else if(grid(1:2).eq.'R-') then
read(grid(3:4),*,err=800,end=800) n
if(n.ge.1 .and. n.le.30) then
ng=NGBASE+31+n
go to 900
endif
go to 10
! Now check for RO, RRR, or 73 in the message field normally used for grid
else if(grid(1:4).eq.'RO ') then
ng=NGBASE+62
go to 900
else if(grid(1:4).eq.'RRR ') then
ng=NGBASE+63
go to 900
else if(grid(1:4).eq.'73 ') then
ng=NGBASE+64
go to 900
endif
! Now check for extended-range signal reports: -50 to -31, and 0 to +49.
10 n=99
c1=grid(1:1)
read(grid,*,err=20,end=20) n
go to 30
20 read(grid(2:4),*,err=30,end=30) n
30 if(n.ge.-50 .and. n.le.49) then
if(c1.eq.'R') then
write(grid,1002) n+50
1002 format('LA',i2.2)
else
write(grid,1003) n+50
1003 format('KA',i2.2)
endif
go to 40
endif
! Maybe it's free text ?
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
if(text) go to 900
! OK, we have a properly formatted grid locator
40 call grid2deg(grid//'mm',dlong,dlat)
long=int(dlong)
lat=int(dlat+ 90.0)
ng=((long+180)/2)*180 + lat
go to 900
90 ng=NGBASE + 1
go to 900
800 text=.true.
900 continue
return
end subroutine packgrid
subroutine unpackgrid(ng,grid)
parameter (NGBASE=180*180)
character grid*4,grid6*6
grid=' '
if(ng.ge.32400) go to 10
dlat=mod(ng,180)-90
dlong=(ng/180)*2 - 180 + 2
call deg2grid(dlong,dlat,grid6)
grid=grid6(:4)
if(grid(1:2).eq.'KA') then
read(grid(3:4),*) n
n=n-50
write(grid,1001) n
1001 format(i3.2)
if(grid(1:1).eq.' ') grid(1:1)='+'
else if(grid(1:2).eq.'LA') then
read(grid(3:4),*) n
n=n-50
write(grid,1002) n
1002 format('R',i3.2)
if(grid(2:2).eq.' ') grid(2:2)='+'
endif
go to 900
10 n=ng-NGBASE-1
if(n.ge.1 .and.n.le.30) then
write(grid,1012) -n
1012 format(i3.2)
else if(n.ge.31 .and.n.le.60) then
n=n-30
write(grid,1022) -n
1022 format('R',i3.2)
else if(n.eq.61) then
grid='RO'
else if(n.eq.62) then
grid='RRR'
else if(n.eq.63) then
grid='73'
endif
900 return
end subroutine unpackgrid
subroutine packmsg(msg,dat,itype)
! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols
! itype Message Type
!--------------------
! 1 Standardd message
! 2 Type 1 prefix
! 3 Type 1 suffix
! 4 Type 2 prefix
! 5 Type 2 suffix
! 6 Free text
! -1 Does not decode correctly
parameter (NBASE=37*36*10*27*27*27)
parameter (NBASE2=262178562)
character*22 msg
integer dat(12)
character*12 c1,c2
character*4 c3
character*6 grid6
logical text1,text2,text3
itype=1
call fmtmsg(msg,iz)
if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'
! See if it's a CQ message
if(msg(1:3).eq.'CQ ') then
i=3
! ... and if so, does it have a reply frequency?
if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and. &
msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and. &
msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
go to 1
endif
do i=1,22
if(msg(i:i).eq.' ') go to 1 !Get 1st blank
enddo
go to 10 !Consider msg as plain text
1 ia=i
c1=msg(1:ia-1)
do i=ia+1,22
if(msg(i:i).eq.' ') go to 2 !Get 2nd blank
enddo
go to 10 !Consider msg as plain text
2 ib=i
c2=msg(ia+1:ib-1)
do i=ib+1,22
if(msg(i:i).eq.' ') go to 3 !Get 3rd blank
enddo
go to 10 !Consider msg as plain text
3 ic=i
c3=' '
if(ic.ge.ib+1) c3=msg(ib+1:ic)
if(c3.eq.'OOO ') c3=' ' !Strip out the OOO flag
call getpfx1(c1,k1,nv2a)
if(nv2a.ge.4) go to 10
call packcall(c1,nc1,text1)
if(text1) go to 10
call getpfx1(c2,k2,nv2b)
call packcall(c2,nc2,text2)
if(text2) go to 10
if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then
if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
if(k2.gt.0) k2=k2+450
k=max(k1,k2)
if(k.gt.0) then
call k2grid(k,grid6)
c3=grid6(:4)
endif
endif
call packgrid(c3,ng,text3)
if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and. &
(.not.text3)) go to 20
nc1=0
if(nv2b.eq.4) then
if(c1(1:3).eq.'CQ ') nc1=262178563 + k2
if(c1(1:4).eq.'QRZ ') nc1=264002072 + k2
if(c1(1:3).eq.'DE ') nc1=265825581 + k2
else if(nv2b.eq.5) then
if(c1(1:3).eq.'CQ ') nc1=267649090 + k2
if(c1(1:4).eq.'QRZ ') nc1=267698375 + k2
if(c1(1:3).eq.'DE ') nc1=267747660 + k2
endif
if(nc1.ne.0) go to 20
! The message will be treated as plain text.
10 itype=6
call packtext(msg,nc1,nc2,ng)
ng=ng+32768
! Encode data into 6-bit words
20 continue
if(itype.ne.6) itype=max(nv2a,nv2b)
dat(1)=iand(ishft(nc1,-22),63) !6 bits
dat(2)=iand(ishft(nc1,-16),63) !6 bits
dat(3)=iand(ishft(nc1,-10),63) !6 bits
dat(4)=iand(ishft(nc1, -4),63) !6 bits
dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3) !4+2 bits
dat(6)=iand(ishft(nc2,-20),63) !6 bits
dat(7)=iand(ishft(nc2,-14),63) !6 bits
dat(8)=iand(ishft(nc2, -8),63) !6 bits
dat(9)=iand(ishft(nc2, -2),63) !6 bits
dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
dat(11)=iand(ishft(ng,-6),63)
dat(12)=iand(ng,63)
return
end subroutine packmsg
subroutine unpackmsg(dat,msg)
parameter (NBASE=37*36*10*27*27*27)
parameter (NGBASE=180*180)
integer dat(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)
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)=' '
return
end subroutine unpackmsg
subroutine packtext(msg,nc1,nc2,nc3)
parameter (MASK28=2**28 - 1)
character*13 msg
character*42 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
nc1=0
nc2=0
nc3=0
do i=1,5 !First 5 characters in nc1
do j=1,42 !Get character code
if(msg(i:i).eq.c(j:j)) go to 10
enddo
j=37
10 j=j-1 !Codes should start at zero
nc1=42*nc1 + j
enddo
do i=6,10 !Characters 6-10 in nc2
do j=1,42 !Get character code
if(msg(i:i).eq.c(j:j)) go to 20
enddo
j=37
20 j=j-1 !Codes should start at zero
nc2=42*nc2 + j
enddo
do i=11,13 !Characters 11-13 in nc3
do j=1,42 !Get character code
if(msg(i:i).eq.c(j:j)) go to 30
enddo
j=37
30 j=j-1 !Codes should start at zero
nc3=42*nc3 + j
enddo
! We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
nc1=nc1+nc1
if(iand(nc3,32768).ne.0) nc1=nc1+1
nc2=nc2+nc2
if(iand(nc3,65536).ne.0) nc2=nc2+1
nc3=iand(nc3,32767)
return
end subroutine packtext
subroutine unpacktext(nc1,nc2,nc3,msg)
character*22 msg
character*44 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
nc3=iand(nc3,32767) !Remove the "plain text" bit
if(iand(nc1,1).ne.0) nc3=nc3+32768
nc1=nc1/2
if(iand(nc2,1).ne.0) nc3=nc3+65536
nc2=nc2/2
do i=5,1,-1
j=mod(nc1,42)+1
msg(i:i)=c(j:j)
nc1=nc1/42
enddo
do i=10,6,-1
j=mod(nc2,42)+1
msg(i:i)=c(j:j)
nc2=nc2/42
enddo
do i=13,11,-1
j=mod(nc3,42)+1
msg(i:i)=c(j:j)
nc3=nc3/42
enddo
msg(14:22) = ' '
return
end subroutine unpacktext
subroutine getpfx1(callsign,k,nv2)
character*12 callsign0,callsign,lof,rof
character*8 c
character addpfx*8,tpfx*4,tsfx*3
logical ispfx,issfx,invalid
common/pfxcom/addpfx
include 'pfx.f90'
callsign0=callsign
nv2=1
iz=index(callsign,' ') - 1
if(iz.lt.0) iz=12
islash=index(callsign(1:iz),'/')
k=0
! if(k.eq.0) go to 10 !Tnx to DL9RDZ for reminder:this was for tests only!
c=' '
if(islash.gt.0 .and. islash.le.(iz-4)) then
! Add-on prefix
c=callsign(1:islash-1)
callsign=callsign(islash+1:iz)
do i=1,NZ
if(pfx(i)(1:4).eq.c) then
k=i
nv2=2
go to 10
endif
enddo
if(addpfx.eq.c) then
k=449
nv2=2
go to 10
endif
else if(islash.eq.(iz-1)) then
! Add-on suffix
c=callsign(islash+1:iz)
callsign=callsign(1:islash-1)
do i=1,NZ2
if(sfx(i).eq.c(1:1)) then
k=400+i
nv2=3
go to 10
endif
enddo
endif
10 if(islash.ne.0 .and.k.eq.0) then
! Original JT65 would force this compound callsign to be treated as
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
! The task here is to compute the proper value of k.
lof=callsign0(:islash-1)
rof=callsign0(islash+1:)
llof=len_trim(lof)
lrof=len_trim(rof)
ispfx=(llof.gt.0 .and. llof.le.4)
issfx=(lrof.gt.0 .and. lrof.le.3)
invalid=.not.(ispfx.or.issfx)
if(ispfx.and.issfx) then
if(llof.lt.3) issfx=.false.
if(lrof.lt.3) ispfx=.false.
if(ispfx.and.issfx) then
i=ichar(callsign0(islash-1:islash-1))
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
issfx=.false.
else
ispfx=.false.
endif
endif
endif
if(invalid) then
k=-1
else
if(ispfx) then
tpfx=lof(1:4)
k=nchar(tpfx(1:1))
k=37*k + nchar(tpfx(2:2))
k=37*k + nchar(tpfx(3:3))
k=37*k + nchar(tpfx(4:4))
nv2=4
i=index(callsign0,'/')
callsign=callsign0(:i-1)
callsign=callsign0(i+1:)
endif
if(issfx) then
tsfx=rof(1:3)
k=nchar(tsfx(1:1))
k=37*k + nchar(tsfx(2:2))
k=37*k + nchar(tsfx(3:3))
nv2=5
i=index(callsign0,'/')
callsign=callsign0(:i-1)
endif
endif
endif
return
end subroutine getpfx1
subroutine getpfx2(k0,callsign)
character callsign*12
include 'pfx.f90'
character addpfx*8
common/pfxcom/addpfx
k=k0
if(k.gt.450) k=k-450
if(k.ge.1 .and. k.le.NZ) then
iz=index(pfx(k),' ') - 1
callsign=pfx(k)(1:iz)//'/'//callsign
else if(k.ge.401 .and. k.le.400+NZ2) then
iz=index(callsign,' ') - 1
callsign=callsign(1:iz)//'/'//sfx(k-400)
else if(k.eq.449) then
iz=index(addpfx,' ') - 1
if(iz.lt.1) iz=8
callsign=addpfx(1:iz)//'/'//callsign
endif
return
end subroutine getpfx2
subroutine grid2k(grid,k)
character*6 grid
call grid2deg(grid,xlong,xlat)
nlong=nint(xlong)
nlat=nint(xlat)
k=0
if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84
return
end subroutine grid2k
subroutine k2grid(k,grid)
character grid*6
nlong=2*mod((k-1)/5,90)-179
if(k.gt.450) nlong=nlong+180
nlat=mod(k-1,5)+ 85
dlat=nlat
dlong=nlong
call deg2grid(dlong,dlat,grid)
return
end subroutine k2grid
subroutine grid2n(grid,n)
character*4 grid
i1=ichar(grid(1:1))-ichar('A')
i2=ichar(grid(3:3))-ichar('0')
i=10*i1 + i2
n=-i - 31
return
end subroutine grid2n
subroutine n2grid(n,grid)
character*4 grid
if(n.gt.-31 .or. n.lt.-70) stop 'Error in n2grid'
i=-(n+31) !NB: 0 <= i <= 39
i1=i/10
i2=mod(i,10)
grid(1:1)=char(ichar('A')+i1)
grid(2:2)='A'
grid(3:3)=char(ichar('0')+i2)
grid(4:4)='0'
return
end subroutine n2grid
function nchar(c)
! Convert ascii number, letter, or space to 0-36 for callsign packing.
character c*1
n=0 !Silence compiler warning
if(c.ge.'0' .and. c.le.'9') then
n=ichar(c)-ichar('0')
else if(c.ge.'A' .and. c.le.'Z') then
n=ichar(c)-ichar('A') + 10
else if(c.ge.'a' .and. c.le.'z') then
n=ichar(c)-ichar('a') + 10
else if(c.ge.' ') then
n=36
else
Print*,'Invalid character in callsign ',c,' ',ichar(c)
stop
endif
nchar=n
return
end function nchar
end module packjt

119
lib/packmsg.f90
View File

@ -1,119 +0,0 @@
subroutine packmsg(msg,dat,itype)
! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols
! itype Message Type
!--------------------
! 1 Standardd message
! 2 Type 1 prefix
! 3 Type 1 suffix
! 4 Type 2 prefix
! 5 Type 2 suffix
! 6 Free text
! -1 Does not decode correctly
parameter (NBASE=37*36*10*27*27*27)
parameter (NBASE2=262178562)
character*22 msg
integer dat(12)
character*12 c1,c2
character*4 c3
character*6 grid6
logical text1,text2,text3
itype=1
call fmtmsg(msg,iz)
if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'
! See if it's a CQ message
if(msg(1:3).eq.'CQ ') then
i=3
! ... and if so, does it have a reply frequency?
if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and. &
msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and. &
msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
go to 1
endif
do i=1,22
if(msg(i:i).eq.' ') go to 1 !Get 1st blank
enddo
go to 10 !Consider msg as plain text
1 ia=i
c1=msg(1:ia-1)
do i=ia+1,22
if(msg(i:i).eq.' ') go to 2 !Get 2nd blank
enddo
go to 10 !Consider msg as plain text
2 ib=i
c2=msg(ia+1:ib-1)
do i=ib+1,22
if(msg(i:i).eq.' ') go to 3 !Get 3rd blank
enddo
go to 10 !Consider msg as plain text
3 ic=i
c3=' '
if(ic.ge.ib+1) c3=msg(ib+1:ic)
if(c3.eq.'OOO ') c3=' ' !Strip out the OOO flag
call getpfx1(c1,k1,nv2a)
if(nv2a.ge.4) go to 10
call packcall(c1,nc1,text1)
if(text1) go to 10
call getpfx1(c2,k2,nv2b)
call packcall(c2,nc2,text2)
if(text2) go to 10
if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then
if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
if(k2.gt.0) k2=k2+450
k=max(k1,k2)
if(k.gt.0) then
call k2grid(k,grid6)
c3=grid6(:4)
endif
endif
call packgrid(c3,ng,text3)
if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and. &
(.not.text3)) go to 20
nc1=0
if(nv2b.eq.4) then
if(c1(1:3).eq.'CQ ') nc1=262178563 + k2
if(c1(1:4).eq.'QRZ ') nc1=264002072 + k2
if(c1(1:3).eq.'DE ') nc1=265825581 + k2
else if(nv2b.eq.5) then
if(c1(1:3).eq.'CQ ') nc1=267649090 + k2
if(c1(1:4).eq.'QRZ ') nc1=267698375 + k2
if(c1(1:3).eq.'DE ') nc1=267747660 + k2
endif
if(nc1.ne.0) go to 20
! The message will be treated as plain text.
10 itype=6
call packtext(msg,nc1,nc2,ng)
ng=ng+32768
! Encode data into 6-bit words
20 continue
if(itype.ne.6) itype=max(nv2a,nv2b)
dat(1)=iand(ishft(nc1,-22),63) !6 bits
dat(2)=iand(ishft(nc1,-16),63) !6 bits
dat(3)=iand(ishft(nc1,-10),63) !6 bits
dat(4)=iand(ishft(nc1, -4),63) !6 bits
dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3) !4+2 bits
dat(6)=iand(ishft(nc2,-20),63) !6 bits
dat(7)=iand(ishft(nc2,-14),63) !6 bits
dat(8)=iand(ishft(nc2, -8),63) !6 bits
dat(9)=iand(ishft(nc2, -2),63) !6 bits
dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
dat(11)=iand(ishft(ng,-6),63)
dat(12)=iand(ng,63)
return
end subroutine packmsg

47
lib/packtext.f90
View File

@ -1,47 +0,0 @@
subroutine packtext(msg,nc1,nc2,nc3)
parameter (MASK28=2**28 - 1)
character*13 msg
character*42 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
nc1=0
nc2=0
nc3=0
do i=1,5 !First 5 characters in nc1
do j=1,42 !Get character code
if(msg(i:i).eq.c(j:j)) go to 10
enddo
j=37
10 j=j-1 !Codes should start at zero
nc1=42*nc1 + j
enddo
do i=6,10 !Characters 6-10 in nc2
do j=1,42 !Get character code
if(msg(i:i).eq.c(j:j)) go to 20
enddo
j=37
20 j=j-1 !Codes should start at zero
nc2=42*nc2 + j
enddo
do i=11,13 !Characters 11-13 in nc3
do j=1,42 !Get character code
if(msg(i:i).eq.c(j:j)) go to 30
enddo
j=37
30 j=j-1 !Codes should start at zero
nc3=42*nc3 + j
enddo
! We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
nc1=nc1+nc1
if(iand(nc3,32768).ne.0) nc1=nc1+1
nc2=nc2+nc2
if(iand(nc3,65536).ne.0) nc2=nc2+1
nc3=iand(nc3,32767)
return
end subroutine packtext

16
lib/peakdt9.f90
View File

@ -1,14 +1,15 @@
subroutine peakdt9(c2,nz2,nsps8,nspsd,c3,nz3,xdt)
subroutine peakdt9(c2,nsps8,nspsd,c3,xdt)
complex c2(0:4096-1)
complex c3(0:4096-1)
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
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
@ -40,10 +41,9 @@ subroutine peakdt9(c2,nz2,nsps8,nspsd,c3,nz3,xdt)
xdt=(lagpk-lag0)*dtlag
nz3=nspsd*85
do i=0,nz3-1
do i=0,NZ3-1
j=i+lagpk-i0-nspsd+1
if(j.ge.0 .and. j.le.nz2) then
if(j.ge.0 .and. j.lt.NZ2) then
c3(i)=c2(j)
else
c3(i)=0.

16
lib/peakup.f90
View File

@ -1,8 +1,8 @@
subroutine peakup(ym,y0,yp,dx)
b=(yp-ym)/2.0
c=(yp+ym-2.0*y0)/2.0
dx=-b/(2.0*c)
return
end subroutine peakup
subroutine peakup(ym,y0,yp,dx)
b=(yp-ym)/2.0
c=(yp+ym-2.0*y0)/2.0
dx=-b/(2.0*c)
return
end subroutine peakup

13
lib/pfxdump.f90
View File

@ -1,13 +0,0 @@
subroutine pfxdump(fname)
character*(*) fname
include 'pfx.f90'
open(11,file=fname,status='unknown')
write(11,1001) sfx
1001 format('Supported Suffixes:'/(11('/',a1,2x)))
write(11,1002) pfx
1002 format(/'Supported Add-On DXCC Prefixes:'/(15(a5,1x)))
close(11)
return
end subroutine pfxdump

4
lib/polfit.f90 → lib/polyfit.f90
View File

@ -1,4 +1,4 @@
subroutine polfit(x,y,sigmay,npts,nterms,mode,a,chisqr)
subroutine polyfit(x,y,sigmay,npts,nterms,mode,a,chisqr)
implicit real*8 (a-h,o-z)
real*8 x(npts), y(npts), sigmay(npts), a(nterms)
real*8 sumx(19), sumy(10), array(10,10)
@ -69,4 +69,4 @@ subroutine polfit(x,y,sigmay,npts,nterms,mode,a,chisqr)
end if
return
end subroutine polfit
end subroutine polyfit

54
lib/ps24.f90 → lib/ps4.f90
View File

@ -1,27 +1,27 @@
subroutine ps24(dat,nfft,s)
parameter (NMAX=2520+2)
parameter (NHMAX=NMAX/2-1)
real dat(nfft)
real dat2(NMAX)
real s(NHMAX)
complex c(0:NMAX)
equivalence(dat2,c)
nh=nfft/2
do i=1,nh
dat2(i)=dat(i)/128.0 !### Why 128 ??
enddo
do i=nh+1,nfft
dat2(i)=0.
enddo
call four2a(c,nfft,1,-1,0)
fac=1.0/nfft
do i=1,nh
s(i)=fac*(real(c(i))**2 + aimag(c(i))**2)
enddo
return
end subroutine ps24
subroutine ps4(dat,nfft,s)
parameter (NMAX=2520+2)
parameter (NHMAX=NMAX/2-1)
real dat(nfft)
real dat2(NMAX)
real s(NHMAX)
complex c(0:NMAX)
equivalence(dat2,c)
nh=nfft/2
do i=1,nh
dat2(i)=dat(i)/128.0 !### Why 128 ??
enddo
do i=nh+1,nfft
dat2(i)=0.
enddo
call four2a(c,nfft,1,-1,0)
fac=1.0/nfft
do i=1,nh
s(i)=fac*(real(c(i))**2 + aimag(c(i))**2)
enddo
return
end subroutine ps4

81
lib/slope.f90
View File

@ -1,40 +1,41 @@
subroutine slope(y,npts,xpk)
! Remove best-fit slope from data in y(i). When fitting the straight line,
! ignore the peak around xpk +/- 2.
real y(npts)
real x(100)
do i=1,npts
x(i)=i
enddo
sumw=0.
sumx=0.
sumy=0.
sumx2=0.
sumxy=0.
sumy2=0.
do i=1,npts
if(abs(i-xpk).gt.2.0) then
sumw=sumw + 1.0
sumx=sumx + x(i)
sumy=sumy + y(i)
sumx2=sumx2 + x(i)**2
sumxy=sumxy + x(i)*y(i)
sumy2=sumy2 + y(i)**2
endif
enddo
delta=sumw*sumx2 - sumx**2
a=(sumx2*sumy - sumx*sumxy) / delta
b=(sumw*sumxy - sumx*sumy) / delta
do i=1,npts
y(i)=y(i)-(a + b*x(i))
enddo
return
end subroutine slope
subroutine slope(y,npts,xpk)
! Remove best-fit slope from data in y(i). When fitting the straight line,
! ignore the peak around xpk +/- 2.
real y(npts)
real x(100)
do i=1,npts
x(i)=i
enddo
sumw=0.
sumx=0.
sumy=0.
sumx2=0.
sumxy=0.
sumy2=0.
do i=1,npts
if(abs(i-xpk).gt.2.0) then
sumw=sumw + 1.0
sumx=sumx + x(i)
sumy=sumy + y(i)
sumx2=sumx2 + x(i)**2
sumxy=sumxy + x(i)*y(i)
sumy2=sumy2 + y(i)**2
endif
enddo
delta=sumw*sumx2 - sumx**2
a=(sumx2*sumy - sumx*sumxy) / delta
b=(sumw*sumxy - sumx*sumy) / delta
do i=1,npts
y(i)=y(i)-(a + b*x(i))
enddo
return
end subroutine slope

11
lib/softsym.f90
View File

@ -3,9 +3,10 @@ subroutine softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, &
! Compute the soft symbols
complex c2(0:1440-1)
complex c3(0:1440-1)
complex c5(0:1440-1)
parameter (NZ2=1512,NZ3=1360)
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)
@ -16,10 +17,10 @@ subroutine softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, &
! Mix, low-pass filter, and downsample to 16 samples per symbol
call timer('downsam9',0)
call downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
call downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2)
call timer('downsam9',1)
call peakdt9(c2,nz2,nsps8,nspsd,c3,nz3,xdt) !Find DT
call peakdt9(c2,nsps8,nspsd,c3,xdt) !Find DT
fsample=1500.0/ndown
a=0.

1
lib/stdmsg.f90
View File

@ -1,5 +1,6 @@
logical*1 function stdmsg(msg0)
use packjt
character*22 msg0,msg
integer dat(12)

13
lib/symspec.f90
View File

@ -1,4 +1,4 @@
subroutine symspec(k,ntrperiod,nsps,ingain,nflatten,pxdb,s,df3,ihsym,npts8)
subroutine symspec(k,ntrperiod,nsps,ingain,pxdb,s,df3,ihsym,npts8)
! Input:
! k pointer to the most recent new data
@ -25,9 +25,13 @@ subroutine symspec(k,ntrperiod,nsps,ingain,nflatten,pxdb,s,df3,ihsym,npts8)
real*4 tmp(NSMAX)
complex cx(0:MAXFFT3/2)
integer*2 id2
common/jt9com/ss(184,NSMAX),savg(NSMAX),id2(NMAX),nutc,ndiskdat, &
character datetime*20,mycall*12,mygrid*6,hiscall*12,hisgrid*6
common/jt9com/ss(184,NSMAX),savg(NSMAX),id2(NMAX),nutc,ndiskdat, &
ntr,mousefqso,newdat,npts8a,nfa,nfsplit,nfb,ntol,kin,nzhsym, &
nsave,nagain,ndepth,ntxmode,nmode,junk(5)
nsubmode,nagain,ndepth,ntxmode,nmode,minw,nclearave,emedelay, &
dttol,nlist,listutc(10),datetime,mycall,mygrid,hiscall,hisgrid
common/jt9w/syellow(NSMAX)
data rms/999.0/,k0/99999999/,nfft3z/0/
equivalence (xc,cx)
@ -78,9 +82,8 @@ subroutine symspec(k,ntrperiod,nsps,ingain,nflatten,pxdb,s,df3,ihsym,npts8)
do i=0,nfft3-1 !Copy data into cx
j=ja+i-(nfft3-1)
xc(i)=0.
if(j.ge.1) xc(i)=fac0*id2(j)
if(j.ge.1 .and.j.le.NMAX) xc(i)=fac0*id2(j)
enddo
if(ihsym.lt.184) ihsym=ihsym+1
xc(0:nfft3-1)=w3(1:nfft3)*xc(0:nfft3-1) !Apply window w3

179
lib/sync24.f90
View File

@ -1,179 +0,0 @@
subroutine sync24(dat,jz,DFTolerance,NFreeze,MouseDF,mode,mode4, &
dtx,dfx,snrx,snrsync,ccfblue,ccfred1,flip,width)
! Synchronizes JT4 data, finding the best-fit DT and DF.
parameter (NFFTMAX=2520) !Max length of FFTs
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
parameter (NSMAX=525) !Max number of half-symbol steps
integer DFTolerance !Range of DF search
real dat(jz)
real psavg(NHMAX) !Average spectrum of whole record
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 ccfred1(-224:224) !Peak of ccfblue, as function of freq
real tmp(1260)
save
! Do FFTs of twice symbol length, stepped by half symbols. Note that
! we have already downsampled the data by factor of 2.
nsym=207
nfft=2520
nh=nfft/2
nq=nfft/4
nsteps=jz/nq - 1
df=0.5*11025.0/nfft
psavg(1:nh)=0.
do j=1,nsteps !Compute spectrum for each step, get average
k=(j-1)*nq + 1
call ps24(dat(k),nfft,s2(1,j))
psavg(1:nh)=psavg(1:nh) + s2(1:nh,j)
enddo
call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten spectra
! Set freq and lag ranges
famin=200.
fbmax=2700.
fa=famin
fb=fbmax
if(NFreeze.eq.1) then
fa=max(famin,1270.46+MouseDF-DFTolerance)
fb=min(fbmax,1270.46+MouseDF+DFTolerance)
else
fa=max(famin,1270.46+MouseDF-600)
fb=min(fbmax,1270.46+MouseDF+600)
endif
ia=fa/df
ib=fb/df
if(mode.eq.7) then
ia=ia - 3*mode4
ib=ib - 3*mode4
endif
i0=nint(1270.46/df)
lag1=-5
lag2=59
syncbest=-1.e30
syncbest2=-1.e30
ccfred=0.
do i=ia,ib !Find best frequency channel for CCF
call xcor24(s2,i,nsteps,nsym,lag1,lag2,mode4,ccfblue,ccf0,lagpk0,flip)
j=i-i0
if(mode.eq.7) j=j + 3*mode4
if(j.ge.-372 .and. j.le.372) ccfred(j)=ccf0
! Find rms of the CCF, without main peak
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
sync=abs(ccfblue(lagpk0))
ppmax=psavg(i)-1.0
! Find best sync value
if(sync.gt.syncbest2) then
ipk2=i
lagpk2=lagpk0
syncbest2=sync
endif
! We are most interested if snrx will be more than -30 dB.
if(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0
if(sync.gt.syncbest) then
ipk=i
lagpk=lagpk0
syncbest=sync
endif
endif
enddo
! If we found nothing with snrx > -30 dB, take the best sync that *was* found.
if(syncbest.lt.-10.) then
ipk=ipk2
lagpk=lagpk2
syncbest=syncbest2
endif
dfx=(ipk-i0)*df
if(mode.eq.7) dfx=dfx + 3*mode4*df
! Peak up in time, at best whole-channel frequency
call xcor24(s2,ipk,nsteps,nsym,lag1,lag2,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=abs(ccfblue(lagpk))/rms - 1.1 !Empirical
dt=2.0/11025.0
istart=xlag*nq
dtx=istart*dt
snrx=-99.0
ppmax=psavg(ipk)-1.0
if(ppmax.gt.0.0001) then
snrx=db(ppmax*df/2500.0) + 7.5 !Empirical
if(mode.eq.7) snrx=snrx + 3.0 !Empirical
endif
if(snrx.lt.-33.0) snrx=-33.0
! Compute width of sync tone to outermost -3 dB points
i1=max(-450,ia-i0)
i2=min(450,ib-i0)
call pctile(ccfred(i1),i2-i1+1,45,base)
jpk=ipk-i0
if(abs(jpk).gt.450) then
print*,'sync24 a:',jpk,ipk,i0
snrsync=0.
go to 999
else
stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB
endif
do i=-10,0
if(jpk+i.ge.-371) then
if(ccfred(jpk+i).gt.stest) go to 30
endif
enddo
i=0
30 continue
if(abs(jpk+i-1).gt.450 .or. abs(jpk+i).gt.450) then
print*,'sync24 b:',jpk,i
else
x1=i-0.5
endif
do i=10,0,-1
if(jpk+i.le.371) then
if(ccfred(jpk+i).gt.stest) go to 32
endif
enddo
i=0
32 x2=i+0.5
width=x2-x1
if(width.gt.1.2) width=sqrt(width**2 - 1.44)
width=df*width
width=max(0.0,min(99.0,width))
do i=-224,224
ccfred1(i)=ccfred(i)
enddo
999 return
end subroutine sync24

60
lib/sync4.f90 Normal file
View File

@ -0,0 +1,60 @@
subroutine sync4(dat,jz,mode4,minw)
! Synchronizes JT4 data, finding the best-fit DT and DF.
use jt4
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
real dat(jz)
real psavg(NHMAX) !Average spectrum of whole record
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real ccfblue(65) !CCF with pseudorandom sequence
real tmp(1260)
save
! Do FFTs of twice symbol length, stepped by half symbols. Note that
! we have already downsampled the data by factor of 2.
nsym=207
nfft=2520
nh=nfft/2
nq=nfft/4
nsteps=jz/nq - 1
df=0.5*11025.0/nfft
psavg(1:nh)=0.
call timer('ps4 ',0)
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
call timer('ps4 ',1)
call timer('flat1a ',0)
nsmo=min(10*mode4,150)
call flat1a(psavg,nsmo,s2,nh,nsteps,NHMAX,NSMAX) !Flatten spectra
call timer('flat1a ',1)
call timer('smo ',0)
if(mode4.ge.9) call smo(psavg,nh,tmp,mode4/4)
call timer('smo ',1)
ia=600.0/df
ib=1600.0/df
! ichmax=1.0+log(float(mode4))/log(2.0)
do ich=minw+1,7 !Find best width
kz=nch(ich)/2
! Set istep>1 for wide submodes?
do i=ia+kz,ib-kz !Find best frequency channel for CCF
call timer('xcor4 ',0)
call xcor4(s2,i,nsteps,nsym,ich,mode4)
call timer('xcor4 ',1)
enddo
enddo
return
end subroutine sync4

28
lib/testmsg.f90 Normal file
View File

@ -0,0 +1,28 @@
parameter (MAXTEST=35,NTEST=25)
character*22 testmsg(MAXTEST)
data testmsg(1:NTEST)/ &
"CQ WB9XYZ EN34", &
"CQ DX WB9XYZ EN34", &
"QRZ WB9XYZ EN34", &
"KA1ABC WB9XYZ EN34", &
"KA1ABC WB9XYZ RO", &
"KA1ABC WB9XYZ -21", &
"KA1ABC WB9XYZ R-19", &
"KA1ABC WB9XYZ RRR", &
"KA1ABC WB9XYZ 73", &
"KA1ABC WB9XYZ", &
"CQ 000 WB9XYZ EN34", &
"CQ 999 WB9XYZ EN34", &
"ZL/KA1ABC WB9XYZ", &
"KA1ABC ZL/WB9XYZ", &
"KA1ABC/4 WB9XYZ", &
"KA1ABC WB9XYZ/4", &
"CQ ZL4/KA1ABC", &
"DE ZL4/KA1ABC", &
"QRZ ZL4/KA1ABC", &
"CQ WB9XYZ/VE4", &
"HELLO WORLD", &
"ZL4/KA1ABC 73", &
"KA1ABC XL/WB9XYZ", &
"KA1ABC WB9XYZ/W4", &
"123456789ABCDEFGH"/

22
lib/unpackbits.f90
View File

@ -1,22 +0,0 @@
subroutine unpackbits(sym,nsymd,m0,dbits)
! Unpack bits from sym() into dbits(), one bit per byte.
! NB: nsymd is the number of input words, and m0 their length.
! there will be m0*nsymd output bytes, each 0 or 1.
integer sym(nsymd)
integer*1 dbits(*)
k=0
do i=1,nsymd
mask=ishft(1,m0-1)
do j=1,m0
k=k+1
dbits(k)=0
if(iand(mask,sym(i)).ne.0) dbits(k)=1
mask=ishft(mask,-1)
enddo
enddo
return
end subroutine unpackbits

138
lib/unpackcall.f90
View File

@ -1,138 +0,0 @@
subroutine unpackcall(ncall,word,iv2,psfx)
parameter (NBASE=37*36*10*27*27*27)
character word*12,c*37,psfx*4
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
word='......'
psfx=' '
n=ncall
iv2=0
if(n.ge.262177560) go to 20
word='......'
! if(n.ge.262177560) go to 999 !Plain text message ...
i=mod(n,27)+11
word(6:6)=c(i:i)
n=n/27
i=mod(n,27)+11
word(5:5)=c(i:i)
n=n/27
i=mod(n,27)+11
word(4:4)=c(i:i)
n=n/27
i=mod(n,10)+1
word(3:3)=c(i:i)
n=n/10
i=mod(n,36)+1
word(2:2)=c(i:i)
n=n/36
i=n+1
word(1:1)=c(i:i)
do i=1,4
if(word(i:i).ne.' ') go to 10
enddo
go to 999
10 word=word(i:)
go to 999
20 if(n.ge.267796946) go to 999
! We have a JT65v2 message
if((n.ge.262178563) .and. (n.le.264002071)) then
! CQ with prefix
iv2=1
n=n-262178563
i=mod(n,37)+1
psfx(4:4)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.264002072) .and. (n.le.265825580)) then
! QRZ with prefix
iv2=2
n=n-264002072
i=mod(n,37)+1
psfx(4:4)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.265825581) .and. (n.le.267649089)) then
! DE with prefix
iv2=3
n=n-265825581
i=mod(n,37)+1
psfx(4:4)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.267649090) .and. (n.le.267698374)) then
! CQ with suffix
iv2=4
n=n-267649090
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.267698375) .and. (n.le.267747659)) then
! QRZ with suffix
iv2=5
n=n-267698375
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if((n.ge.267747660) .and. (n.le.267796944)) then
! DE with suffix
iv2=6
n=n-267747660
i=mod(n,37)+1
psfx(3:3)=c(i:i)
n=n/37
i=mod(n,37)+1
psfx(2:2)=c(i:i)
n=n/37
i=n+1
psfx(1:1)=c(i:i)
else if(n.eq.267796945) then
! DE with no prefix or suffix
iv2=7
psfx = ' '
endif
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
return
end subroutine unpackcall

45
lib/unpackgrid.f90
View File

@ -1,45 +0,0 @@
subroutine unpackgrid(ng,grid)
parameter (NGBASE=180*180)
character grid*4,grid6*6
grid=' '
if(ng.ge.32400) go to 10
dlat=mod(ng,180)-90
dlong=(ng/180)*2 - 180 + 2
call deg2grid(dlong,dlat,grid6)
grid=grid6(:4)
if(grid(1:2).eq.'KA') then
read(grid(3:4),*) n
n=n-50
write(grid,1001) n
1001 format(i3.2)
if(grid(1:1).eq.' ') grid(1:1)='+'
else if(grid(1:2).eq.'LA') then
read(grid(3:4),*) n
n=n-50
write(grid,1002) n
1002 format('R',i3.2)
if(grid(2:2).eq.' ') grid(2:2)='+'
endif
go to 900
10 n=ng-NGBASE-1
if(n.ge.1 .and.n.le.30) then
write(grid,1012) -n
1012 format(i3.2)
else if(n.ge.31 .and.n.le.60) then
n=n-30
write(grid,1022) -n
1022 format('R',i3.2)
else if(n.eq.61) then
grid='RO'
else if(n.eq.62) then
grid='RRR'
else if(n.eq.63) then
grid='73'
endif
900 return
end subroutine unpackgrid

108
lib/unpackmsg.f90
View File

@ -1,108 +0,0 @@
subroutine unpackmsg(dat,msg)
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)
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)=' '
return
end subroutine unpackmsg

35
lib/unpacktext.f90
View File

@ -1,35 +0,0 @@
subroutine unpacktext(nc1,nc2,nc3,msg)
character*22 msg
character*44 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
nc3=iand(nc3,32767) !Remove the "plain text" bit
if(iand(nc1,1).ne.0) nc3=nc3+32768
nc1=nc1/2
if(iand(nc2,1).ne.0) nc3=nc3+65536
nc2=nc2/2
do i=5,1,-1
j=mod(nc1,42)+1
msg(i:i)=c(j:j)
nc1=nc1/42
enddo
do i=10,6,-1
j=mod(nc2,42)+1
msg(i:i)=c(j:j)
nc2=nc2/42
enddo
do i=13,11,-1
j=mod(nc3,42)+1
msg(i:i)=c(j:j)
nc3=nc3/42
enddo
msg(14:22) = ' '
return
end subroutine unpacktext

28
lib/wav11.f90 Normal file
View File

@ -0,0 +1,28 @@
subroutine wav11(d2,npts,dd)
! Convert i*2 data sampled at 12000 Hz to r*4 sampled at 11025 Hz.
parameter (NZ11=60*11025,NZ12=60*12000)
parameter (NFFT1=64*12000,NFFT2=64*11025)
integer*2 d2(NZ12)
real*4 dd(NZ11)
real x(NFFT2)
complex cx(0:NFFT1/2)
equivalence (x,cx)
save x,cx
jz=min(NZ12,npts)
x(1:jz)=d2(1:jz)
x(jz+1:)=0.0
call four2a(x,nfft1,1,-1,0) !Forwarxd FFT, r2c
df=12000.0/NFFT1
ia=5000.0/df
cx(ia:)=0.0
call four2a(cx,nfft2,1,1,-1) !Inverse FFT, c2r
npts=jz*11025.0/12000.0
fac=1.e-6
dd(1:npts)=fac*x(1:npts)
if(npts.lt.NZ11) dd(npts+1:NZ11)=0.0
return
end subroutine wav11

49
lib/wav12.f90 Normal file
View File

@ -0,0 +1,49 @@
subroutine wav12(d2,d1,npts,nbitsam2)
! Convert i*2 or i*1 data at 11025 Hz (from WSJT *.wav files)
! to i*2 data at 12000 Hz.
! Input: i*2 d2(npts) or i*1 d1(npts)
! i*2 nbitsam2 = 8 or 16 (bits per sample)
! Output: npts = (12000*npts)/11025
! i*2 d2(npts)
parameter (NZ11=60*11025,NZ12=60*12000)
parameter (NFFT1=64*11025,NFFT2=64*12000)
integer*1 d1(NZ11)
integer*1 d1a(NZ11)
integer*1 i1
integer*2 i2
integer*2 d2(NZ12)
real x(NFFT2)
complex cx(0:NFFT2/2)
integer*2 nbitsam2
equivalence (x,cx),(i1,i2)
jz=min(NZ11,npts)
if(nbitsam2.eq.8) then
jz=min(NZ11,2*npts)
d1a(1:jz)=d1(1:jz) !d1 and d2 may be same array in calling prog
do i=1,jz !Move data from d1a into d2
i2=0
i1=d1a(i)
d2(i)=10*(i2-128)
enddo
endif
x(1:jz)=d2(1:jz)
x(jz+1:)=0.0
call four2a(x,nfft1,1,-1,0) !Forwarxd FFT, r2c
cx(nfft1/2:)=0.0
call four2a(cx,nfft2,1,1,-1) !Inverse FFT, c2r
npts=jz*12000.0/11025.0
fac=1.e-6
! if(nbitsam2.eq.16) fac=3.e-6
x=fac*x
d2(1:npts)=nint(x(1:npts))
if(npts.lt.NZ12) d2(npts+1:NZ12)=0
return
end subroutine wav12

181
lib/wsjt24.f90
View File

@ -1,181 +0,0 @@
subroutine wsjt24(dat,npts,cfile6,NClearAve,MinSigdB, &
DFTolerance,NFreeze,mode,mode4,Nseg,MouseDF,NAgain, &
idf,lumsg,lcum,nspecial,ndf,NSyncOK,ccfblue,ccfred,ndiag)
! Orchestrates the process of decoding JT4 messages, using data that
! have been 2x downsampled.
! No message averaging and no deep search, at present.
parameter (MAXAVE=120)
real dat(npts) !Raw data
real*4 ccfblue(-5:540) !CCF in time
real*4 ccfred(-224:224) !CCF in frequency
integer DFTolerance
logical first
logical lcum
character decoded*22,cfile6*6,special*5,cooo*3
character*22 avemsg1,avemsg2,deepmsg
character*77 line,ave1,ave2
character*1 csync,c1
character*12 mycall
character*12 hiscall
character*6 hisgrid
character submode*1
real*4 ccfbluesum(-5:540),ccfredsum(-224:224)
common/ave/ppsave(207,7,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE)
data first/.true./,ns10/0/,ns20/0/
save
if(first) then
nsave=0
first=.false.
ave1=' '
ave2=' '
ccfblue=0.
ccfred=0.
if(nspecial.eq.999) go to 900 !Silence compiler warning
endif
ndepth=3 !###
naggressive=0
if(ndepth.ge.2) naggressive=1
nq1=3
nq2=6
if(naggressive.eq.1) nq1=1
if(NClearAve.ne.0) then
nsave=0 !Clear the averaging accumulators
ns10=0
ns20=0
ave1=' '
ave2=' '
endif
if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then
ns10=0 !For Include/Exclude ?
ns20=0
endif
! Attempt to synchronize: look for sync pattern, get DF and DT.
call sync24(dat,npts,DFTolerance,NFreeze,MouseDF,mode, &
mode4,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
csync=' '
decoded=' '
deepmsg=' '
special=' '
cooo=' '
ncount=-1 !Flag for RS decode of current record
ncount1=-1 !Flag for RS Decode of ave1
ncount2=-1 !Flag for RS Decode of ave2
NSyncOK=0
nqual1=0
nqual2=0
if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1)) nsave=nsave+1
if(nsave.le.0) go to 900 !Prevent bounds error
nflag(nsave)=0 !Clear the "good sync" flag
iseg(nsave)=Nseg !Set the RX segment to 1 or 2
nsync=nint(snrsync-3.0)
nsnr=nint(snrx)
if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0
nsnrlim=-33
if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200
! If we get here, we have achieved sync!
NSyncOK=1
nflag(nsave)=1 !Mark this RX file as good
csync='*'
if(flip.lt.0.0) then
csync='#'
cooo='O ?'
endif
call decode24(dat,npts,dtx,dfx,flip,mode,mode4,decoded, &
ncount,deepmsg,qual,submode)
200 kvqual=0
if(ncount.ge.0) kvqual=1
nqual=qual
if(ndiag.eq.0 .and. nqual.gt.10) nqual=10
if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg
ndf=nint(dfx)
if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO'
if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?'
if(decoded.eq.' ') cooo=' '
do i=1,22
c1=decoded(i:i)
if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32)
enddo
jdf=ndf+idf
! call cs_lock('wsjt24')
write(line,1010) cfile6,nsync,nsnr,dtx-1.0,jdf,nint(width), &
csync,special,decoded(1:19),cooo,kvqual,nqual,submode
1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i3,i5,1x,a1)
! Blank all end-of-line stuff if no decode
if(line(31:40).eq.' ') line=line(:30)
if(lcum) write(21,1011) line
! Write decoded msg unless this is an "Exclude" request:
if(MinSigdB.lt.99) write(*,1011) line
1011 format(a77)
if(nsave.ge.1) call avemsg4(1,mode4,ndepth, &
avemsg1,nused1,nq1,nq2,neme,mycall,hiscall,hisgrid,qual1, &
ns1,ncount1)
if(nsave.ge.1) call avemsg4(2,mode4,ndepth, &
avemsg2,nused2,nq1,nq2,neme,mycall,hiscall,hisgrid,qual2, &
ns2,ncount2)
nqual1=qual1
nqual2=qual2
if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10
if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10
nc1=0
nc2=0
if(ncount1.ge.0) nc1=1
if(ncount2.ge.0) nc2=1
! Write the average line
if(ns1.ge.1) then
if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1,nc1,nqual1
1021 format(a6,i3,i4,'/',i1,20x,a19,i7,i5)
if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6, &
1,nused1,ns1,avemsg1,nc1,nqual1
1022 format(a6,i3,i4,'/',i2,19x,a19,i7,i5)
if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1, &
avemsg1,nc1,nqual1
1023 format(a6,i3,i4,'/',i3,18x,a19,i7,i5)
if(lcum .and. (avemsg1.ne.' ')) &
write(21,1011) ave1
ns10=ns1
endif
! If Monitor segment #2 is available, write that line also
if(ns2.ge.1) then
if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2,nc2,nqual2
if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6, &
2,nused2,ns2,avemsg2,nc2,nqual2
if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2,nc2,nqual2
if(lcum .and. (avemsg2.ne.' ')) &
write(21,1011) ave2
ns20=ns2
endif
if(ave1(31:40).eq.' ') ave1=ave1(:30)
if(ave2(31:40).eq.' ') ave2=ave2(:30)
write(12,1011) ave1
write(12,1011) ave2
call flush(12)
! call cs_unlock
900 continue
ccfbluesum=ccfbluesum + ccfblue
ccfredsum=ccfredsum + ccfred
return
end subroutine wsjt24

43
lib/wsjt24d.f90
View File

@ -1,43 +0,0 @@
program wsjt24d
real*4 dat(60*11025/2)
character*6 cfile6
character*12 arg
real ccfblue(-5:540) !X-cor function in JT65 mode (blue line)
real ccfred(450) !Average spectrum of the whole file
integer dftolerance
nargs=iargc()
if(nargs.ne.2) then
print*,'Usage: wspr24d ifile1 ifile2'
go to 999
endif
call getarg(1,arg)
read(arg,*) ifile1
call getarg(2,arg)
read(arg,*) ifile2
open(23,file='CALL3.TXT',status='old')
open(50,file='vk7mo.dat',form='unformatted',status='old')
do ifile=1,ifile2
read(50,end=999) jz,cfile6,NClearAve,MinSigdB,DFTolerance,NFreeze, &
mode,mode4,Nseg,MouseDF2,NAgain,idf,lumsg,lcum,nspecial,ndf, &
NSyncOK,dat(1:jz)
if(ifile.lt.ifile1) cycle
! write(*,3000) ifile,cfile6,jz,mode,mode4,idf
!3000 format(i3,2x,a6,i10,3i5)
dftolerance=100
nfreeze=1
neme=0
! call wsjt24(dat(4097),jz-4096,cfile6,NClearAve,MinSigdB,DFTolerance, &
call wsjt24(dat,jz,cfile6,NClearAve,MinSigdB,DFTolerance, &
NFreeze,mode,mode4,Nseg,MouseDF2,NAgain,idf,lumsg,lcum,nspecial, &
ndf,NSyncOK,ccfblue,ccfred,ndiag)
if(ifile.ge.ifile2) exit
enddo
999 end program wsjt24d

179
lib/wsjt4.f90 Normal file
View File

@ -0,0 +1,179 @@
subroutine wsjt4(dat,npts,nutc,NClearAve,ntol,emedelay,dttol, &
mode4,minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme)
! Orchestrates the process of decoding JT4 messages, using data that
! have been 2x downsampled.
! NB: JT4 presently looks for only one decodable signal in the FTol
! range -- analogous to the nqd=1 step in JT9 and JT65.
use jt4
real dat(npts) !Raw data
real z(458,65)
logical first,prtavg
character decoded*22,special*5
character*22 avemsg,deepmsg,deepave,blank,deepmsg0,deepave1
character csync*1,cqual*2
character*12 mycall
character*12 hiscall
character*6 hisgrid
data first/.true./,nutc0/-999/,nfreq0/-999999/
save
if(first) then
nsave=0
first=.false.
blank=' '
ccfblue=0.
ccfred=0.
nagain=0
endif
zz=0.
! syncmin=1.0
syncmin=7.0
naggressive=0
if(ndepth.ge.2) naggressive=1
nq1=3
nq2=6
if(naggressive.eq.1) nq1=1
if(NClearAve.ne.0) then
nsave=0
iutc=-1
nfsave=0.
listutc=0
ppsave=0.
rsymbol=0.
dtsave=0.
syncsave=0.
endif
! Attempt to synchronize: look for sync pattern, get DF and DT.
call timer('sync4 ',0)
call sync4(dat,npts,mode4,minw)
call timer('sync4 ',1)
call timer('zplt ',0)
do ich=4,6
z(1:458,1:65)=zz(274:731,1:65,ich)
call zplt(z,ich-4,syncz,dtxz,nfreqz,flipz,sync2z,0,emedelay,dttol, &
nfqso,ntol)
if(ich.eq.5) then
dtxzz=dtxz
nfreqzz=nfreqz
endif
enddo
call timer('zplt ',1)
! Use results from zplt
flip=flipz
sync=syncz
snrx=db(sync) - 26.
nsnr=nint(snrx)
if(sync.lt.syncmin) then
write(*,1010) nutc,nsnr,dtxz,nfreqz
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: display the message and return FANO OK
write(*,1010) nutc,nsnr,dtx,nfreq,csync,decoded,' *', &
char(ichar('A')+ich-1)
1010 format(i4.4,i4,f5.2,i5,a1,1x,a22,a2,1x,a1,i3)
nsave=0
go to 990
else ! NO FANO
if(qual.gt.qbest) then
dtx0=dtx
nfreq0=nfreq
deepmsg0=deepmsg
ich0=ich
qbest=qual
endif
endif
! Single-sequence Fano decode failed, so try for an average Fano decode:
qave=0.
! If this is a new minute or a new frequency, call avg4
if(.not. prtavg) then
if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then
nutc0=nutc ! TRY AVG
nfreq0=nfreq
nsave=nsave+1
nsave=mod(nsave-1,64)+1
call timer('avg4 ',0)
call 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: display the message AVG FANO OK
write(*,1010) nutc,nsnr,dtx,nfreq,csync,avemsg,' *', &
char(ichar('A')+ich-1),nfanoave
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(int(qual).ge.nq1) then
write(cqual,'(i2)') int(qual)
write(*,1010) nutc,nsnr,dtx,nfreq,csync, &
deepmsg,cqual,char(ichar('A')+ich-1)
else
write(*,1010) nutc,nsnr,dtxz,nfreqz,csync
endif
dtx=dtx1
nfreq=nfreq1
deepave=deepave1
ich=ich1
qave=qabest
if(int(qave).ge.nq1) then
write(cqual,'(i2)') nint(qave)
write(*,1010) nutc,nsnr,dtx,nfreq,csync, &
deepave,cqual,char(ichar('A')+ich-1),ndeepave
endif
990 return
end subroutine wsjt4

94
lib/xcor24.f90
View File

@ -1,94 +0,0 @@
subroutine xcor24(s2,ipk,nsteps,nsym,lag1,lag2,mode4,ccf,ccf0,lagpk,flip)
! Computes ccf of a row of s2 and the pseudo-random array pr2. Returns
! peak of the CCF and the lag at which peak occurs. For JT65, the
! CCF peak may be either positive or negative, with negative implying
! the "OOO" message.
parameter (NHMAX=1260) !Max length of power spectra
parameter (NSMAX=525) !Max number of half-symbol steps
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real a(NSMAX)
real ccf(-5:540)
integer npr2(207)
real pr2(207)
logical first
data lagmin/0/ !Silence g77 warning
data first/.true./
data npr2/ &
0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, &
0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, &
1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, &
0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, &
0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, &
0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, &
1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/
save
if(first) then
do i=1,207
pr2(i)=2*npr2(i)-1
enddo
first=.false.
endif
do j=1,nsteps
n=2*mode4
if(mode4.eq.1) then
a(j)=max(s2(ipk+n,j),s2(ipk+3*n,j)) - max(s2(ipk ,j),s2(ipk+2*n,j))
else
kz=mode4/2
ss0=0.
ss1=0.
ss2=0.
ss3=0.
wsum=0.
do k=-kz+1,kz-1
w=float(kz-iabs(k))/mode4
wsum=wsum+w
if(ipk+k.lt.1 .or. ipk+3*n+k.gt.1260) then
print*,'xcor24:',ipk,n,k
else
ss0=ss0 + w*s2(ipk +k,j)
ss1=ss1 + w*s2(ipk+ n+k,j)
ss2=ss2 + w*s2(ipk+2*n+k,j)
ss3=ss3 + w*s2(ipk+3*n+k,j)
endif
enddo
a(j)=(max(ss1,ss3) - max(ss0,ss2))/sqrt(wsum)
endif
enddo
ccfmax=0.
ccfmin=0.
do lag=lag1,lag2
x=0.
do i=1,nsym
j=2*i-1+lag
if(j.ge.1 .and. j.le.nsteps) x=x+a(j)*pr2(i)
enddo
ccf(lag)=2*x !The 2 is for plotting scale
if(ccf(lag).gt.ccfmax) then
ccfmax=ccf(lag)
lagpk=lag
endif
if(ccf(lag).lt.ccfmin) then
ccfmin=ccf(lag)
lagmin=lag
endif
enddo
ccf0=ccfmax
flip=1.0
if(-ccfmin.gt.ccfmax) then
do lag=lag1,lag2
ccf(lag)=-ccf(lag)
enddo
lagpk=lagmin
ccf0=-ccfmin
flip=-1.0
endif
return
end subroutine xcor24

49
lib/xcor4.f90 Normal file
View File

@ -0,0 +1,49 @@
subroutine xcor4(s2,ipk,nsteps,nsym,ich,mode4)
! Computes ccf of the 4-FSK spectral array s2 and the pseudo-random
! array pr2. Returns peak of CCF and the lag at which peak occurs.
! The CCF peak may be either positive or negative, with negative
! implying a message with report.
use jt4
parameter (NHMAX=1260) !Max length of power spectra
parameter (NSMAX=525) !Max number of half-symbol steps
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real a(NSMAX)
save
nw=nch(ich)
do j=1,nsteps
n=2*mode4
if(mode4.eq.1) then
a(j)=max(s2(ipk+n,j),s2(ipk+3*n,j)) - max(s2(ipk ,j),s2(ipk+2*n,j))
else
kz=max(1,nw/2)
ss0=0.
ss1=0.
ss2=0.
ss3=0.
wsum=0.
do k=-kz+1,kz-1
w=float(kz-iabs(k))/nw
wsum=wsum+w
ss0=ss0 + w*s2(ipk +k,j)
ss1=ss1 + w*s2(ipk+ n+k,j)
ss2=ss2 + w*s2(ipk+2*n+k,j)
ss3=ss3 + w*s2(ipk+3*n+k,j)
enddo
a(j)=(max(ss1,ss3) - max(ss0,ss2))/sqrt(wsum)
endif
enddo
do lag=1,65
x=0.
do i=1,nsym
j=2*i-1+lag
if(j.ge.1 .and. j.le.nsteps) x=x+a(j)*float(2*npr(i)-1)
enddo
zz(ipk,lag,ich)=x
enddo
return
end subroutine xcor4

112
lib/zplt.f90 Normal file
View File

@ -0,0 +1,112 @@
subroutine zplt(z,iplt,sync,dtx,nfreq,flip,sync2,nplot,emedelay,dttol, &
nfqso,ntol)
real z(458,65)
real zz(458,65)
integer ij(2)
character*4 lab
call pctile(z,458*65,84,rms)
fac=0.05/rms
z=fac*z
dtq=0.114286
df=11025.0/(2.0*2520.0)
ia=nint((nfqso-ntol)/df) - 273
if(ia.lt.1) ia=1
ib=nint((nfqso+ntol)/df) - 273
if(ib.gt.458) ib=458
ja=(emedelay+0.8-dttol)/dtq
if(ja.lt.1) ja=1
jb=(emedelay+0.8+dttol)/dtq
if(jb.gt.65) jb=65
zz=0.
zz(ia:ib,ja:jb)=z(ia:ib,ja:jb)
zmin=minval(zz)
zmax=maxval(zz)
flip=1.0
if(abs(zmin).gt.abs(zmax)) flip=-1.0
ij=maxloc(zz)
if(flip.lt.0.0) ij=minloc(zz)
i0=ij(1)
j0=ij(2)
nfreq=nint((i0+273)*df)
dtx=j0*dtq-0.8
! write(69,3101) ia,ib,ja,jb,ij,dtx,nfreq
!3101 format(6i5,f8.2,i6)
ia=max(1,i0-72)
ib=min(458,i0+72)
sync=16.33*flip*(z(i0,j0) - 0.5*(z(ia,j0)+z(ib,j0)))
sync2=20.0*flip*z(i0,j0)
if(nplot.eq.0) go to 900
zmax=max(abs(zmin),abs(zmax),1.0)
zmin=-zmax
do j=1,65
write(61,1100) j*dtq-0.8,z(i0,j)
1100 format(2f10.3)
enddo
do i=1,458
write(62,1100) (i+273)*df,flip*z(i,j0)
enddo
xx=1.5
yy=7.5 - 3.0*iplt
width=6.0
height=2.0
IP=458
JP=65
imax=IP
jmax=JP
if(iplt.eq.0) then
call imopen("testjt4.ps")
call imfont("Helvetica",16)
call impalette("BlueRed.pal")
endif
call imr4mat_color(z,IP,JP,imax,jmax,zmin,zmax,xx,yy, &
width,height,1)
call imstring("Frequency (Hz)",xx+0.5*width,yy-0.5,2,0)
dy=0.1
do i=1,9
x=xx + 0.1*i*width
call imyline(x,yy,dy)
call imyline(x,yy+height,-dy)
enddo
do i=1,6
nf=(i-1)*200 + 600
write(lab,1020) nf
1020 format(i4)
x=xx + (i-1)*0.2*width
call imstring(lab,x,yy-0.25,2,0)
enddo
dx=0.1
do i=0,6
y=yy + height*(0.8+i)/(65.0*0.114286)
call imxline(xx,y,dx)
call imxline(xx+width,y,-dx)
enddo
do i=0,6,2
y=yy + height*(0.8+i)/(65.0*0.114286)
write(lab,1020) i
call imstring(lab(4:4),xx-0.15,y-0.08,2,0)
enddo
y=yy + height*(3.8)/(65.0*0.114286)
call imstring("DT", xx-0.5,y ,2,0)
call imstring("(s)",xx-0.5,y-0.25,2,0)
if(iplt.eq.2) call imclose
900 return
end subroutine zplt

1
main.cpp
View File

@ -45,7 +45,6 @@ int main(int argc, char *argv[])
// Override programs executable basename as application name.
a.setApplicationName ("WSJT-X");
a.setApplicationVersion (version ());
bool multiple {false};
#if QT_VERSION >= 0x050200

865
mainwindow.cpp
View File

File diff suppressed because it is too large Load Diff

66
mainwindow.h
View File

@ -31,16 +31,15 @@
#include "Modulator.hpp"
#include "decodedtext.h"
#define NUM_JT4_SYMBOLS 206
#define NUM_JT65_SYMBOLS 126
#define NUM_JT9_SYMBOLS 85
#define NUM_CW_SYMBOLS 250
#define TX_SAMPLE_RATE 48000
extern int volatile itone[NUM_JT65_SYMBOLS]; //Audio tones for all Tx symbols
extern int volatile itone[NUM_JT4_SYMBOLS]; //Audio tones for all Tx symbols
extern int volatile icw[NUM_CW_SYMBOLS]; //Dits for CW ID
//--------------------------------------------------------------- MainWindow
namespace Ui {
class MainWindow;
@ -54,6 +53,7 @@ class WideGraph;
class LogQSO;
class Transceiver;
class Astro;
class MessageAveraging;
class MessageClient;
class QTime;
@ -85,6 +85,8 @@ public slots:
void jt9_error(QProcess::ProcessError);
void setXIT(int n);
void setFreq4(int rxFreq, int txFreq);
void clrAvg();
void msgAvgDecode2();
protected:
virtual void keyPressEvent( QKeyEvent *e );
@ -137,6 +139,7 @@ private slots:
void on_actionJT9_1_triggered();
void on_actionJT65_triggered();
void on_actionJT9_JT65_triggered();
void on_actionJT4_triggered();
void on_TxFreqSpinBox_valueChanged(int arg1);
void on_actionSave_decoded_triggered();
void on_actionQuickDecode_triggered();
@ -182,32 +185,48 @@ private slots:
void on_actionShort_list_of_add_on_prefixes_and_suffixes_triggered();
void getpfx();
void on_actionJT9W_1_triggered();
void band_changed (Frequency);
void monitor (bool);
void stop_tuning ();
void auto_tx_mode (bool);
void on_actionMessage_averaging_triggered();
void on_sbTol_valueChanged(int i);
void on_actionInclude_averaging_triggered();
void on_actionInclude_correlation_triggered();
void on_sbDT_valueChanged(double x);
void VHF_controls_visible(bool b);
void VHF_features_enabled(bool b);
void on_cbEME_toggled(bool b);
void on_sbMinW_valueChanged(int n);
void on_sbSubmode_valueChanged(int n);
void on_cbShMsgs_toggled(bool b);
void on_cbTx6_toggled(bool b);
void networkError (QString const&);
void on_ClrAvgButton_clicked();
private:
void enable_DXCC_entity (bool on);
Q_SIGNAL void initializeAudioOutputStream (QAudioDeviceInfo, unsigned channels, unsigned msBuffered) const;
Q_SIGNAL void initializeAudioOutputStream (QAudioDeviceInfo,
unsigned channels, unsigned msBuffered) const;
Q_SIGNAL void stopAudioOutputStream () const;
Q_SIGNAL void startAudioInputStream (QAudioDeviceInfo const&, int framesPerBuffer, AudioDevice * sink, unsigned downSampleFactor, AudioDevice::Channel) const;
Q_SIGNAL void startAudioInputStream (QAudioDeviceInfo const&,
int framesPerBuffer, AudioDevice * sink,
unsigned downSampleFactor, AudioDevice::Channel) const;
Q_SIGNAL void suspendAudioInputStream () const;
Q_SIGNAL void resumeAudioInputStream () const;
Q_SIGNAL void startDetector (AudioDevice::Channel) const;
Q_SIGNAL void detectorClose () const;
Q_SIGNAL void finished () const;
Q_SIGNAL void transmitFrequency (unsigned) const;
Q_SIGNAL void endTransmitMessage (bool quick = false) const;
Q_SIGNAL void tune (bool = true) const;
Q_SIGNAL void sendMessage (unsigned symbolsLength, double framesPerSymbol, unsigned frequency, double toneSpacing, SoundOutput *, AudioDevice::Channel = AudioDevice::Mono, bool synchronize = true, double dBSNR = 99.) const;
Q_SIGNAL void sendMessage (unsigned symbolsLength, double framesPerSymbol,
unsigned frequency, double toneSpacing,
SoundOutput *, AudioDevice::Channel = AudioDevice::Mono,
bool synchronize = true, double dBSNR = 99.) const;
Q_SIGNAL void outAttenuationChanged (qreal) const;
Q_SIGNAL void toggleShorthand () const;
private:
QDir m_dataDir;
@ -227,6 +246,7 @@ private:
QScopedPointer<QTextEdit> m_shortcuts;
QScopedPointer<QTextEdit> m_prefixes;
QScopedPointer<QTextEdit> m_mouseCmnds;
QScopedPointer<MessageAveraging> m_msgAvgWidget;
Frequency m_dialFreq;
@ -238,6 +258,11 @@ private:
qint64 m_msErase;
qint64 m_secBandChanged;
qint64 m_freqMoon;
qint64 m_freqNominal;
qint64 m_dialFreqTx;
float m_DTtol;
qint32 m_waterfallAvg;
qint32 m_ntx;
@ -255,12 +280,17 @@ private:
qint32 m_hsymStop;
qint32 m_len1;
qint32 m_inGain;
qint32 m_nsave;
qint32 m_ncw;
qint32 m_secID;
qint32 m_repeatMsg;
qint32 m_watchdogLimit;
qint32 m_astroFont;
qint32 m_nSubMode;
qint32 m_MinW;
qint32 m_tol;
qint32 m_nclearave;
qint32 m_DopplerMethod;
qint32 m_DopplerMethod0;
bool m_btxok; //True if OK to transmit
bool m_diskData;
@ -304,6 +334,10 @@ private:
bool m_CATerror;
bool m_plus2kHz;
bool m_bAstroData;
bool m_bEME;
bool m_bShMsgs;
bool m_bDopplerTracking;
bool m_bDopplerTracking0;
float m_pctZap;
@ -354,7 +388,7 @@ private:
QString m_cmnd;
QString m_msgSent0;
QString m_fileToSave;
QString m_band;
QString m_band;
QStringList m_prefix;
QStringList m_suffix;
@ -363,7 +397,6 @@ private:
QHash<QString,bool> m_sfx;
QDateTime m_dateTimeQSO;
QRect m_astroGeom;
QSharedMemory *mem_jt9;
SignalMeter *signalMeter;
@ -423,10 +456,13 @@ extern int ptt(int nport, int ntx, int* iptt, int* nopen);
extern "C" {
//----------------------------------------------------- C and Fortran routines
void symspec_(int* k, int* ntrperiod, int* nsps, int* ingain, int* nflatten,
void symspec_(int* k, int* ntrperiod, int* nsps, int* ingain,
float* px, float s[], float* df3, int* nhsym, int* npts8);
void genjt9_(char* msg, int* ichk, char* msgsent, int itone[],
void gen4_(char* msg, int* ichk, char* msgsent, int itone[],
int* itext, int len1, int len2);
void gen9_(char* msg, int* ichk, char* msgsent, int itone[],
int* itext, int len1, int len2);
void gen65_(char* msg, int* ichk, char* msgsent, int itone[],

4397
mainwindow.ui
View File

File diff suppressed because it is too large Load Diff

44
messageaveraging.cpp Normal file
View File

@ -0,0 +1,44 @@
#include <QSettings>
#include "messageaveraging.h"
#include "ui_messageaveraging.h"
#include "commons.h"
MessageAveraging::MessageAveraging(QSettings * settings, QWidget *parent) :
QWidget(parent),
settings_ {settings},
ui(new Ui::MessageAveraging)
{
ui->setupUi(this);
read_settings ();
}
MessageAveraging::~MessageAveraging()
{
if (isVisible ()) write_settings ();
delete ui;
}
void MessageAveraging::closeEvent (QCloseEvent * e)
{
write_settings ();
QWidget::closeEvent (e);
}
void MessageAveraging::read_settings ()
{
settings_->beginGroup ("MessageAveraging");
move (settings_->value ("window/pos", pos ()).toPoint ());
settings_->endGroup ();
}
void MessageAveraging::write_settings ()
{
settings_->beginGroup ("MessageAveraging");
settings_->setValue ("window/pos", pos ());
settings_->endGroup ();
}
void MessageAveraging::displayAvg(QString t)
{
ui->msgAvgTextBrowser->setText(t);
}

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