w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2026-06-29 23:13:24 -04:00
Code Issues Packages Projects Releases Wiki Activity

Set properties for native eol style and the "Rev" keyword.

Browse Source 
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/map65@2464 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
2012-05-22 17:09:48 +00:00
parent 29c0fd1ddb
commit c4a1997191
122 changed files with 13394 additions and 13394 deletions
Download Patch File Download Diff File Expand all files Collapse all files
about.cpp
+23 -23
View File
@@ -1,23 +1,23 @@
#include "about.h"
#include "ui_about.h"
CAboutDlg::CAboutDlg(QWidget *parent, QString Revision) :
QDialog(parent),
m_Revision(Revision),
ui(new Ui::CAboutDlg)
{
ui->setupUi(this);
ui->labelTxt->clear();
m_Str = "<html><h2>" + m_Revision + "</h2>\n\n";
m_Str += "MAP65 implements a wideband polarization-matching receiver <br>";
m_Str += "for the JT65 protocol, with a matching transmitting facility. <br>";
m_Str += "It is primarily intended for amateur radio EME communication. <br><br>";
m_Str += "Copyright 2001-2012 by Joe Taylor, K1JT. Additional <br>";
m_Str += "acknowledgments are contained in the source code. <br>";
ui->labelTxt->setText(m_Str);
}
CAboutDlg::~CAboutDlg()
{
delete ui;
}
#include "about.h"
#include "ui_about.h"
CAboutDlg::CAboutDlg(QWidget *parent, QString Revision) :
QDialog(parent),
m_Revision(Revision),
ui(new Ui::CAboutDlg)
{
ui->setupUi(this);
ui->labelTxt->clear();
m_Str = "<html><h2>" + m_Revision + "</h2>\n\n";
m_Str += "MAP65 implements a wideband polarization-matching receiver <br>";
m_Str += "for the JT65 protocol, with a matching transmitting facility. <br>";
m_Str += "It is primarily intended for amateur radio EME communication. <br><br>";
m_Str += "Copyright 2001-2012 by Joe Taylor, K1JT. Additional <br>";
m_Str += "acknowledgments are contained in the source code. <br>";
ui->labelTxt->setText(m_Str);
}
CAboutDlg::~CAboutDlg()
{
delete ui;
}
about.h
+24 -24
View File
@@ -1,24 +1,24 @@
#ifndef ABOUTDLG_H
#define ABOUTDLG_H
#include <QDialog>
namespace Ui {
class CAboutDlg;
}
class CAboutDlg : public QDialog
{
Q_OBJECT
public:
explicit CAboutDlg(QWidget *parent=0, QString Revision="");
~CAboutDlg();
private:
QString m_Revision;
Ui::CAboutDlg *ui;
QString m_Str;
};
#endif // ABOUTDLG_H
#ifndef ABOUTDLG_H
#define ABOUTDLG_H
#include <QDialog>
namespace Ui {
class CAboutDlg;
}
class CAboutDlg : public QDialog
{
Q_OBJECT
public:
explicit CAboutDlg(QWidget *parent=0, QString Revision="");
~CAboutDlg();
private:
QString m_Revision;
Ui::CAboutDlg *ui;
QString m_Str;
};
#endif // ABOUTDLG_H
astro.cpp
+102 -102
View File
@@ -1,102 +1,102 @@
#include "astro.h"
#include "ui_astro.h"
#include <QDebug>
#include <QFile>
#include <QMessageBox>
#include <stdio.h>
#include "commons.h"
Astro::Astro(QWidget *parent) :
QWidget(parent),
ui(new Ui::Astro)
{
ui->setupUi(this);
ui->astroTextBrowser->setStyleSheet(
"QTextBrowser { background-color : cyan; color : black; }");
ui->astroTextBrowser->clear();
}
Astro::~Astro()
{
delete ui;
}
void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq, QString azelDir)
{
static int ntxFreq0=-99;
static bool astroBusy=false;
char cc[300];
double azsun,elsun,azmoon,elmoon,azmoondx,elmoondx;
double ramoon,decmoon,dgrd,poloffset,xnr;
int ntsky,ndop,ndop00;
QString date = t.date().toString("yyyy MMM dd");
QString utc = t.time().toString();
int nyear=t.date().year();
int month=t.date().month();
int nday=t.date().day();
int nhr=t.time().hour();
int nmin=t.time().minute();
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;
if(nfreq<10 or nfreq > 50000) nfreq=144;
if(!astroBusy) {
astroBusy=true;
astrosub_(&nyear, &month, &nday, &uth, &nfreq, mygrid.toAscii(),
hisgrid.toAscii(), &azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &ndop, &ndop00,&ramoon, &decmoon,
&dgrd, &poloffset, &xnr, 6, 6);
astroBusy=false;
}
sprintf(cc,"Az: %6.1f\n"
"El: %6.1f\n"
"Dop: %6d\n"
"DxAz: %6.1f\n"
"DxEl: %6.1f\n"
"DxDop: %6d\n"
"Dec: %6.1f\n"
"SunAz: %6.1f\n"
"SunEl: %6.1f\n"
"Tsky: %6d\n"
"MNR: %6.1f\n"
"Dgrd: %6.1f",
azmoon,elmoon,ndop00,azmoondx,elmoondx,ndop,decmoon,azsun,elsun,
ntsky,xnr,dgrd);
ui->astroTextBrowser->setText(" "+ date + "\nUTC: " + utc + "\n" + cc);
QString fname=azelDir+"/azel.dat";
QFile f(fname);
if(!f.open(QIODevice::WriteOnly | QIODevice::Text)) {
QMessageBox mb;
mb.setText("Cannot open " + fname);
mb.exec();
return;
}
int ndiff=0;
if(ntxFreq != ntxFreq0) ndiff=1;
ntxFreq0=ntxFreq;
QTextStream out(&f);
sprintf(cc,"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Moon\n"
"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Sun\n"
"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Source\n"
"%4d,%6d,Doppler\n"
"%3d,%1d,fQSO\n"
"%3d,%1d,fQSO2\n",
nhr,nmin,isec,azmoon,elmoon,
nhr,nmin,isec,azsun,elsun,
nhr,nmin,isec,0.0,0.0,
nfreq,ndop,
fQSO,nsetftx,
ntxFreq,ndiff);
out << cc;
f.close();
}
void Astro::setFontSize(int n)
{
ui->astroTextBrowser->setFontPointSize(n);
}
#include "astro.h"
#include "ui_astro.h"
#include <QDebug>
#include <QFile>
#include <QMessageBox>
#include <stdio.h>
#include "commons.h"
Astro::Astro(QWidget *parent) :
QWidget(parent),
ui(new Ui::Astro)
{
ui->setupUi(this);
ui->astroTextBrowser->setStyleSheet(
"QTextBrowser { background-color : cyan; color : black; }");
ui->astroTextBrowser->clear();
}
Astro::~Astro()
{
delete ui;
}
void Astro::astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq, QString azelDir)
{
static int ntxFreq0=-99;
static bool astroBusy=false;
char cc[300];
double azsun,elsun,azmoon,elmoon,azmoondx,elmoondx;
double ramoon,decmoon,dgrd,poloffset,xnr;
int ntsky,ndop,ndop00;
QString date = t.date().toString("yyyy MMM dd");
QString utc = t.time().toString();
int nyear=t.date().year();
int month=t.date().month();
int nday=t.date().day();
int nhr=t.time().hour();
int nmin=t.time().minute();
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;
if(nfreq<10 or nfreq > 50000) nfreq=144;
if(!astroBusy) {
astroBusy=true;
astrosub_(&nyear, &month, &nday, &uth, &nfreq, mygrid.toAscii(),
hisgrid.toAscii(), &azsun, &elsun, &azmoon, &elmoon,
&azmoondx, &elmoondx, &ntsky, &ndop, &ndop00,&ramoon, &decmoon,
&dgrd, &poloffset, &xnr, 6, 6);
astroBusy=false;
}
sprintf(cc,"Az: %6.1f\n"
"El: %6.1f\n"
"Dop: %6d\n"
"DxAz: %6.1f\n"
"DxEl: %6.1f\n"
"DxDop: %6d\n"
"Dec: %6.1f\n"
"SunAz: %6.1f\n"
"SunEl: %6.1f\n"
"Tsky: %6d\n"
"MNR: %6.1f\n"
"Dgrd: %6.1f",
azmoon,elmoon,ndop00,azmoondx,elmoondx,ndop,decmoon,azsun,elsun,
ntsky,xnr,dgrd);
ui->astroTextBrowser->setText(" "+ date + "\nUTC: " + utc + "\n" + cc);
QString fname=azelDir+"/azel.dat";
QFile f(fname);
if(!f.open(QIODevice::WriteOnly | QIODevice::Text)) {
QMessageBox mb;
mb.setText("Cannot open " + fname);
mb.exec();
return;
}
int ndiff=0;
if(ntxFreq != ntxFreq0) ndiff=1;
ntxFreq0=ntxFreq;
QTextStream out(&f);
sprintf(cc,"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Moon\n"
"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Sun\n"
"%2.2d:%2.2d:%2.2d,%5.1f,%5.1f,Source\n"
"%4d,%6d,Doppler\n"
"%3d,%1d,fQSO\n"
"%3d,%1d,fQSO2\n",
nhr,nmin,isec,azmoon,elmoon,
nhr,nmin,isec,azsun,elsun,
nhr,nmin,isec,0.0,0.0,
nfreq,ndop,
fQSO,nsetftx,
ntxFreq,ndiff);
out << cc;
f.close();
}
void Astro::setFontSize(int n)
{
ui->astroTextBrowser->setFontPointSize(n);
}
astro.h
+35 -35
View File
@@ -1,35 +1,35 @@
#ifndef ASTRO_H
#define ASTRO_H
#include <QWidget>
#include <QDateTime>
namespace Ui {
class Astro;
}
class Astro : public QWidget
{
Q_OBJECT
public:
explicit Astro(QWidget *parent = 0);
void astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq, QString azelDir);
void setFontSize(int n);
~Astro();
private:
Ui::Astro *ui;
};
extern "C" {
void astrosub_(int* nyear, int* month, int* nday, double* uth, int* nfreq,
const char* mygrid, const char* hisgrid, double* azsun,
double* elsun, double* azmoon, double* elmoon, double* azmoondx,
double* elmoondx, int* ntsky, int* ndop, int* ndop00,
double* ramoon, double* decmoon, double* dgrd, double* poloffset,
double* xnr, int len1, int len2);
}
#endif // ASTRO_H
#ifndef ASTRO_H
#define ASTRO_H
#include <QWidget>
#include <QDateTime>
namespace Ui {
class Astro;
}
class Astro : public QWidget
{
Q_OBJECT
public:
explicit Astro(QWidget *parent = 0);
void astroUpdate(QDateTime t, QString mygrid, QString hisgrid,
int fQSO, int nsetftx, int ntxFreq, QString azelDir);
void setFontSize(int n);
~Astro();
private:
Ui::Astro *ui;
};
extern "C" {
void astrosub_(int* nyear, int* month, int* nday, double* uth, int* nfreq,
const char* mygrid, const char* hisgrid, double* azsun,
double* elsun, double* azmoon, double* elmoon, double* azmoondx,
double* elmoondx, int* ntsky, int* ndop, int* ndop00,
double* ramoon, double* decmoon, double* dgrd, double* poloffset,
double* xnr, int len1, int len2);
}
#endif // ASTRO_H
bandmap.cpp
+89 -89
View File
@@ -1,89 +1,89 @@
#include "bandmap.h"
#include "ui_bandmap.h"
#include <QDebug>
BandMap::BandMap(QWidget *parent) :
QWidget(parent),
ui(new Ui::BandMap)
{
ui->setupUi(this);
ui->bmTextBrowser->setStyleSheet(
"QTextBrowser { background-color : #000066; color : red; }");
m_bandMapText="";
ui->bmTextBrowser->clear();
}
BandMap::~BandMap()
{
delete ui;
}
void BandMap::setText(QString t)
{
m_bandMapText=t;
int w=ui->bmTextBrowser->size().width();
int ncols=1;
if(w>220) ncols=2;
QString s="QTextBrowser{background-color: "+m_colorBackground+"}";
ui->bmTextBrowser->setStyleSheet(s);
QString t0="<html style=\" font-family:'Courier New';"
"font-size:9pt; background-color:#000066\">"
"<table border=0 cellspacing=7><tr><td>\n";
QString tfreq,tspace,tcall;
QString s0,s1,s2,s3,bg;
bg="<span style=color:"+m_colorBackground+";>.</span>";
s0="<span style=color:"+m_color0+";>";
s1="<span style=color:"+m_color1+";>";
s2="<span style=color:"+m_color2+";>";
s3="<span style=color:"+m_color3+";>";
ui->bmTextBrowser->clear();
QStringList lines = t.split( "\n", QString::SkipEmptyParts );
int nrows=(lines.length()+ncols-1)/ncols;
for(int i=0; i<nrows; i++) {
tfreq=lines[i].mid(0,3);
tspace=lines[i].mid(4,1);
if(tspace==" ") tspace=bg;
tcall=lines[i].mid(5,7);
int n=lines[i].mid(13,1).toInt();
if(n==0) t0 += s0;
if(n==1) t0 += s1;
if(n==2) t0 += s2;
if(n>=3) t0 += s3;
t0 += (tfreq + tspace + tcall + "</span><br>\n");
}
if(ncols==2) { //2-column display
t0 += "<td><br><td>\n";
for(int i=nrows; i<lines.length(); i++) {
tfreq=lines[i].mid(0,3);
tspace=lines[i].mid(4,1);
if(tspace==" ") tspace=bg;
tcall=lines[i].mid(5,7);
int n=lines[i].mid(13,1).toInt();
if(n==0) t0 += s0;
if(n==1) t0 += s1;
if(n==2) t0 += s2;
if(n>=3) t0 += s3;
t0 += (tfreq + tspace + tcall + "</span><br>\n");
}
if(2*nrows>lines.length()) t0 += (s0 + "</span><br>\n");
}
ui->bmTextBrowser->setHtml(t0);
}
void BandMap::resizeEvent(QResizeEvent* )
{
setText(m_bandMapText);
}
void BandMap::setColors(QString t)
{
m_colorBackground = "#"+t.mid(0,6);
m_color0 = "#"+t.mid(6,6);
m_color1 = "#"+t.mid(12,6);
m_color2 = "#"+t.mid(18,6);
m_color3 = "#"+t.mid(24,6);
setText(m_bandMapText);
}
#include "bandmap.h"
#include "ui_bandmap.h"
#include <QDebug>
BandMap::BandMap(QWidget *parent) :
QWidget(parent),
ui(new Ui::BandMap)
{
ui->setupUi(this);
ui->bmTextBrowser->setStyleSheet(
"QTextBrowser { background-color : #000066; color : red; }");
m_bandMapText="";
ui->bmTextBrowser->clear();
}
BandMap::~BandMap()
{
delete ui;
}
void BandMap::setText(QString t)
{
m_bandMapText=t;
int w=ui->bmTextBrowser->size().width();
int ncols=1;
if(w>220) ncols=2;
QString s="QTextBrowser{background-color: "+m_colorBackground+"}";
ui->bmTextBrowser->setStyleSheet(s);
QString t0="<html style=\" font-family:'Courier New';"
"font-size:9pt; background-color:#000066\">"
"<table border=0 cellspacing=7><tr><td>\n";
QString tfreq,tspace,tcall;
QString s0,s1,s2,s3,bg;
bg="<span style=color:"+m_colorBackground+";>.</span>";
s0="<span style=color:"+m_color0+";>";
s1="<span style=color:"+m_color1+";>";
s2="<span style=color:"+m_color2+";>";
s3="<span style=color:"+m_color3+";>";
ui->bmTextBrowser->clear();
QStringList lines = t.split( "\n", QString::SkipEmptyParts );
int nrows=(lines.length()+ncols-1)/ncols;
for(int i=0; i<nrows; i++) {
tfreq=lines[i].mid(0,3);
tspace=lines[i].mid(4,1);
if(tspace==" ") tspace=bg;
tcall=lines[i].mid(5,7);
int n=lines[i].mid(13,1).toInt();
if(n==0) t0 += s0;
if(n==1) t0 += s1;
if(n==2) t0 += s2;
if(n>=3) t0 += s3;
t0 += (tfreq + tspace + tcall + "</span><br>\n");
}
if(ncols==2) { //2-column display
t0 += "<td><br><td>\n";
for(int i=nrows; i<lines.length(); i++) {
tfreq=lines[i].mid(0,3);
tspace=lines[i].mid(4,1);
if(tspace==" ") tspace=bg;
tcall=lines[i].mid(5,7);
int n=lines[i].mid(13,1).toInt();
if(n==0) t0 += s0;
if(n==1) t0 += s1;
if(n==2) t0 += s2;
if(n>=3) t0 += s3;
t0 += (tfreq + tspace + tcall + "</span><br>\n");
}
if(2*nrows>lines.length()) t0 += (s0 + "</span><br>\n");
}
ui->bmTextBrowser->setHtml(t0);
}
void BandMap::resizeEvent(QResizeEvent* )
{
setText(m_bandMapText);
}
void BandMap::setColors(QString t)
{
m_colorBackground = "#"+t.mid(0,6);
m_color0 = "#"+t.mid(6,6);
m_color1 = "#"+t.mid(12,6);
m_color2 = "#"+t.mid(18,6);
m_color3 = "#"+t.mid(24,6);
setText(m_bandMapText);
}
bandmap.h
+34 -34
View File
@@ -1,34 +1,34 @@
#ifndef BANDMAP_H
#define BANDMAP_H
#include <QWidget>
namespace Ui {
class BandMap;
}
class BandMap : public QWidget
{
Q_OBJECT
public:
explicit BandMap(QWidget *parent = 0);
void setText(QString t);
void setColors(QString t);
~BandMap();
protected:
void resizeEvent(QResizeEvent* event);
private:
Ui::BandMap *ui;
QString m_bandMapText;
QString m_colorBackground;
QString m_color0;
QString m_color1;
QString m_color2;
QString m_color3;
};
#endif // BANDMAP_H
#ifndef BANDMAP_H
#define BANDMAP_H
#include <QWidget>
namespace Ui {
class BandMap;
}
class BandMap : public QWidget
{
Q_OBJECT
public:
explicit BandMap(QWidget *parent = 0);
void setText(QString t);
void setColors(QString t);
~BandMap();
protected:
void resizeEvent(QResizeEvent* event);
private:
Ui::BandMap *ui;
QString m_bandMapText;
QString m_colorBackground;
QString m_color0;
QString m_color1;
QString m_color2;
QString m_color3;
};
#endif // BANDMAP_H
commons.h
+42 -42
View File
@@ -1,42 +1,42 @@
#ifndef COMMONS_H
#define COMMONS_H
#define NFFT 32768
extern "C" {
extern struct { //This is "common/datcom/..." in Fortran
float d4[4*5760000]; //Raw I/Q data from Linrad
float ss[4*322*NFFT]; //Half-symbol spectra at 0,45,90,135 deg pol
float savg[4*NFFT]; //Avg spectra at 0,45,90,135 deg pol
double fcenter; //Center freq from Linrad (MHz)
int nutc; //UTC as integer, HHMM
int idphi; //Phase correction for Y pol'n, degrees
int mousedf; //User-selected DF
int mousefqso; //User-selected QSO freq (kHz)
int nagain; //1 ==> decode only at fQSO +/- Tol
int ndepth; //How much hinted decoding to do?
int ndiskdat; //1 ==> data read from *.tf2 or *.iq file
int neme; //Hinted decoding tries only for EME calls
int newdat; //1 ==> new data, must do long FFT
int nfa; //Low decode limit (kHz)
int nfb; //High decode limit (kHz)
int nfcal; //Frequency correction, for calibration (Hz)
int nfshift; //Shift of displayed center freq (kHz)
int mcall3; //1 ==> CALL3.TXT has been modified
int ntimeout; //Max for timeouts in Messages and BandMap
int ntol; //+/- decoding range around fQSO (Hz)
int nxant; //1 ==> add 45 deg to measured pol angle
int map65RxLog; //Flags to control log files
int nfsample; //Input sample rate
int nxpol; //1 if using xpol antennas, 0 otherwise
int mode65; //JT65 sub-mode: A=1, B=2, C=4
char mycall[12];
char mygrid[6];
char hiscall[12];
char hisgrid[6];
char datetime[20];
} datcom_;
}
#endif // COMMONS_H
#ifndef COMMONS_H
#define COMMONS_H
#define NFFT 32768
extern "C" {
extern struct { //This is "common/datcom/..." in Fortran
float d4[4*5760000]; //Raw I/Q data from Linrad
float ss[4*322*NFFT]; //Half-symbol spectra at 0,45,90,135 deg pol
float savg[4*NFFT]; //Avg spectra at 0,45,90,135 deg pol
double fcenter; //Center freq from Linrad (MHz)
int nutc; //UTC as integer, HHMM
int idphi; //Phase correction for Y pol'n, degrees
int mousedf; //User-selected DF
int mousefqso; //User-selected QSO freq (kHz)
int nagain; //1 ==> decode only at fQSO +/- Tol
int ndepth; //How much hinted decoding to do?
int ndiskdat; //1 ==> data read from *.tf2 or *.iq file
int neme; //Hinted decoding tries only for EME calls
int newdat; //1 ==> new data, must do long FFT
int nfa; //Low decode limit (kHz)
int nfb; //High decode limit (kHz)
int nfcal; //Frequency correction, for calibration (Hz)
int nfshift; //Shift of displayed center freq (kHz)
int mcall3; //1 ==> CALL3.TXT has been modified
int ntimeout; //Max for timeouts in Messages and BandMap
int ntol; //+/- decoding range around fQSO (Hz)
int nxant; //1 ==> add 45 deg to measured pol angle
int map65RxLog; //Flags to control log files
int nfsample; //Input sample rate
int nxpol; //1 if using xpol antennas, 0 otherwise
int mode65; //JT65 sub-mode: A=1, B=2, C=4
char mycall[12];
char mygrid[6];
char hiscall[12];
char hisgrid[6];
char datetime[20];
} datcom_;
}
#endif // COMMONS_H
devsetup.cpp
+325 -325
View File
@@ -1,325 +1,325 @@
#include "devsetup.h"
#include "mainwindow.h"
#include <QDebug>
#include <portaudio.h>
#define MAXDEVICES 100
//----------------------------------------------------------- DevSetup()
DevSetup::DevSetup(QWidget *parent) : QDialog(parent)
{
ui.setupUi(this); //setup the dialog form
m_restartSoundIn=false;
m_restartSoundOut=false;
}
DevSetup::~DevSetup()
{
}
void DevSetup::initDlg()
{
int k,id;
int valid_devices=0;
int minChan[MAXDEVICES];
int maxChan[MAXDEVICES];
int minSpeed[MAXDEVICES];
int maxSpeed[MAXDEVICES];
char hostAPI_DeviceName[MAXDEVICES][50];
char s[60];
int numDevices=Pa_GetDeviceCount();
getDev(&numDevices,hostAPI_DeviceName,minChan,maxChan,minSpeed,maxSpeed);
k=0;
for(id=0; id<numDevices; id++) {
if(96000 >= minSpeed[id] && 96000 <= maxSpeed[id]) {
m_inDevList[k]=id;
k++;
sprintf(s,"%2d %d %-49s",id,maxChan[id],hostAPI_DeviceName[id]);
QString t(s);
ui.comboBoxSndIn->addItem(t);
valid_devices++;
}
}
const PaDeviceInfo *pdi;
int nchout;
char *p,*p1;
char p2[50];
char pa_device_name[128];
char pa_device_hostapi[128];
k=0;
for(id=0; id<numDevices; id++ ) {
pdi=Pa_GetDeviceInfo(id);
nchout=pdi->maxOutputChannels;
if(nchout>=2) {
m_outDevList[k]=id;
k++;
sprintf((char*)(pa_device_name),"%s",pdi->name);
sprintf((char*)(pa_device_hostapi),"%s",
Pa_GetHostApiInfo(pdi->hostApi)->name);
p1=(char*)"";
p=strstr(pa_device_hostapi,"MME");
if(p!=NULL) p1=(char*)"MME";
p=strstr(pa_device_hostapi,"Direct");
if(p!=NULL) p1=(char*)"DirectX";
p=strstr(pa_device_hostapi,"WASAPI");
if(p!=NULL) p1=(char*)"WASAPI";
p=strstr(pa_device_hostapi,"ASIO");
if(p!=NULL) p1=(char*)"ASIO";
p=strstr(pa_device_hostapi,"WDM-KS");
if(p!=NULL) p1=(char*)"WDM-KS";
sprintf(p2,"%2d %-8s %-39s",id,p1,pa_device_name);
QString t(p2);
ui.comboBoxSndOut->addItem(t);
}
}
ui.myCallEntry->setText(m_myCall);
ui.myGridEntry->setText(m_myGrid);
ui.idIntSpinBox->setValue(m_idInt);
ui.pttComboBox->setCurrentIndex(m_pttPort);
ui.astroFont->setValue(m_astroFont);
ui.cbXpol->setChecked(m_xpol);
ui.rbAntennaX->setChecked(m_xpolx);
ui.saveDirEntry->setText(m_saveDir);
ui.azelDirEntry->setText(m_azelDir);
ui.dxccEntry->setText(m_dxccPfx);
ui.timeoutSpinBox->setValue(m_timeout);
ui.dPhiSpinBox->setValue(m_dPhi);
ui.fCalSpinBox->setValue(m_fCal);
ui.faddEntry->setText(QString::number(m_fAdd,'f',3));
ui.networkRadioButton->setChecked(m_network);
ui.soundCardRadioButton->setChecked(!m_network);
ui.rb96000->setChecked(m_fs96000);
ui.rb95238->setChecked(!m_fs96000);
ui.comboBoxSndIn->setEnabled(!m_network);
ui.comboBoxSndIn->setCurrentIndex(m_nDevIn);
ui.comboBoxSndOut->setCurrentIndex(m_nDevOut);
ui.sbPort->setValue(m_udpPort);
ui.cbIQswap->setChecked(m_IQswap);
ui.cb10db->setChecked(m_10db);
ui.cbInitIQplus->setChecked(m_initIQplus);
ui.mult570SpinBox->setValue(m_mult570);
ui.cal570SpinBox->setValue(m_cal570);
sscanf(m_colors.toAscii(),"%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x",
&r,&g,&b,&r0,&g0,&b0,&r1,&g1,&b1,&r2,&g2,&b2,&r3,&g3,&b3);
updateColorLabels();
ui.sbBackgroundRed->setValue(r);
ui.sbBackgroundGreen->setValue(g);
ui.sbBackgroundBlue->setValue(b);
ui.sbRed0->setValue(r0);
ui.sbRed1->setValue(r1);
ui.sbRed2->setValue(r2);
ui.sbRed3->setValue(r3);
ui.sbGreen0->setValue(g0);
ui.sbGreen1->setValue(g1);
ui.sbGreen2->setValue(g2);
ui.sbGreen3->setValue(g3);
ui.sbBlue0->setValue(b0);
ui.sbBlue1->setValue(b1);
ui.sbBlue2->setValue(b2);
ui.sbBlue3->setValue(b3);
m_paInDevice=m_inDevList[m_nDevIn];
m_paOutDevice=m_outDevList[m_nDevOut];
}
//------------------------------------------------------- accept()
void DevSetup::accept()
{
// Called when OK button is clicked.
// Check to see whether SoundInThread must be restarted,
// and save user parameters.
if(m_network!=ui.networkRadioButton->isChecked() or
m_nDevIn!=ui.comboBoxSndIn->currentIndex() or
m_paInDevice!=m_inDevList[m_nDevIn] or
m_xpol!=ui.cbXpol->isChecked() or
m_udpPort!=ui.sbPort->value()) m_restartSoundIn=true;
if(m_nDevOut!=ui.comboBoxSndOut->currentIndex() or
m_paOutDevice!=m_outDevList[m_nDevOut]) m_restartSoundOut=true;
m_myCall=ui.myCallEntry->text();
m_myGrid=ui.myGridEntry->text();
m_idInt=ui.idIntSpinBox->value();
m_pttPort=ui.pttComboBox->currentIndex();
m_astroFont=ui.astroFont->value();
m_xpol=ui.cbXpol->isChecked();
m_xpolx=ui.rbAntennaX->isChecked();
m_saveDir=ui.saveDirEntry->text();
m_azelDir=ui.azelDirEntry->text();
m_dxccPfx=ui.dxccEntry->text();
m_timeout=ui.timeoutSpinBox->value();
m_dPhi=ui.dPhiSpinBox->value();
m_fCal=ui.fCalSpinBox->value();
m_fAdd=ui.faddEntry->text().toDouble();
m_network=ui.networkRadioButton->isChecked();
m_fs96000=ui.rb96000->isChecked();
m_nDevIn=ui.comboBoxSndIn->currentIndex();
m_paInDevice=m_inDevList[m_nDevIn];
m_nDevOut=ui.comboBoxSndOut->currentIndex();
m_paOutDevice=m_outDevList[m_nDevOut];
m_udpPort=ui.sbPort->value();
m_IQswap=ui.cbIQswap->isChecked();
m_10db=ui.cb10db->isChecked();
m_initIQplus=ui.cbInitIQplus->isChecked();
m_mult570=ui.mult570SpinBox->value();
m_cal570=ui.cal570SpinBox->value();
QDialog::accept();
}
void DevSetup::on_soundCardRadioButton_toggled(bool checked)
{
ui.comboBoxSndIn->setEnabled(ui.soundCardRadioButton->isChecked());
ui.rb96000->setChecked(checked);
ui.rb95238->setEnabled(!checked);
ui.label_InputDev->setEnabled(checked);
ui.label_Port->setEnabled(!checked);
ui.sbPort->setEnabled(!checked);
ui.cbIQswap->setEnabled(checked);
ui.cb10db->setEnabled(checked);
}
void DevSetup::on_cbXpol_stateChanged(int n)
{
m_xpol = (n!=0);
ui.rbAntenna->setEnabled(m_xpol);
ui.rbAntennaX->setEnabled(m_xpol);
ui.dPhiSpinBox->setEnabled(m_xpol);
ui.labelDphi->setEnabled(m_xpol);
}
void DevSetup::on_cal570SpinBox_valueChanged(double ppm)
{
m_cal570=ppm;
}
void DevSetup::on_mult570SpinBox_valueChanged(int mult)
{
m_mult570=mult;
}
void DevSetup::updateColorLabels()
{
QString t;
int r=ui.sbBackgroundRed->value();
int g=ui.sbBackgroundGreen->value();
int b=ui.sbBackgroundBlue->value();
int r0=ui.sbRed0->value();
int r1=ui.sbRed1->value();
int r2=ui.sbRed2->value();
int r3=ui.sbRed3->value();
int g0=ui.sbGreen0->value();
int g1=ui.sbGreen1->value();
int g2=ui.sbGreen2->value();
int g3=ui.sbGreen3->value();
int b0=ui.sbBlue0->value();
int b1=ui.sbBlue1->value();
int b2=ui.sbBlue2->value();
int b3=ui.sbBlue3->value();
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r0,g0,b0);
ui.lab0->setStyleSheet(t);
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r1,g1,b1);
ui.lab1->setStyleSheet(t);
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r2,g2,b2);
ui.lab2->setStyleSheet(t);
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r3,g3,b3);
ui.lab3->setStyleSheet(t);
m_colors.sprintf("%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x"
"%2.2x%2.2x%2.2x",r,g,b,r0,g0,b0,r1,g1,b1,r2,g2,b2,r3,g3,b3);
}
void DevSetup::on_sbBackgroundRed_valueChanged(int r)
{
updateColorLabels();
}
void DevSetup::on_sbBackgroundGreen_valueChanged(int g)
{
updateColorLabels();
}
void DevSetup::on_sbBackgroundBlue_valueChanged(int b)
{
updateColorLabels();
}
void DevSetup::on_sbRed0_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen0_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue0_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbRed1_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen1_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue1_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbRed2_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen2_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue2_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbRed3_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen3_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue3_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_pushButton_5_clicked()
{
QColor color = QColorDialog::getColor(Qt::green, this);
if (color.isValid()) {
}
}
#include "devsetup.h"
#include "mainwindow.h"
#include <QDebug>
#include <portaudio.h>
#define MAXDEVICES 100
//----------------------------------------------------------- DevSetup()
DevSetup::DevSetup(QWidget *parent) : QDialog(parent)
{
ui.setupUi(this); //setup the dialog form
m_restartSoundIn=false;
m_restartSoundOut=false;
}
DevSetup::~DevSetup()
{
}
void DevSetup::initDlg()
{
int k,id;
int valid_devices=0;
int minChan[MAXDEVICES];
int maxChan[MAXDEVICES];
int minSpeed[MAXDEVICES];
int maxSpeed[MAXDEVICES];
char hostAPI_DeviceName[MAXDEVICES][50];
char s[60];
int numDevices=Pa_GetDeviceCount();
getDev(&numDevices,hostAPI_DeviceName,minChan,maxChan,minSpeed,maxSpeed);
k=0;
for(id=0; id<numDevices; id++) {
if(96000 >= minSpeed[id] && 96000 <= maxSpeed[id]) {
m_inDevList[k]=id;
k++;
sprintf(s,"%2d %d %-49s",id,maxChan[id],hostAPI_DeviceName[id]);
QString t(s);
ui.comboBoxSndIn->addItem(t);
valid_devices++;
}
}
const PaDeviceInfo *pdi;
int nchout;
char *p,*p1;
char p2[50];
char pa_device_name[128];
char pa_device_hostapi[128];
k=0;
for(id=0; id<numDevices; id++ ) {
pdi=Pa_GetDeviceInfo(id);
nchout=pdi->maxOutputChannels;
if(nchout>=2) {
m_outDevList[k]=id;
k++;
sprintf((char*)(pa_device_name),"%s",pdi->name);
sprintf((char*)(pa_device_hostapi),"%s",
Pa_GetHostApiInfo(pdi->hostApi)->name);
p1=(char*)"";
p=strstr(pa_device_hostapi,"MME");
if(p!=NULL) p1=(char*)"MME";
p=strstr(pa_device_hostapi,"Direct");
if(p!=NULL) p1=(char*)"DirectX";
p=strstr(pa_device_hostapi,"WASAPI");
if(p!=NULL) p1=(char*)"WASAPI";
p=strstr(pa_device_hostapi,"ASIO");
if(p!=NULL) p1=(char*)"ASIO";
p=strstr(pa_device_hostapi,"WDM-KS");
if(p!=NULL) p1=(char*)"WDM-KS";
sprintf(p2,"%2d %-8s %-39s",id,p1,pa_device_name);
QString t(p2);
ui.comboBoxSndOut->addItem(t);
}
}
ui.myCallEntry->setText(m_myCall);
ui.myGridEntry->setText(m_myGrid);
ui.idIntSpinBox->setValue(m_idInt);
ui.pttComboBox->setCurrentIndex(m_pttPort);
ui.astroFont->setValue(m_astroFont);
ui.cbXpol->setChecked(m_xpol);
ui.rbAntennaX->setChecked(m_xpolx);
ui.saveDirEntry->setText(m_saveDir);
ui.azelDirEntry->setText(m_azelDir);
ui.dxccEntry->setText(m_dxccPfx);
ui.timeoutSpinBox->setValue(m_timeout);
ui.dPhiSpinBox->setValue(m_dPhi);
ui.fCalSpinBox->setValue(m_fCal);
ui.faddEntry->setText(QString::number(m_fAdd,'f',3));
ui.networkRadioButton->setChecked(m_network);
ui.soundCardRadioButton->setChecked(!m_network);
ui.rb96000->setChecked(m_fs96000);
ui.rb95238->setChecked(!m_fs96000);
ui.comboBoxSndIn->setEnabled(!m_network);
ui.comboBoxSndIn->setCurrentIndex(m_nDevIn);
ui.comboBoxSndOut->setCurrentIndex(m_nDevOut);
ui.sbPort->setValue(m_udpPort);
ui.cbIQswap->setChecked(m_IQswap);
ui.cb10db->setChecked(m_10db);
ui.cbInitIQplus->setChecked(m_initIQplus);
ui.mult570SpinBox->setValue(m_mult570);
ui.cal570SpinBox->setValue(m_cal570);
sscanf(m_colors.toAscii(),"%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x%2x",
&r,&g,&b,&r0,&g0,&b0,&r1,&g1,&b1,&r2,&g2,&b2,&r3,&g3,&b3);
updateColorLabels();
ui.sbBackgroundRed->setValue(r);
ui.sbBackgroundGreen->setValue(g);
ui.sbBackgroundBlue->setValue(b);
ui.sbRed0->setValue(r0);
ui.sbRed1->setValue(r1);
ui.sbRed2->setValue(r2);
ui.sbRed3->setValue(r3);
ui.sbGreen0->setValue(g0);
ui.sbGreen1->setValue(g1);
ui.sbGreen2->setValue(g2);
ui.sbGreen3->setValue(g3);
ui.sbBlue0->setValue(b0);
ui.sbBlue1->setValue(b1);
ui.sbBlue2->setValue(b2);
ui.sbBlue3->setValue(b3);
m_paInDevice=m_inDevList[m_nDevIn];
m_paOutDevice=m_outDevList[m_nDevOut];
}
//------------------------------------------------------- accept()
void DevSetup::accept()
{
// Called when OK button is clicked.
// Check to see whether SoundInThread must be restarted,
// and save user parameters.
if(m_network!=ui.networkRadioButton->isChecked() or
m_nDevIn!=ui.comboBoxSndIn->currentIndex() or
m_paInDevice!=m_inDevList[m_nDevIn] or
m_xpol!=ui.cbXpol->isChecked() or
m_udpPort!=ui.sbPort->value()) m_restartSoundIn=true;
if(m_nDevOut!=ui.comboBoxSndOut->currentIndex() or
m_paOutDevice!=m_outDevList[m_nDevOut]) m_restartSoundOut=true;
m_myCall=ui.myCallEntry->text();
m_myGrid=ui.myGridEntry->text();
m_idInt=ui.idIntSpinBox->value();
m_pttPort=ui.pttComboBox->currentIndex();
m_astroFont=ui.astroFont->value();
m_xpol=ui.cbXpol->isChecked();
m_xpolx=ui.rbAntennaX->isChecked();
m_saveDir=ui.saveDirEntry->text();
m_azelDir=ui.azelDirEntry->text();
m_dxccPfx=ui.dxccEntry->text();
m_timeout=ui.timeoutSpinBox->value();
m_dPhi=ui.dPhiSpinBox->value();
m_fCal=ui.fCalSpinBox->value();
m_fAdd=ui.faddEntry->text().toDouble();
m_network=ui.networkRadioButton->isChecked();
m_fs96000=ui.rb96000->isChecked();
m_nDevIn=ui.comboBoxSndIn->currentIndex();
m_paInDevice=m_inDevList[m_nDevIn];
m_nDevOut=ui.comboBoxSndOut->currentIndex();
m_paOutDevice=m_outDevList[m_nDevOut];
m_udpPort=ui.sbPort->value();
m_IQswap=ui.cbIQswap->isChecked();
m_10db=ui.cb10db->isChecked();
m_initIQplus=ui.cbInitIQplus->isChecked();
m_mult570=ui.mult570SpinBox->value();
m_cal570=ui.cal570SpinBox->value();
QDialog::accept();
}
void DevSetup::on_soundCardRadioButton_toggled(bool checked)
{
ui.comboBoxSndIn->setEnabled(ui.soundCardRadioButton->isChecked());
ui.rb96000->setChecked(checked);
ui.rb95238->setEnabled(!checked);
ui.label_InputDev->setEnabled(checked);
ui.label_Port->setEnabled(!checked);
ui.sbPort->setEnabled(!checked);
ui.cbIQswap->setEnabled(checked);
ui.cb10db->setEnabled(checked);
}
void DevSetup::on_cbXpol_stateChanged(int n)
{
m_xpol = (n!=0);
ui.rbAntenna->setEnabled(m_xpol);
ui.rbAntennaX->setEnabled(m_xpol);
ui.dPhiSpinBox->setEnabled(m_xpol);
ui.labelDphi->setEnabled(m_xpol);
}
void DevSetup::on_cal570SpinBox_valueChanged(double ppm)
{
m_cal570=ppm;
}
void DevSetup::on_mult570SpinBox_valueChanged(int mult)
{
m_mult570=mult;
}
void DevSetup::updateColorLabels()
{
QString t;
int r=ui.sbBackgroundRed->value();
int g=ui.sbBackgroundGreen->value();
int b=ui.sbBackgroundBlue->value();
int r0=ui.sbRed0->value();
int r1=ui.sbRed1->value();
int r2=ui.sbRed2->value();
int r3=ui.sbRed3->value();
int g0=ui.sbGreen0->value();
int g1=ui.sbGreen1->value();
int g2=ui.sbGreen2->value();
int g3=ui.sbGreen3->value();
int b0=ui.sbBlue0->value();
int b1=ui.sbBlue1->value();
int b2=ui.sbBlue2->value();
int b3=ui.sbBlue3->value();
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r0,g0,b0);
ui.lab0->setStyleSheet(t);
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r1,g1,b1);
ui.lab1->setStyleSheet(t);
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r2,g2,b2);
ui.lab2->setStyleSheet(t);
t.sprintf("QLabel{background-color: #%2.2x%2.2x%2.2x;"
"color: #%2.2x%2.2x%2.2x}",r,g,b,r3,g3,b3);
ui.lab3->setStyleSheet(t);
m_colors.sprintf("%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x"
"%2.2x%2.2x%2.2x",r,g,b,r0,g0,b0,r1,g1,b1,r2,g2,b2,r3,g3,b3);
}
void DevSetup::on_sbBackgroundRed_valueChanged(int r)
{
updateColorLabels();
}
void DevSetup::on_sbBackgroundGreen_valueChanged(int g)
{
updateColorLabels();
}
void DevSetup::on_sbBackgroundBlue_valueChanged(int b)
{
updateColorLabels();
}
void DevSetup::on_sbRed0_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen0_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue0_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbRed1_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen1_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue1_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbRed2_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen2_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue2_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbRed3_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbGreen3_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_sbBlue3_valueChanged(int arg1)
{
updateColorLabels();
}
void DevSetup::on_pushButton_5_clicked()
{
QColor color = QColorDialog::getColor(Qt::green, this);
if (color.isValid()) {
}
}
devsetup.h
+83 -83
View File
@@ -1,83 +1,83 @@
#ifndef DEVSETUP_H
#define DEVSETUP_H
#include <QDialog>
#include "ui_devsetup.h"
class DevSetup : public QDialog
{
Q_OBJECT
public:
DevSetup(QWidget *parent=0);
~DevSetup();
void initDlg();
qint32 m_idInt;
qint32 m_pttPort;
qint32 m_nDevIn;
qint32 m_nDevOut;
qint32 m_inDevList[100];
qint32 m_outDevList[100];
qint32 m_paInDevice;
qint32 m_paOutDevice;
qint32 m_timeout;
qint32 m_dPhi;
qint32 m_fCal;
qint32 m_udpPort;
qint32 m_astroFont;
qint32 m_mult570;
double m_fAdd;
double m_cal570;
bool m_xpolx;
bool m_network;
bool m_fs96000;
bool m_xpol;
bool m_IQswap;
bool m_restartSoundIn;
bool m_restartSoundOut;
bool m_10db;
bool m_initIQplus;
QString m_myCall;
QString m_myGrid;
QString m_saveDir;
QString m_azelDir;
QString m_dxccPfx;
QString m_colors;
QColor m_colorBackground;
public slots:
void accept();
private slots:
void on_soundCardRadioButton_toggled(bool checked);
void on_cbXpol_stateChanged(int arg1);
void on_cal570SpinBox_valueChanged(double ppm);
void on_mult570SpinBox_valueChanged(int mult);
void on_sbBackgroundRed_valueChanged(int arg1);
void on_sbBackgroundGreen_valueChanged(int arg1);
void on_sbBackgroundBlue_valueChanged(int arg1);
void updateColorLabels(void);
void on_sbRed0_valueChanged(int arg1);
void on_sbGreen0_valueChanged(int arg1);
void on_sbBlue0_valueChanged(int arg1);
void on_sbRed1_valueChanged(int arg1);
void on_sbGreen1_valueChanged(int arg1);
void on_sbBlue1_valueChanged(int arg1);
void on_sbRed2_valueChanged(int arg1);
void on_sbGreen2_valueChanged(int arg1);
void on_sbBlue2_valueChanged(int arg1);
void on_sbRed3_valueChanged(int arg1);
void on_sbGreen3_valueChanged(int arg1);
void on_sbBlue3_valueChanged(int arg1);
void on_pushButton_5_clicked();
private:
int r,g,b,r0,g0,b0,r1,g1,b1,r2,g2,b2,r3,g3,b3;
Ui::DialogSndCard ui;
};
#endif // DEVSETUP_H
#ifndef DEVSETUP_H
#define DEVSETUP_H
#include <QDialog>
#include "ui_devsetup.h"
class DevSetup : public QDialog
{
Q_OBJECT
public:
DevSetup(QWidget *parent=0);
~DevSetup();
void initDlg();
qint32 m_idInt;
qint32 m_pttPort;
qint32 m_nDevIn;
qint32 m_nDevOut;
qint32 m_inDevList[100];
qint32 m_outDevList[100];
qint32 m_paInDevice;
qint32 m_paOutDevice;
qint32 m_timeout;
qint32 m_dPhi;
qint32 m_fCal;
qint32 m_udpPort;
qint32 m_astroFont;
qint32 m_mult570;
double m_fAdd;
double m_cal570;
bool m_xpolx;
bool m_network;
bool m_fs96000;
bool m_xpol;
bool m_IQswap;
bool m_restartSoundIn;
bool m_restartSoundOut;
bool m_10db;
bool m_initIQplus;
QString m_myCall;
QString m_myGrid;
QString m_saveDir;
QString m_azelDir;
QString m_dxccPfx;
QString m_colors;
QColor m_colorBackground;
public slots:
void accept();
private slots:
void on_soundCardRadioButton_toggled(bool checked);
void on_cbXpol_stateChanged(int arg1);
void on_cal570SpinBox_valueChanged(double ppm);
void on_mult570SpinBox_valueChanged(int mult);
void on_sbBackgroundRed_valueChanged(int arg1);
void on_sbBackgroundGreen_valueChanged(int arg1);
void on_sbBackgroundBlue_valueChanged(int arg1);
void updateColorLabels(void);
void on_sbRed0_valueChanged(int arg1);
void on_sbGreen0_valueChanged(int arg1);
void on_sbBlue0_valueChanged(int arg1);
void on_sbRed1_valueChanged(int arg1);
void on_sbGreen1_valueChanged(int arg1);
void on_sbBlue1_valueChanged(int arg1);
void on_sbRed2_valueChanged(int arg1);
void on_sbGreen2_valueChanged(int arg1);
void on_sbBlue2_valueChanged(int arg1);
void on_sbRed3_valueChanged(int arg1);
void on_sbGreen3_valueChanged(int arg1);
void on_sbBlue3_valueChanged(int arg1);
void on_pushButton_5_clicked();
private:
int r,g,b,r0,g0,b0,r1,g1,b1,r2,g2,b2,r3,g3,b3;
Ui::DialogSndCard ui;
};
#endif // DEVSETUP_H
displaytext.cpp
+15 -15
View File
@@ -1,15 +1,15 @@
#include "displaytext.h"
#include <QDebug>
#include <QMouseEvent>
DisplayText::DisplayText(QWidget *parent) :
QTextBrowser(parent)
{
}
void DisplayText::mouseDoubleClickEvent(QMouseEvent *e)
{
bool ctrl = (e->modifiers() & 0x4000000);
emit(selectCallsign(ctrl));
QTextBrowser::mouseDoubleClickEvent(e);
}
#include "displaytext.h"
#include <QDebug>
#include <QMouseEvent>
DisplayText::DisplayText(QWidget *parent) :
QTextBrowser(parent)
{
}
void DisplayText::mouseDoubleClickEvent(QMouseEvent *e)
{
bool ctrl = (e->modifiers() & 0x4000000);
emit(selectCallsign(ctrl));
QTextBrowser::mouseDoubleClickEvent(e);
}
displaytext.h
+22 -22
View File
@@ -1,22 +1,22 @@
#ifndef DISPLAYTEXT_H
#define DISPLAYTEXT_H
#include <QTextBrowser>
class DisplayText : public QTextBrowser
{
Q_OBJECT
public:
explicit DisplayText(QWidget *parent = 0);
signals:
void selectCallsign(bool ctrl);
public slots:
protected:
void mouseDoubleClickEvent(QMouseEvent *e);
};
#endif // DISPLAYTEXT_H
#ifndef DISPLAYTEXT_H
#define DISPLAYTEXT_H
#include <QTextBrowser>
class DisplayText : public QTextBrowser
{
Q_OBJECT
public:
explicit DisplayText(QWidget *parent = 0);
signals:
void selectCallsign(bool ctrl);
public slots:
protected:
void mouseDoubleClickEvent(QMouseEvent *e);
};
#endif // DISPLAYTEXT_H
ffft.f
+69 -69
View File
@@ -1,69 +1,69 @@
subroutine ffft(d,npts,isign,ireal)
C Fourier transform of length npts=2**k, performed in place.
C Input data in array d, treated as complex if ireal=0, and as real if ireal=1.
C In either case the transform values are returned in array d, treated as
C complex. The DC term is d(1), and d(npts/2+1) is the term at the Nyquist
C frequency. The basic algorithm is the same as Norm Brenner's FOUR1, and
C uses radix-2 transforms.
C J. H. Taylor, Princeton University.
complex d(npts),t,w,wstep,tt,uu
data pi/3.14159265359/
C Shuffle the data to bit-reversed order.
imax=npts/(ireal+1)
irev=1
do 5 i=1,imax
if(i.ge.irev) go to 2
t=d(i)
d(i)=d(irev)
d(irev)=t
2 mmax=imax/2
3 if(irev.le.mmax) go to 5
irev=irev-mmax
mmax=mmax/2
if(mmax.ge.1) go to 3
5 irev=irev+mmax
C The radix-2 transform begins here.
api=isign*pi/2.
mmax=1
6 istep=2*mmax
wstep=cmplx(-2.*sin(api/mmax)**2,sin(2.*api/mmax))
w=1.
do 9 m=1,mmax
C This in the inner-most loop -- optimization here is important!
do 8 i=m,imax,istep
t=w*d(i+mmax)
d(i+mmax)=d(i)-t
8 d(i)=d(i)+t
9 w=w*(1.+wstep)
mmax=istep
if(mmax.lt.imax) go to 6
if(ireal.eq.0) return
C Now complete the last stage of a doubled-up real transform.
jmax=imax/2 + 1
wstep=cmplx(-2.*sin(isign*pi/npts)**2,sin(isign*pi/imax))
w=1.0
d(imax+1)=d(1)
do 10 j=1,jmax
uu=cmplx(real(d(j))+real(d(2+imax-j)),aimag(d(j)) -
+ aimag(d(2+imax-j)))
tt=w*cmplx(aimag(d(j))+aimag(d(2+imax-j)),-real(d(j)) +
+ real(d(2+imax-j)))
d(j)=uu+tt
d(2+imax-j)=conjg(uu-tt)
10 w=w*(1.+wstep)
return
end
subroutine ffft(d,npts,isign,ireal)
C Fourier transform of length npts=2**k, performed in place.
C Input data in array d, treated as complex if ireal=0, and as real if ireal=1.
C In either case the transform values are returned in array d, treated as
C complex. The DC term is d(1), and d(npts/2+1) is the term at the Nyquist
C frequency. The basic algorithm is the same as Norm Brenner's FOUR1, and
C uses radix-2 transforms.
C J. H. Taylor, Princeton University.
complex d(npts),t,w,wstep,tt,uu
data pi/3.14159265359/
C Shuffle the data to bit-reversed order.
imax=npts/(ireal+1)
irev=1
do 5 i=1,imax
if(i.ge.irev) go to 2
t=d(i)
d(i)=d(irev)
d(irev)=t
2 mmax=imax/2
3 if(irev.le.mmax) go to 5
irev=irev-mmax
mmax=mmax/2
if(mmax.ge.1) go to 3
5 irev=irev+mmax
C The radix-2 transform begins here.
api=isign*pi/2.
mmax=1
6 istep=2*mmax
wstep=cmplx(-2.*sin(api/mmax)**2,sin(2.*api/mmax))
w=1.
do 9 m=1,mmax
C This in the inner-most loop -- optimization here is important!
do 8 i=m,imax,istep
t=w*d(i+mmax)
d(i+mmax)=d(i)-t
8 d(i)=d(i)+t
9 w=w*(1.+wstep)
mmax=istep
if(mmax.lt.imax) go to 6
if(ireal.eq.0) return
C Now complete the last stage of a doubled-up real transform.
jmax=imax/2 + 1
wstep=cmplx(-2.*sin(isign*pi/npts)**2,sin(isign*pi/imax))
w=1.0
d(imax+1)=d(1)
do 10 j=1,jmax
uu=cmplx(real(d(j))+real(d(2+imax-j)),aimag(d(j)) -
+ aimag(d(2+imax-j)))
tt=w*cmplx(aimag(d(j))+aimag(d(2+imax-j)),-real(d(j)) +
+ real(d(2+imax-j)))
d(j)=uu+tt
d(2+imax-j)=conjg(uu-tt)
10 w=w*(1.+wstep)
return
end
fftw3.f
+64 -64
View File
@@ -1,64 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)
getdev.cpp
+259 -259
View File
@@ -1,259 +1,259 @@
#include <stdio.h>
#define MAXDEVICES 100
#include <string.h>
#include <portaudio.h>
#include <QDebug>
//------------------------------------------------------- pa_get_device_info
int pa_get_device_info (int n,
void *pa_device_name,
void *pa_device_hostapi,
double *pa_device_max_speed,
double *pa_device_min_speed,
int *pa_device_max_bytes,
int *pa_device_min_bytes,
int *pa_device_max_channels,
int *pa_device_min_channels )
{
(void) n ;
(void) pa_device_name;
(void) pa_device_hostapi;
(void) pa_device_max_speed;
(void) pa_device_min_speed;
(void) pa_device_max_bytes;
(void) pa_device_min_bytes;
(void) pa_device_max_channels;
(void) pa_device_min_channels;
const PaDeviceInfo *deviceInfo;
PaError pa_err;
PaStreamParameters inputParameters;
int i,j, speed_warning;
int minBytes, maxBytes;
double maxStandardSampleRate;
double minStandardSampleRate;
int minInputChannels;
int maxInputChannels;
// negative terminated list
static double standardSampleRates[] = {8000.0, 9600.0,
11025.0, 12000.0, 16000.0, 22050.0, 24000.0, 32000.0,
44100.0, 48000.0, 88200.0, 96000.0, 192000.0, -1};
// *******************************************************
*pa_device_max_speed=0;
*pa_device_min_speed=0;
*pa_device_max_bytes=0;
*pa_device_min_bytes=0;
*pa_device_max_channels=0;
*pa_device_min_channels=0;
minInputChannels=0;
if(n >= Pa_GetDeviceCount() ) return -1;
deviceInfo = Pa_GetDeviceInfo(n);
if (deviceInfo->maxInputChannels==0) return -1;
sprintf((char*)(pa_device_name),"%s",deviceInfo->name);
sprintf((char*)(pa_device_hostapi),"%s",
Pa_GetHostApiInfo( deviceInfo->hostApi )->name);
speed_warning=0;
// bypass bug in Juli@ ASIO driver:
// this driver hangs after a Pa_IsFormatSupported call
i = strncmp(deviceInfo->name, "ASIO 2.0 - ESI Juli@", 19);
if (i == 0) {
minStandardSampleRate=44100;
maxStandardSampleRate=192000;
minBytes=1;
maxBytes=4;
maxInputChannels= deviceInfo->maxInputChannels;
minInputChannels= 1;
goto end_pa_get_device_info;
}
// Investigate device capabilities.
// Check min and max samplerates with 16 bit data.
maxStandardSampleRate=0;
minStandardSampleRate=0;
inputParameters.device = n;
inputParameters.channelCount = deviceInfo->maxInputChannels;
inputParameters.sampleFormat = paInt16;
inputParameters.suggestedLatency = 0;
inputParameters.hostApiSpecificStreamInfo = NULL;
// ************************************************************************
//filter for portaudio Windows hostapi's with non experts.
//only allow ASIO or WASAPI or WDM-KS
i = strncmp(Pa_GetHostApiInfo(deviceInfo->hostApi)->name, "ASIO", 4);
if (i==0 ) goto end_filter_hostapi;
i = strncmp(Pa_GetHostApiInfo(deviceInfo->hostApi)->name,
"Windows WASAPI", 14);
if (i==0 ) goto end_filter_hostapi;
i = strncmp(Pa_GetHostApiInfo(deviceInfo->hostApi)->name,
"Windows WDM-KS", 14);
if (i==0 ) goto end_filter_hostapi;
speed_warning=1;
end_filter_hostapi:;
// ************************************************************************
i=0;
while(standardSampleRates[i] > 0 && minStandardSampleRate==0) {
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
standardSampleRates[i] );
if(pa_err == paDeviceUnavailable) return -1;
if(pa_err == paInvalidDevice) return -1;
if(pa_err == paFormatIsSupported ) {
minStandardSampleRate=standardSampleRates[i];
}
i++;
}
if(minStandardSampleRate == 0) return -1;
j=i;
while(standardSampleRates[i] > 0 ) i++;
i--;
while(i >= j && maxStandardSampleRate==0) {
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
standardSampleRates[i] );
if(pa_err == paDeviceUnavailable) return -1;
if(pa_err == paInvalidDevice) return -1;
if( pa_err == paFormatIsSupported ) {
maxStandardSampleRate=standardSampleRates[i];
}
i--;
}
// check if min SampleRate = max SampleRate
if(maxStandardSampleRate==0 && (minStandardSampleRate != 0)) {
maxStandardSampleRate= minStandardSampleRate;
}
// check min and max bytes
minBytes=2;
maxBytes=2;
inputParameters.sampleFormat = paUInt8;
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
maxStandardSampleRate );
if( pa_err == paFormatIsSupported ) {
minBytes=1;
}
inputParameters.sampleFormat = paInt32;
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
maxStandardSampleRate );
if( pa_err == paFormatIsSupported ) {
maxBytes=4;
}
// check min channel count
maxInputChannels= deviceInfo->maxInputChannels;
inputParameters.channelCount = 1;
inputParameters.sampleFormat = paInt16;
pa_err=paFormatIsSupported+32000;
while(pa_err != paFormatIsSupported &&
( inputParameters.channelCount < (maxInputChannels+1)) ) {
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
maxStandardSampleRate );
inputParameters.channelCount++;
}
if( pa_err == paFormatIsSupported ) {
minInputChannels=inputParameters.channelCount-1;
} else {
return -1;
}
end_pa_get_device_info:;
*pa_device_max_speed=maxStandardSampleRate;
*pa_device_min_speed=minStandardSampleRate;
*pa_device_max_bytes=maxBytes;
*pa_device_min_bytes=minBytes;
*pa_device_max_channels= maxInputChannels;
*pa_device_min_channels= minInputChannels;
return speed_warning;
}
void paInputDevice(int id, char* hostAPI_DeviceName, int* minChan,
int* maxChan, int* minSpeed, int* maxSpeed)
{
int i;
char pa_device_name[128];
char pa_device_hostapi[128];
double pa_device_max_speed;
double pa_device_min_speed;
int pa_device_max_bytes;
int pa_device_min_bytes;
int pa_device_max_channels;
int pa_device_min_channels;
char p2[50];
char *p,*p1;
static int iret, valid_dev_cnt;
iret=pa_get_device_info (id,
&pa_device_name,
&pa_device_hostapi,
&pa_device_max_speed,
&pa_device_min_speed,
&pa_device_max_bytes,
&pa_device_min_bytes,
&pa_device_max_channels,
&pa_device_min_channels);
if (iret >= 0 ) {
valid_dev_cnt++;
p1=(char*)"";
p=strstr(pa_device_hostapi,"MME");
if(p!=NULL) p1=(char*)"MME";
p=strstr(pa_device_hostapi,"Direct");
if(p!=NULL) p1=(char*)"DirectX";
p=strstr(pa_device_hostapi,"WASAPI");
if(p!=NULL) p1=(char*)"WASAPI";
p=strstr(pa_device_hostapi,"ASIO");
if(p!=NULL) p1=(char*)"ASIO";
p=strstr(pa_device_hostapi,"WDM-KS");
if(p!=NULL) p1=(char*)"WDM-KS";
sprintf(p2,"%-8s %-39s",p1,pa_device_name);
for(i=0; i<50; i++) {
hostAPI_DeviceName[i]=p2[i];
if(p2[i]==0) break;
}
*minChan=pa_device_min_channels;
*maxChan=pa_device_max_channels;
*minSpeed=(int)pa_device_min_speed;
*maxSpeed=(int)pa_device_max_speed;
} else {
for(i=0; i<50; i++) {
hostAPI_DeviceName[i]=0;
}
*minChan=0;
*maxChan=0;
*minSpeed=0;
*maxSpeed=0;
}
}
void getDev(int* numDevices0, char hostAPI_DeviceName[][50],
int minChan[], int maxChan[],
int minSpeed[], int maxSpeed[])
{
int i,id,numDevices;
int minch,maxch,minsp,maxsp;
char apidev[256];
numDevices=Pa_GetDeviceCount();
*numDevices0=numDevices;
for(id=0; id<numDevices; id++) {
paInputDevice(id,apidev,&minch,&maxch,&minsp,&maxsp);
for(i=0; i<50; i++) {
hostAPI_DeviceName[id][i]=apidev[i];
}
hostAPI_DeviceName[id][49]=0;
minChan[id]=minch;
maxChan[id]=maxch;
minSpeed[id]=minsp;
maxSpeed[id]=maxsp;
}
}
#include <stdio.h>
#define MAXDEVICES 100
#include <string.h>
#include <portaudio.h>
#include <QDebug>
//------------------------------------------------------- pa_get_device_info
int pa_get_device_info (int n,
void *pa_device_name,
void *pa_device_hostapi,
double *pa_device_max_speed,
double *pa_device_min_speed,
int *pa_device_max_bytes,
int *pa_device_min_bytes,
int *pa_device_max_channels,
int *pa_device_min_channels )
{
(void) n ;
(void) pa_device_name;
(void) pa_device_hostapi;
(void) pa_device_max_speed;
(void) pa_device_min_speed;
(void) pa_device_max_bytes;
(void) pa_device_min_bytes;
(void) pa_device_max_channels;
(void) pa_device_min_channels;
const PaDeviceInfo *deviceInfo;
PaError pa_err;
PaStreamParameters inputParameters;
int i,j, speed_warning;
int minBytes, maxBytes;
double maxStandardSampleRate;
double minStandardSampleRate;
int minInputChannels;
int maxInputChannels;
// negative terminated list
static double standardSampleRates[] = {8000.0, 9600.0,
11025.0, 12000.0, 16000.0, 22050.0, 24000.0, 32000.0,
44100.0, 48000.0, 88200.0, 96000.0, 192000.0, -1};
// *******************************************************
*pa_device_max_speed=0;
*pa_device_min_speed=0;
*pa_device_max_bytes=0;
*pa_device_min_bytes=0;
*pa_device_max_channels=0;
*pa_device_min_channels=0;
minInputChannels=0;
if(n >= Pa_GetDeviceCount() ) return -1;
deviceInfo = Pa_GetDeviceInfo(n);
if (deviceInfo->maxInputChannels==0) return -1;
sprintf((char*)(pa_device_name),"%s",deviceInfo->name);
sprintf((char*)(pa_device_hostapi),"%s",
Pa_GetHostApiInfo( deviceInfo->hostApi )->name);
speed_warning=0;
// bypass bug in Juli@ ASIO driver:
// this driver hangs after a Pa_IsFormatSupported call
i = strncmp(deviceInfo->name, "ASIO 2.0 - ESI Juli@", 19);
if (i == 0) {
minStandardSampleRate=44100;
maxStandardSampleRate=192000;
minBytes=1;
maxBytes=4;
maxInputChannels= deviceInfo->maxInputChannels;
minInputChannels= 1;
goto end_pa_get_device_info;
}
// Investigate device capabilities.
// Check min and max samplerates with 16 bit data.
maxStandardSampleRate=0;
minStandardSampleRate=0;
inputParameters.device = n;
inputParameters.channelCount = deviceInfo->maxInputChannels;
inputParameters.sampleFormat = paInt16;
inputParameters.suggestedLatency = 0;
inputParameters.hostApiSpecificStreamInfo = NULL;
// ************************************************************************
//filter for portaudio Windows hostapi's with non experts.
//only allow ASIO or WASAPI or WDM-KS
i = strncmp(Pa_GetHostApiInfo(deviceInfo->hostApi)->name, "ASIO", 4);
if (i==0 ) goto end_filter_hostapi;
i = strncmp(Pa_GetHostApiInfo(deviceInfo->hostApi)->name,
"Windows WASAPI", 14);
if (i==0 ) goto end_filter_hostapi;
i = strncmp(Pa_GetHostApiInfo(deviceInfo->hostApi)->name,
"Windows WDM-KS", 14);
if (i==0 ) goto end_filter_hostapi;
speed_warning=1;
end_filter_hostapi:;
// ************************************************************************
i=0;
while(standardSampleRates[i] > 0 && minStandardSampleRate==0) {
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
standardSampleRates[i] );
if(pa_err == paDeviceUnavailable) return -1;
if(pa_err == paInvalidDevice) return -1;
if(pa_err == paFormatIsSupported ) {
minStandardSampleRate=standardSampleRates[i];
}
i++;
}
if(minStandardSampleRate == 0) return -1;
j=i;
while(standardSampleRates[i] > 0 ) i++;
i--;
while(i >= j && maxStandardSampleRate==0) {
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
standardSampleRates[i] );
if(pa_err == paDeviceUnavailable) return -1;
if(pa_err == paInvalidDevice) return -1;
if( pa_err == paFormatIsSupported ) {
maxStandardSampleRate=standardSampleRates[i];
}
i--;
}
// check if min SampleRate = max SampleRate
if(maxStandardSampleRate==0 && (minStandardSampleRate != 0)) {
maxStandardSampleRate= minStandardSampleRate;
}
// check min and max bytes
minBytes=2;
maxBytes=2;
inputParameters.sampleFormat = paUInt8;
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
maxStandardSampleRate );
if( pa_err == paFormatIsSupported ) {
minBytes=1;
}
inputParameters.sampleFormat = paInt32;
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
maxStandardSampleRate );
if( pa_err == paFormatIsSupported ) {
maxBytes=4;
}
// check min channel count
maxInputChannels= deviceInfo->maxInputChannels;
inputParameters.channelCount = 1;
inputParameters.sampleFormat = paInt16;
pa_err=paFormatIsSupported+32000;
while(pa_err != paFormatIsSupported &&
( inputParameters.channelCount < (maxInputChannels+1)) ) {
pa_err=Pa_IsFormatSupported(&inputParameters, NULL,
maxStandardSampleRate );
inputParameters.channelCount++;
}
if( pa_err == paFormatIsSupported ) {
minInputChannels=inputParameters.channelCount-1;
} else {
return -1;
}
end_pa_get_device_info:;
*pa_device_max_speed=maxStandardSampleRate;
*pa_device_min_speed=minStandardSampleRate;
*pa_device_max_bytes=maxBytes;
*pa_device_min_bytes=minBytes;
*pa_device_max_channels= maxInputChannels;
*pa_device_min_channels= minInputChannels;
return speed_warning;
}
void paInputDevice(int id, char* hostAPI_DeviceName, int* minChan,
int* maxChan, int* minSpeed, int* maxSpeed)
{
int i;
char pa_device_name[128];
char pa_device_hostapi[128];
double pa_device_max_speed;
double pa_device_min_speed;
int pa_device_max_bytes;
int pa_device_min_bytes;
int pa_device_max_channels;
int pa_device_min_channels;
char p2[50];
char *p,*p1;
static int iret, valid_dev_cnt;
iret=pa_get_device_info (id,
&pa_device_name,
&pa_device_hostapi,
&pa_device_max_speed,
&pa_device_min_speed,
&pa_device_max_bytes,
&pa_device_min_bytes,
&pa_device_max_channels,
&pa_device_min_channels);
if (iret >= 0 ) {
valid_dev_cnt++;
p1=(char*)"";
p=strstr(pa_device_hostapi,"MME");
if(p!=NULL) p1=(char*)"MME";
p=strstr(pa_device_hostapi,"Direct");
if(p!=NULL) p1=(char*)"DirectX";
p=strstr(pa_device_hostapi,"WASAPI");
if(p!=NULL) p1=(char*)"WASAPI";
p=strstr(pa_device_hostapi,"ASIO");
if(p!=NULL) p1=(char*)"ASIO";
p=strstr(pa_device_hostapi,"WDM-KS");
if(p!=NULL) p1=(char*)"WDM-KS";
sprintf(p2,"%-8s %-39s",p1,pa_device_name);
for(i=0; i<50; i++) {
hostAPI_DeviceName[i]=p2[i];
if(p2[i]==0) break;
}
*minChan=pa_device_min_channels;
*maxChan=pa_device_max_channels;
*minSpeed=(int)pa_device_min_speed;
*maxSpeed=(int)pa_device_max_speed;
} else {
for(i=0; i<50; i++) {
hostAPI_DeviceName[i]=0;
}
*minChan=0;
*maxChan=0;
*minSpeed=0;
*maxSpeed=0;
}
}
void getDev(int* numDevices0, char hostAPI_DeviceName[][50],
int minChan[], int maxChan[],
int minSpeed[], int maxSpeed[])
{
int i,id,numDevices;
int minch,maxch,minsp,maxsp;
char apidev[256];
numDevices=Pa_GetDeviceCount();
*numDevices0=numDevices;
for(id=0; id<numDevices; id++) {
paInputDevice(id,apidev,&minch,&maxch,&minsp,&maxsp);
for(i=0; i<50; i++) {
hostAPI_DeviceName[id][i]=apidev[i];
}
hostAPI_DeviceName[id][49]=0;
minChan[id]=minch;
maxChan[id]=maxch;
minSpeed[id]=minsp;
maxSpeed[id]=maxsp;
}
}
getfile.cpp
+105 -105
View File
@@ -1,105 +1,105 @@
#include "getfile.h"
#include <QDir>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
extern qint16 id[4*60*96000];
void getfile(QString fname, bool xpol, int dbDgrd)
{
int npts=2*52*96000;
if(xpol) npts=2*npts;
// Degrade S/N by dbDgrd dB -- for tests only!!
float dgrd=0.0;
if(dbDgrd<0) dgrd = 23.0*sqrt(pow(10.0,-0.1*(double)dbDgrd) - 1.0);
float fac=23.0/sqrt(dgrd*dgrd + 23.0*23.0);
memset(id,0,2*npts);
char name[80];
strcpy(name,fname.toAscii());
FILE* fp=fopen(name,"rb");
if(fp != NULL) {
fread(&datcom_.fcenter,sizeof(datcom_.fcenter),1,fp);
fread(id,2,npts,fp);
int j=0;
if(dbDgrd<0) {
for(int i=0; i<npts; i+=2) {
datcom_.d4[j++]=fac*((float)id[i] + dgrd*gran());
datcom_.d4[j++]=fac*((float)id[i+1] + dgrd*gran());
if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
} else {
for(int i=0; i<npts; i+=2) {
datcom_.d4[j++]=(float)id[i];
datcom_.d4[j++]=(float)id[i+1];
if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
}
fclose(fp);
datcom_.ndiskdat=1;
int nfreq=(int)datcom_.fcenter;
if(nfreq!=144 and nfreq != 432 and nfreq != 1296) datcom_.fcenter=144.125;
int i0=fname.indexOf(".tf2");
if(i0<0) i0=fname.indexOf(".iq");
datcom_.nutc=0;
if(i0>0) datcom_.nutc=100*fname.mid(i0-4,2).toInt() +
fname.mid(i0-2,2).toInt();
}
}
void savetf2(QString fname, bool xpol)
{
int npts=2*52*96000;
if(xpol) npts=2*npts;
qint16* buf=(qint16*)malloc(2*npts);
char name[80];
strcpy(name,fname.toAscii());
FILE* fp=fopen(name,"wb");
if(fp != NULL) {
fwrite(&datcom_.fcenter,sizeof(datcom_.fcenter),1,fp);
int j=0;
for(int i=0; i<npts; i+=2) {
buf[i]=(qint16)datcom_.d4[j++];
buf[i+1]=(qint16)datcom_.d4[j++];
if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
fwrite(buf,2,npts,fp);
fclose(fp);
}
free(buf);
}
//#define MAX_RANDOM 0x7fffffff
/* Generate gaussian random float with mean=0 and std_dev=1 */
float gran()
{
float fac,rsq,v1,v2;
static float gset;
static int iset;
if(iset){
/* Already got one */
iset = 0;
return gset;
}
/* Generate two evenly distributed numbers between -1 and +1
* that are inside the unit circle
*/
do {
v1 = 2.0 * (float)rand() / RAND_MAX - 1;
v2 = 2.0 * (float)rand() / RAND_MAX - 1;
rsq = v1*v1 + v2*v2;
} while(rsq >= 1.0 || rsq == 0.0);
fac = sqrt(-2.0*log(rsq)/rsq);
gset = v1*fac;
iset++;
return v2*fac;
}
#include "getfile.h"
#include <QDir>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
extern qint16 id[4*60*96000];
void getfile(QString fname, bool xpol, int dbDgrd)
{
int npts=2*52*96000;
if(xpol) npts=2*npts;
// Degrade S/N by dbDgrd dB -- for tests only!!
float dgrd=0.0;
if(dbDgrd<0) dgrd = 23.0*sqrt(pow(10.0,-0.1*(double)dbDgrd) - 1.0);
float fac=23.0/sqrt(dgrd*dgrd + 23.0*23.0);
memset(id,0,2*npts);
char name[80];
strcpy(name,fname.toAscii());
FILE* fp=fopen(name,"rb");
if(fp != NULL) {
fread(&datcom_.fcenter,sizeof(datcom_.fcenter),1,fp);
fread(id,2,npts,fp);
int j=0;
if(dbDgrd<0) {
for(int i=0; i<npts; i+=2) {
datcom_.d4[j++]=fac*((float)id[i] + dgrd*gran());
datcom_.d4[j++]=fac*((float)id[i+1] + dgrd*gran());
if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
} else {
for(int i=0; i<npts; i+=2) {
datcom_.d4[j++]=(float)id[i];
datcom_.d4[j++]=(float)id[i+1];
if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
}
fclose(fp);
datcom_.ndiskdat=1;
int nfreq=(int)datcom_.fcenter;
if(nfreq!=144 and nfreq != 432 and nfreq != 1296) datcom_.fcenter=144.125;
int i0=fname.indexOf(".tf2");
if(i0<0) i0=fname.indexOf(".iq");
datcom_.nutc=0;
if(i0>0) datcom_.nutc=100*fname.mid(i0-4,2).toInt() +
fname.mid(i0-2,2).toInt();
}
}
void savetf2(QString fname, bool xpol)
{
int npts=2*52*96000;
if(xpol) npts=2*npts;
qint16* buf=(qint16*)malloc(2*npts);
char name[80];
strcpy(name,fname.toAscii());
FILE* fp=fopen(name,"wb");
if(fp != NULL) {
fwrite(&datcom_.fcenter,sizeof(datcom_.fcenter),1,fp);
int j=0;
for(int i=0; i<npts; i+=2) {
buf[i]=(qint16)datcom_.d4[j++];
buf[i+1]=(qint16)datcom_.d4[j++];
if(!xpol) j+=2; //Skip over d4(3,x) and d4(4,x)
}
fwrite(buf,2,npts,fp);
fclose(fp);
}
free(buf);
}
//#define MAX_RANDOM 0x7fffffff
/* Generate gaussian random float with mean=0 and std_dev=1 */
float gran()
{
float fac,rsq,v1,v2;
static float gset;
static int iset;
if(iset){
/* Already got one */
iset = 0;
return gset;
}
/* Generate two evenly distributed numbers between -1 and +1
* that are inside the unit circle
*/
do {
v1 = 2.0 * (float)rand() / RAND_MAX - 1;
v2 = 2.0 * (float)rand() / RAND_MAX - 1;
rsq = v1*v1 + v2*v2;
} while(rsq >= 1.0 || rsq == 0.0);
fac = sqrt(-2.0*log(rsq)/rsq);
gset = v1*fac;
iset++;
return v2*fac;
}
getfile.h
+12 -12
View File
@@ -1,12 +1,12 @@
#ifndef GETFILE_H
#define GETFILE_H
#include <QString>
#include <QFile>
#include <QDebug>
#include "commons.h"
void getfile(QString fname, bool xpol, int dbDgrd);
void savetf2(QString fname, bool xpol);
float gran();
#endif // GETFILE_H
#ifndef GETFILE_H
#define GETFILE_H
#include <QString>
#include <QFile>
#include <QDebug>
#include "commons.h"
void getfile(QString fname, bool xpol, int dbDgrd);
void savetf2(QString fname, bool xpol);
float gran();
#endif // GETFILE_H
killbyname.cpp
+282 -282
View File
@@ -1,282 +1,282 @@
#include <windows.h>
#include <tlhelp32.h>
#include <iostream>
int killbyname(const char *szToTerminate)
// Created: 6/23/2000 (Ravi Kochhar)
// Last modified: 3/10/2002 (RK)
// Please report any problems or bugs to kochhar@physiology.wisc.edu
// The latest version of this routine can be found at:
// http://www.neurophys.wisc.edu/ravi/software/killproc/
// Terminate the process "szToTerminate" if it is currently running
// This works for Win/95/98/ME and also Win/NT/2000/XP
// The process name is case-insensitive, i.e. "notepad.exe" and "NOTEPAD.EXE"
// will both work (for szToTerminate)
// Return codes are as follows:
// 0 = Process was successfully terminated
// 602 = Unable to terminate process for some other reason
// 603 = Process was not currently running
// 604 = No permission to terminate process
// 605 = Unable to load PSAPI.DLL
// 606 = Unable to identify system type
// 607 = Unsupported OS
// 632 = Invalid process name
// 700 = Unable to get procedure address from PSAPI.DLL
// 701 = Unable to get process list, EnumProcesses failed
// 702 = Unable to load KERNEL32.DLL
// 703 = Unable to get procedure address from KERNEL32.DLL
// 704 = CreateToolhelp32Snapshot failed
{
BOOL bResult,bResultm;
DWORD aiPID[1000],iCb=1000,iNumProc; //,iV2000=0;
DWORD iCbneeded,i,iFound=0;
char szName[MAX_PATH],szToTermUpper[MAX_PATH];
HANDLE hProc,hSnapShot,hSnapShotm;
OSVERSIONINFO osvi;
HINSTANCE hInstLib;
int iLen,iLenP,indx;
HMODULE hMod;
PROCESSENTRY32 procentry;
MODULEENTRY32 modentry;
// Transfer Process name into "szToTermUpper" and convert to upper case
iLenP=strlen(szToTerminate);
if(iLenP<1 || iLenP>MAX_PATH) return 632;
for(indx=0;indx<iLenP;indx++)
szToTermUpper[indx]=toupper(szToTerminate[indx]);
szToTermUpper[iLenP]=0;
// PSAPI Function Pointers.
BOOL (WINAPI *lpfEnumProcesses)( DWORD *, DWORD cb, DWORD * );
BOOL (WINAPI *lpfEnumProcessModules)( HANDLE, HMODULE *,
DWORD, LPDWORD );
DWORD (WINAPI *lpfGetModuleBaseName)( HANDLE, HMODULE,
LPTSTR, DWORD );
// ToolHelp Function Pointers.
HANDLE (WINAPI *lpfCreateToolhelp32Snapshot)(DWORD,DWORD) ;
BOOL (WINAPI *lpfProcess32First)(HANDLE,LPPROCESSENTRY32) ;
BOOL (WINAPI *lpfProcess32Next)(HANDLE,LPPROCESSENTRY32) ;
BOOL (WINAPI *lpfModule32First)(HANDLE,LPMODULEENTRY32) ;
BOOL (WINAPI *lpfModule32Next)(HANDLE,LPMODULEENTRY32) ;
// First check what version of Windows we're in
osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
bResult=GetVersionEx(&osvi);
if(!bResult) return 606; // Unable to identify system version
// At Present we only support Win/NT/2000/XP or Win/9x/ME
// Seems to work OK in Win7
if((osvi.dwPlatformId != VER_PLATFORM_WIN32_NT) &&
(osvi.dwPlatformId != VER_PLATFORM_WIN32_WINDOWS)) return 607;
if(osvi.dwPlatformId==VER_PLATFORM_WIN32_NT)
{
// Win/NT or 2000 or XP
// Load library and get the procedures explicitly. We do
// this so that we don't have to worry about modules using
// this code failing to load under Windows 9x, because
// it can't resolve references to the PSAPI.DLL.
hInstLib = LoadLibraryA("PSAPI.DLL");
if(hInstLib == NULL) return 605;
// Get procedure addresses.
lpfEnumProcesses = (BOOL(WINAPI *)(DWORD *,DWORD,DWORD*))
GetProcAddress( hInstLib, "EnumProcesses" ) ;
lpfEnumProcessModules = (BOOL(WINAPI *)(HANDLE, HMODULE *,
DWORD, LPDWORD)) GetProcAddress( hInstLib, "EnumProcessModules" ) ;
lpfGetModuleBaseName =(DWORD (WINAPI *)(HANDLE, HMODULE, LPTSTR,
DWORD )) GetProcAddress( hInstLib, "GetModuleBaseNameA" ) ;
if(lpfEnumProcesses == NULL || lpfEnumProcessModules == NULL ||
lpfGetModuleBaseName == NULL) {
FreeLibrary(hInstLib);
return 700;
}
bResult=lpfEnumProcesses(aiPID,iCb,&iCbneeded);
if(!bResult) {
// Unable to get process list, EnumProcesses failed
FreeLibrary(hInstLib);
return 701;
}
// How many processes are there?
iNumProc=iCbneeded/sizeof(DWORD);
// Get and match the name of each process
for(i=0;i<iNumProc;i++) {
// Get the (module) name for this process
strcpy(szName,"Unknown");
// First, get a handle to the process
hProc=OpenProcess(PROCESS_QUERY_INFORMATION|PROCESS_VM_READ,FALSE,
aiPID[i]);
// Now, get the process name
if(hProc) {
if(lpfEnumProcessModules(hProc,&hMod,sizeof(hMod),&iCbneeded) ) {
iLen=lpfGetModuleBaseName(hProc,hMod,szName,MAX_PATH);
}
}
CloseHandle(hProc);
// We will match regardless of lower or upper case
if(strcmp(_strupr(szName),szToTermUpper)==0) {
// Process found, now terminate it
iFound=1;
// First open for termination
hProc=OpenProcess(PROCESS_TERMINATE,FALSE,aiPID[i]);
if(hProc) {
if(TerminateProcess(hProc,0)) {
// process terminated
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 0;
} else {
// Unable to terminate process
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 602;
}
} else {
// Unable to open process for termination
FreeLibrary(hInstLib);
return 604;
}
}
}
}
if(osvi.dwPlatformId==VER_PLATFORM_WIN32_WINDOWS)
{
// Win/95 or 98 or ME
hInstLib = LoadLibraryA("Kernel32.DLL");
if( hInstLib == NULL )
return 702;
// Get procedure addresses.
// We are linking to these functions of Kernel32
// explicitly, because otherwise a module using
// this code would fail to load under Windows NT,
// which does not have the Toolhelp32
// functions in the Kernel 32.
lpfCreateToolhelp32Snapshot=
(HANDLE(WINAPI *)(DWORD,DWORD))
GetProcAddress( hInstLib,
"CreateToolhelp32Snapshot" ) ;
lpfProcess32First=
(BOOL(WINAPI *)(HANDLE,LPPROCESSENTRY32))
GetProcAddress( hInstLib, "Process32First" ) ;
lpfProcess32Next=
(BOOL(WINAPI *)(HANDLE,LPPROCESSENTRY32))
GetProcAddress( hInstLib, "Process32Next" ) ;
lpfModule32First=
(BOOL(WINAPI *)(HANDLE,LPMODULEENTRY32))
GetProcAddress( hInstLib, "Module32First" ) ;
lpfModule32Next=
(BOOL(WINAPI *)(HANDLE,LPMODULEENTRY32))
GetProcAddress( hInstLib, "Module32Next" ) ;
if( lpfProcess32Next == NULL ||
lpfProcess32First == NULL ||
lpfModule32Next == NULL ||
lpfModule32First == NULL ||
lpfCreateToolhelp32Snapshot == NULL )
{
FreeLibrary(hInstLib);
return 703;
}
// The Process32.. and Module32.. routines return names in all uppercase
// Get a handle to a Toolhelp snapshot of all the systems processes.
hSnapShot = lpfCreateToolhelp32Snapshot(
TH32CS_SNAPPROCESS, 0 ) ;
if( hSnapShot == INVALID_HANDLE_VALUE )
{
FreeLibrary(hInstLib);
return 704;
}
// Get the first process' information.
procentry.dwSize = sizeof(PROCESSENTRY32);
bResult=lpfProcess32First(hSnapShot,&procentry);
// While there are processes, keep looping and checking.
while(bResult)
{
// Get a handle to a Toolhelp snapshot of this process.
hSnapShotm = lpfCreateToolhelp32Snapshot(
TH32CS_SNAPMODULE, procentry.th32ProcessID) ;
if( hSnapShotm == INVALID_HANDLE_VALUE )
{
CloseHandle(hSnapShot);
FreeLibrary(hInstLib);
return 704;
}
// Get the module list for this process
modentry.dwSize=sizeof(MODULEENTRY32);
bResultm=lpfModule32First(hSnapShotm,&modentry);
// While there are modules, keep looping and checking
while(bResultm)
{
if(strcmp(modentry.szModule,szToTermUpper)==0)
{
// Process found, now terminate it
iFound=1;
// First open for termination
hProc=OpenProcess(PROCESS_TERMINATE,FALSE,procentry.th32ProcessID);
if(hProc)
{
if(TerminateProcess(hProc,0))
{
// process terminated
CloseHandle(hSnapShotm);
CloseHandle(hSnapShot);
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 0;
}
else
{
// Unable to terminate process
CloseHandle(hSnapShotm);
CloseHandle(hSnapShot);
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 602;
}
}
else
{
// Unable to open process for termination
CloseHandle(hSnapShotm);
CloseHandle(hSnapShot);
FreeLibrary(hInstLib);
return 604;
}
}
else
{ // Look for next modules for this process
modentry.dwSize=sizeof(MODULEENTRY32);
bResultm=lpfModule32Next(hSnapShotm,&modentry);
}
}
//Keep looking
CloseHandle(hSnapShotm);
procentry.dwSize = sizeof(PROCESSENTRY32);
bResult = lpfProcess32Next(hSnapShot,&procentry);
}
CloseHandle(hSnapShot);
}
if(iFound==0)
{
FreeLibrary(hInstLib);
return 603;
}
FreeLibrary(hInstLib);
return 0;
}
#include <windows.h>
#include <tlhelp32.h>
#include <iostream>
int killbyname(const char *szToTerminate)
// Created: 6/23/2000 (Ravi Kochhar)
// Last modified: 3/10/2002 (RK)
// Please report any problems or bugs to kochhar@physiology.wisc.edu
// The latest version of this routine can be found at:
// http://www.neurophys.wisc.edu/ravi/software/killproc/
// Terminate the process "szToTerminate" if it is currently running
// This works for Win/95/98/ME and also Win/NT/2000/XP
// The process name is case-insensitive, i.e. "notepad.exe" and "NOTEPAD.EXE"
// will both work (for szToTerminate)
// Return codes are as follows:
// 0 = Process was successfully terminated
// 602 = Unable to terminate process for some other reason
// 603 = Process was not currently running
// 604 = No permission to terminate process
// 605 = Unable to load PSAPI.DLL
// 606 = Unable to identify system type
// 607 = Unsupported OS
// 632 = Invalid process name
// 700 = Unable to get procedure address from PSAPI.DLL
// 701 = Unable to get process list, EnumProcesses failed
// 702 = Unable to load KERNEL32.DLL
// 703 = Unable to get procedure address from KERNEL32.DLL
// 704 = CreateToolhelp32Snapshot failed
{
BOOL bResult,bResultm;
DWORD aiPID[1000],iCb=1000,iNumProc; //,iV2000=0;
DWORD iCbneeded,i,iFound=0;
char szName[MAX_PATH],szToTermUpper[MAX_PATH];
HANDLE hProc,hSnapShot,hSnapShotm;
OSVERSIONINFO osvi;
HINSTANCE hInstLib;
int iLen,iLenP,indx;
HMODULE hMod;
PROCESSENTRY32 procentry;
MODULEENTRY32 modentry;
// Transfer Process name into "szToTermUpper" and convert to upper case
iLenP=strlen(szToTerminate);
if(iLenP<1 || iLenP>MAX_PATH) return 632;
for(indx=0;indx<iLenP;indx++)
szToTermUpper[indx]=toupper(szToTerminate[indx]);
szToTermUpper[iLenP]=0;
// PSAPI Function Pointers.
BOOL (WINAPI *lpfEnumProcesses)( DWORD *, DWORD cb, DWORD * );
BOOL (WINAPI *lpfEnumProcessModules)( HANDLE, HMODULE *,
DWORD, LPDWORD );
DWORD (WINAPI *lpfGetModuleBaseName)( HANDLE, HMODULE,
LPTSTR, DWORD );
// ToolHelp Function Pointers.
HANDLE (WINAPI *lpfCreateToolhelp32Snapshot)(DWORD,DWORD) ;
BOOL (WINAPI *lpfProcess32First)(HANDLE,LPPROCESSENTRY32) ;
BOOL (WINAPI *lpfProcess32Next)(HANDLE,LPPROCESSENTRY32) ;
BOOL (WINAPI *lpfModule32First)(HANDLE,LPMODULEENTRY32) ;
BOOL (WINAPI *lpfModule32Next)(HANDLE,LPMODULEENTRY32) ;
// First check what version of Windows we're in
osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
bResult=GetVersionEx(&osvi);
if(!bResult) return 606; // Unable to identify system version
// At Present we only support Win/NT/2000/XP or Win/9x/ME
// Seems to work OK in Win7
if((osvi.dwPlatformId != VER_PLATFORM_WIN32_NT) &&
(osvi.dwPlatformId != VER_PLATFORM_WIN32_WINDOWS)) return 607;
if(osvi.dwPlatformId==VER_PLATFORM_WIN32_NT)
{
// Win/NT or 2000 or XP
// Load library and get the procedures explicitly. We do
// this so that we don't have to worry about modules using
// this code failing to load under Windows 9x, because
// it can't resolve references to the PSAPI.DLL.
hInstLib = LoadLibraryA("PSAPI.DLL");
if(hInstLib == NULL) return 605;
// Get procedure addresses.
lpfEnumProcesses = (BOOL(WINAPI *)(DWORD *,DWORD,DWORD*))
GetProcAddress( hInstLib, "EnumProcesses" ) ;
lpfEnumProcessModules = (BOOL(WINAPI *)(HANDLE, HMODULE *,
DWORD, LPDWORD)) GetProcAddress( hInstLib, "EnumProcessModules" ) ;
lpfGetModuleBaseName =(DWORD (WINAPI *)(HANDLE, HMODULE, LPTSTR,
DWORD )) GetProcAddress( hInstLib, "GetModuleBaseNameA" ) ;
if(lpfEnumProcesses == NULL || lpfEnumProcessModules == NULL ||
lpfGetModuleBaseName == NULL) {
FreeLibrary(hInstLib);
return 700;
}
bResult=lpfEnumProcesses(aiPID,iCb,&iCbneeded);
if(!bResult) {
// Unable to get process list, EnumProcesses failed
FreeLibrary(hInstLib);
return 701;
}
// How many processes are there?
iNumProc=iCbneeded/sizeof(DWORD);
// Get and match the name of each process
for(i=0;i<iNumProc;i++) {
// Get the (module) name for this process
strcpy(szName,"Unknown");
// First, get a handle to the process
hProc=OpenProcess(PROCESS_QUERY_INFORMATION|PROCESS_VM_READ,FALSE,
aiPID[i]);
// Now, get the process name
if(hProc) {
if(lpfEnumProcessModules(hProc,&hMod,sizeof(hMod),&iCbneeded) ) {
iLen=lpfGetModuleBaseName(hProc,hMod,szName,MAX_PATH);
}
}
CloseHandle(hProc);
// We will match regardless of lower or upper case
if(strcmp(_strupr(szName),szToTermUpper)==0) {
// Process found, now terminate it
iFound=1;
// First open for termination
hProc=OpenProcess(PROCESS_TERMINATE,FALSE,aiPID[i]);
if(hProc) {
if(TerminateProcess(hProc,0)) {
// process terminated
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 0;
} else {
// Unable to terminate process
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 602;
}
} else {
// Unable to open process for termination
FreeLibrary(hInstLib);
return 604;
}
}
}
}
if(osvi.dwPlatformId==VER_PLATFORM_WIN32_WINDOWS)
{
// Win/95 or 98 or ME
hInstLib = LoadLibraryA("Kernel32.DLL");
if( hInstLib == NULL )
return 702;
// Get procedure addresses.
// We are linking to these functions of Kernel32
// explicitly, because otherwise a module using
// this code would fail to load under Windows NT,
// which does not have the Toolhelp32
// functions in the Kernel 32.
lpfCreateToolhelp32Snapshot=
(HANDLE(WINAPI *)(DWORD,DWORD))
GetProcAddress( hInstLib,
"CreateToolhelp32Snapshot" ) ;
lpfProcess32First=
(BOOL(WINAPI *)(HANDLE,LPPROCESSENTRY32))
GetProcAddress( hInstLib, "Process32First" ) ;
lpfProcess32Next=
(BOOL(WINAPI *)(HANDLE,LPPROCESSENTRY32))
GetProcAddress( hInstLib, "Process32Next" ) ;
lpfModule32First=
(BOOL(WINAPI *)(HANDLE,LPMODULEENTRY32))
GetProcAddress( hInstLib, "Module32First" ) ;
lpfModule32Next=
(BOOL(WINAPI *)(HANDLE,LPMODULEENTRY32))
GetProcAddress( hInstLib, "Module32Next" ) ;
if( lpfProcess32Next == NULL ||
lpfProcess32First == NULL ||
lpfModule32Next == NULL ||
lpfModule32First == NULL ||
lpfCreateToolhelp32Snapshot == NULL )
{
FreeLibrary(hInstLib);
return 703;
}
// The Process32.. and Module32.. routines return names in all uppercase
// Get a handle to a Toolhelp snapshot of all the systems processes.
hSnapShot = lpfCreateToolhelp32Snapshot(
TH32CS_SNAPPROCESS, 0 ) ;
if( hSnapShot == INVALID_HANDLE_VALUE )
{
FreeLibrary(hInstLib);
return 704;
}
// Get the first process' information.
procentry.dwSize = sizeof(PROCESSENTRY32);
bResult=lpfProcess32First(hSnapShot,&procentry);
// While there are processes, keep looping and checking.
while(bResult)
{
// Get a handle to a Toolhelp snapshot of this process.
hSnapShotm = lpfCreateToolhelp32Snapshot(
TH32CS_SNAPMODULE, procentry.th32ProcessID) ;
if( hSnapShotm == INVALID_HANDLE_VALUE )
{
CloseHandle(hSnapShot);
FreeLibrary(hInstLib);
return 704;
}
// Get the module list for this process
modentry.dwSize=sizeof(MODULEENTRY32);
bResultm=lpfModule32First(hSnapShotm,&modentry);
// While there are modules, keep looping and checking
while(bResultm)
{
if(strcmp(modentry.szModule,szToTermUpper)==0)
{
// Process found, now terminate it
iFound=1;
// First open for termination
hProc=OpenProcess(PROCESS_TERMINATE,FALSE,procentry.th32ProcessID);
if(hProc)
{
if(TerminateProcess(hProc,0))
{
// process terminated
CloseHandle(hSnapShotm);
CloseHandle(hSnapShot);
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 0;
}
else
{
// Unable to terminate process
CloseHandle(hSnapShotm);
CloseHandle(hSnapShot);
CloseHandle(hProc);
FreeLibrary(hInstLib);
return 602;
}
}
else
{
// Unable to open process for termination
CloseHandle(hSnapShotm);
CloseHandle(hSnapShot);
FreeLibrary(hInstLib);
return 604;
}
}
else
{ // Look for next modules for this process
modentry.dwSize=sizeof(MODULEENTRY32);
bResultm=lpfModule32Next(hSnapShotm,&modentry);
}
}
//Keep looking
CloseHandle(hSnapShotm);
procentry.dwSize = sizeof(PROCESSENTRY32);
bResult = lpfProcess32Next(hSnapShot,&procentry);
}
CloseHandle(hSnapShot);
}
if(iFound==0)
{
FreeLibrary(hInstLib);
return 603;
}
FreeLibrary(hInstLib);
return 0;
}
libm65/JT65code.f90
+47 -47
View File
@@ -1,47 +1,47 @@
program JT65code
! Provides examples of message packing, bit and symbol ordering,
! Reed Solomon encoding, and other necessary details of the JT65
! protocol.
character*22 msg0,msg,decoded,cok*3
integer dgen(12),sent(63),recd(12),era(51)
nargs=iargc()
if(nargs.ne.1) then
print*,'Usage: JT65code "message"'
go to 999
endif
call getarg(1,msg0) !Get message from command line
msg=msg0
call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report
if(nspecial.gt.0) then !or is a shorthand message
write(*,1010)
1010 format('Shorthand message.')
go to 999
endif
call packmsg(msg,dgen) !Pack message into 72 bits
write(*,1020) msg0
1020 format('Message: ',a22) !Echo input message
if(iand(dgen(10),8).ne.0) write(*,1030) !Is plain text bit set?
1030 format('Plain text.')
write(*,1040) dgen
1040 format('Packed message, 6-bit symbols: ',12i3) !Display packed symbols
call rs_encode(dgen,sent) !RS encode
call interleave63(sent,1) !Interleave channel symbols
call graycode(sent,63,1) !Apply Gray code
write(*,1050) sent
1050 format('Channel symbols, including FEC:'/(i5,20i3))
call graycode(sent,63,-1)
call interleave63(sent,-1)
call rs_decode(sent,era,0,recd,nerr)
call unpackmsg(recd,decoded) !Unpack the user message
write(*,1060) decoded,cok
1060 format('Decoded message: ',a22,2x,a3)
999 end program JT65code
program JT65code
! Provides examples of message packing, bit and symbol ordering,
! Reed Solomon encoding, and other necessary details of the JT65
! protocol.
character*22 msg0,msg,decoded,cok*3
integer dgen(12),sent(63),recd(12),era(51)
nargs=iargc()
if(nargs.ne.1) then
print*,'Usage: JT65code "message"'
go to 999
endif
call getarg(1,msg0) !Get message from command line
msg=msg0
call chkmsg(msg,cok,nspecial,flip) !See if it includes "OOO" report
if(nspecial.gt.0) then !or is a shorthand message
write(*,1010)
1010 format('Shorthand message.')
go to 999
endif
call packmsg(msg,dgen) !Pack message into 72 bits
write(*,1020) msg0
1020 format('Message: ',a22) !Echo input message
if(iand(dgen(10),8).ne.0) write(*,1030) !Is plain text bit set?
1030 format('Plain text.')
write(*,1040) dgen
1040 format('Packed message, 6-bit symbols: ',12i3) !Display packed symbols
call rs_encode(dgen,sent) !RS encode
call interleave63(sent,1) !Interleave channel symbols
call graycode(sent,63,1) !Apply Gray code
write(*,1050) sent
1050 format('Channel symbols, including FEC:'/(i5,20i3))
call graycode(sent,63,-1)
call interleave63(sent,-1)
call rs_decode(sent,era,0,recd,nerr)
call unpackmsg(recd,decoded) !Unpack the user message
write(*,1060) decoded,cok
1060 format('Decoded message: ',a22,2x,a3)
999 end program JT65code
libm65/Makefile.MinGW
+92 -92
View File
@@ -1,92 +1,92 @@
# Makefile for MinGW on Windows
CC = gcc
FC = g95
FFLAGS = -O2 -fbounds-check -Wall -Wno-precision-loss -fno-second-underscore
CFLAGS = -I. -fbounds-check
# Default rules
%.o: %.c
${CC} ${CFLAGS} -c $<
%.o: %.f
${FC} ${FFLAGS} -c $<
%.o: %.F
${FC} ${FFLAGS} -c $<
%.o: %.f90
${FC} ${FFLAGS} -c $<
%.o: %.F90
${FC} ${FFLAGS} -c $<
all: libm65.a m65.exe JT65code.exe
OBJS1 = trimlist.o display.o getdphi.o pctile.o ccf65.o \
decode1a.o sort.o filbig.o fil6521.o afc65b.o \
twkfreq.o decode65b.o indexx.o ssort.o fchisq.o setup65.o \
extract.o deep65.o ccf2.o demod64a.o chkhist.o graycode.o \
interleave63.o unpackmsg.o encode65.o igray.o set.o unpackcall.o \
unpackgrid.o grid2k.o unpacktext.o getpfx2.o packmsg.o \
deg2grid.o packtext.o getpfx1.o packcall.o k2grid.o packgrid.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o \
astro.o tm2.o sun.o moondop.o coord.o tmoonsub.o \
geocentric.o moon2.o toxyz.o dot.o dcoord.o f77_wisdom.o \
gen65.o chkmsg.o ptt.o astrosub.o astro0.o recvpkt.o symspec.o \
iqcal.o iqfix.o timf2.o s3avg.o
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o cutil.o
LIBS3 = -L'c:/QtSDK/Desktop/Qt/4.7.4/mingw/lib' -lQtCore4
m65.exe: $(OBJS3) libm65.a
g++ -o m65.exe $(OBJS3) $(LIBS3) libm65.a ../libfftw3f_win.a \
c:/MinGW/lib/libf95.a
cp m65.exe ../../map65_install
OBJS2 = JT65code.o
JT65code.exe: $(OBJS2) libm65.a
$(FC) -o JT65code.exe $(OBJS2) libm65.a
INCPATH = -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/QtCore' \
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include' \
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/ActiveQt' \
-I'release' -I'.' -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/mkspecs/win32-g++'
ipcomm.o: ipcomm.cpp
g++ -c $(INCPATH) ipcomm.cpp
#m65a.o: m65a.f90
# $(FC) -c -fno-second-underscore -cpp m65a.f90
sec_midn.o: sec_midn.f90
$(FC) -c -fno-second-underscore sec_midn.f90
#symspec.o: ../symspec.f90
# $(FC) -c $(FFLAGS) -o symspec.o ../symspec.f90
OBJS4 = tastro.o astro0.o libm65.a
tastro.exe: $(OBJS4)
$(FC) $(FFLAGS) -o tastro.exe $(OBJS4) libm65.a
OBJS5 = t1.o timer.o libm65.a
t1.exe: $(OBJS5)
$(FC) $(FFLAGS) -o t1.exe $(OBJS5) libm65.a
#astro0.o: ../astro0.f90
# $(FC) -c $(FFLAGS) -o astro0.o ../astro0.f90
init_rs.o: init_rs.c
$(CC) -c -DBIGSYM=1 -o init_rs.o init_rs.c
encode_rs.o: encode_rs.c
$(CC) -c -DBIGSYM=1 -o encode_rs.o encode_rs.c
decode_rs.o: decode_rs.c
$(CC) -c -DBIGSYM=1 -o decode_rs.o decode_rs.c
.PHONY : clean
clean:
rm -f *.o libm65.a m65.exe jt65code.exe
# Makefile for MinGW on Windows
CC = gcc
FC = g95
FFLAGS = -O2 -fbounds-check -Wall -Wno-precision-loss -fno-second-underscore
CFLAGS = -I. -fbounds-check
# Default rules
%.o: %.c
${CC} ${CFLAGS} -c $<
%.o: %.f
${FC} ${FFLAGS} -c $<
%.o: %.F
${FC} ${FFLAGS} -c $<
%.o: %.f90
${FC} ${FFLAGS} -c $<
%.o: %.F90
${FC} ${FFLAGS} -c $<
all: libm65.a m65.exe JT65code.exe
OBJS1 = trimlist.o display.o getdphi.o pctile.o ccf65.o \
decode1a.o sort.o filbig.o fil6521.o afc65b.o \
twkfreq.o decode65b.o indexx.o ssort.o fchisq.o setup65.o \
extract.o deep65.o ccf2.o demod64a.o chkhist.o graycode.o \
interleave63.o unpackmsg.o encode65.o igray.o set.o unpackcall.o \
unpackgrid.o grid2k.o unpacktext.o getpfx2.o packmsg.o \
deg2grid.o packtext.o getpfx1.o packcall.o k2grid.o packgrid.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o \
astro.o tm2.o sun.o moondop.o coord.o tmoonsub.o \
geocentric.o moon2.o toxyz.o dot.o dcoord.o f77_wisdom.o \
gen65.o chkmsg.o ptt.o astrosub.o astro0.o recvpkt.o symspec.o \
iqcal.o iqfix.o timf2.o s3avg.o
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o cutil.o
LIBS3 = -L'c:/QtSDK/Desktop/Qt/4.7.4/mingw/lib' -lQtCore4
m65.exe: $(OBJS3) libm65.a
g++ -o m65.exe $(OBJS3) $(LIBS3) libm65.a ../libfftw3f_win.a \
c:/MinGW/lib/libf95.a
cp m65.exe ../../map65_install
OBJS2 = JT65code.o
JT65code.exe: $(OBJS2) libm65.a
$(FC) -o JT65code.exe $(OBJS2) libm65.a
INCPATH = -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/QtCore' \
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include' \
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/ActiveQt' \
-I'release' -I'.' -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/mkspecs/win32-g++'
ipcomm.o: ipcomm.cpp
g++ -c $(INCPATH) ipcomm.cpp
#m65a.o: m65a.f90
# $(FC) -c -fno-second-underscore -cpp m65a.f90
sec_midn.o: sec_midn.f90
$(FC) -c -fno-second-underscore sec_midn.f90
#symspec.o: ../symspec.f90
# $(FC) -c $(FFLAGS) -o symspec.o ../symspec.f90
OBJS4 = tastro.o astro0.o libm65.a
tastro.exe: $(OBJS4)
$(FC) $(FFLAGS) -o tastro.exe $(OBJS4) libm65.a
OBJS5 = t1.o timer.o libm65.a
t1.exe: $(OBJS5)
$(FC) $(FFLAGS) -o t1.exe $(OBJS5) libm65.a
#astro0.o: ../astro0.f90
# $(FC) -c $(FFLAGS) -o astro0.o ../astro0.f90
init_rs.o: init_rs.c
$(CC) -c -DBIGSYM=1 -o init_rs.o init_rs.c
encode_rs.o: encode_rs.c
$(CC) -c -DBIGSYM=1 -o encode_rs.o encode_rs.c
decode_rs.o: decode_rs.c
$(CC) -c -DBIGSYM=1 -o decode_rs.o decode_rs.c
.PHONY : clean
clean:
rm -f *.o libm65.a m65.exe jt65code.exe
libm65/Makefile.linux
+96 -96
View File
@@ -1,96 +1,96 @@
CC = gcc
FC = gfortran
FFLAGS = -O2 -fbounds-check -Wall
# For ptt_unix:
CFLAGS = -I. -fbounds-check -DHAVE_STDLIB_H=1 -DHAVE_STDIO_H=1 \
-DHAVE_FCNTL_H=1 -DHAVE_SYS_IOCTL_H=1
# Default rules
%.o: %.c
${CC} ${CFLAGS} -c $<
%.o: %.f
${FC} ${FFLAGS} -c $<
%.o: %.F
${FC} ${FFLAGS} -c $<
%.o: %.f90
${FC} ${FFLAGS} -c $<
%.o: %.F90
${FC} ${FFLAGS} -c $<
all: libm65.a m65
OBJS1 = trimlist.o display.o getdphi.o pctile.o ccf65.o \
decode1a.o sort.o filbig.o fil6521.o afc65b.o \
twkfreq.o decode65b.o indexx.o ssort.o fchisq.o setup65.o \
extract.o deep65.o ccf2.o demod64a.o chkhist.o graycode.o \
interleave63.o unpackmsg.o encode65.o igray.o set.o unpackcall.o \
unpackgrid.o grid2k.o unpacktext.o getpfx2.o packmsg.o \
deg2grid.o packtext.o getpfx1.o packcall.o k2grid.o packgrid.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o \
astro.o tm2.o sun.o moondop.o coord.o tmoonsub.o \
geocentric.o moon2.o toxyz.o dot.o dcoord.o f77_wisdom.o \
gen65.o chkmsg.o ptt_unix.o astrosub.o astro0.o recvpkt.o \
symspec.o iqcal.o iqfix.o timf2.o s3avg.o
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o cutil.o
m65: $(OBJS3) libm65.a
g++ -o m65 $(OBJS3) libm65.a -lfftw3f -lQtCore -lfftw3f -lgfortran
OBJS2 = m65a.o ipcomm.o sec_midn.o cutil.o decode0.o map65a.o \
timer.o ftninit.o ftnquit.o
LIBS2 = -lQtCore -lfftw3f -lgfortran
m65a: $(OBJS2) libm65.a
g++ -o m65a $(OBJS2) libm65.a -lQtCore -lfftw3f -lgfortran
OBJS6 = t3.o ipcomm.o
LIBS2 = -lQtCore -lgfortran
t3: $(OBJS6)
g++ -o t3 $(OBJS6) $(LIBS2)
t3:
INCPATH = -I. -I'/usr/include/qt4' -I'/usr/include/qt4/QtCore'
ipcomm.o: ipcomm.cpp
g++ -c $(INCPATH) ipcomm.cpp
m65a.o: m65a.F90
$(FC) -c -fno-second-underscore -DUNIX m65a.F90
extract.o: extract.F
$(FC) -c -fno-second-underscore -DUNIX extract.F
sec_midn.o: sec_midn.f90
$(FC) -c -fno-second-underscore sec_midn.f90
OBJS4 = tastro.o astro0.o libm65.a
tastro: $(OBJS4)
$(FC) $(FFLAGS) -o tastro $(OBJS4) libm65.a
OBJS5 = t1.o timer.o libm65.a
t1: $(OBJS5)
$(FC) $(FFLAGS) -o t1 $(OBJS5) libm65.a
init_rs.o: init_rs.c
$(CC) -c -DBIGSYM=1 -o init_rs.o init_rs.c
encode_rs.o: encode_rs.c
$(CC) -c -DBIGSYM=1 -o encode_rs.o encode_rs.c
decode_rs.o: decode_rs.c
$(CC) -c -DBIGSYM=1 -o decode_rs.o decode_rs.c
.PHONY : clean
clean:
rm -f *.o libm65.a m65 m65a
CC = gcc
FC = gfortran
FFLAGS = -O2 -fbounds-check -Wall
# For ptt_unix:
CFLAGS = -I. -fbounds-check -DHAVE_STDLIB_H=1 -DHAVE_STDIO_H=1 \
-DHAVE_FCNTL_H=1 -DHAVE_SYS_IOCTL_H=1
# Default rules
%.o: %.c
${CC} ${CFLAGS} -c $<
%.o: %.f
${FC} ${FFLAGS} -c $<
%.o: %.F
${FC} ${FFLAGS} -c $<
%.o: %.f90
${FC} ${FFLAGS} -c $<
%.o: %.F90
${FC} ${FFLAGS} -c $<
all: libm65.a m65
OBJS1 = trimlist.o display.o getdphi.o pctile.o ccf65.o \
decode1a.o sort.o filbig.o fil6521.o afc65b.o \
twkfreq.o decode65b.o indexx.o ssort.o fchisq.o setup65.o \
extract.o deep65.o ccf2.o demod64a.o chkhist.o graycode.o \
interleave63.o unpackmsg.o encode65.o igray.o set.o unpackcall.o \
unpackgrid.o grid2k.o unpacktext.o getpfx2.o packmsg.o \
deg2grid.o packtext.o getpfx1.o packcall.o k2grid.o packgrid.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o \
astro.o tm2.o sun.o moondop.o coord.o tmoonsub.o \
geocentric.o moon2.o toxyz.o dot.o dcoord.o f77_wisdom.o \
gen65.o chkmsg.o ptt_unix.o astrosub.o astro0.o recvpkt.o \
symspec.o iqcal.o iqfix.o timf2.o s3avg.o
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o cutil.o
m65: $(OBJS3) libm65.a
g++ -o m65 $(OBJS3) libm65.a -lfftw3f -lQtCore -lfftw3f -lgfortran
OBJS2 = m65a.o ipcomm.o sec_midn.o cutil.o decode0.o map65a.o \
timer.o ftninit.o ftnquit.o
LIBS2 = -lQtCore -lfftw3f -lgfortran
m65a: $(OBJS2) libm65.a
g++ -o m65a $(OBJS2) libm65.a -lQtCore -lfftw3f -lgfortran
OBJS6 = t3.o ipcomm.o
LIBS2 = -lQtCore -lgfortran
t3: $(OBJS6)
g++ -o t3 $(OBJS6) $(LIBS2)
t3:
INCPATH = -I. -I'/usr/include/qt4' -I'/usr/include/qt4/QtCore'
ipcomm.o: ipcomm.cpp
g++ -c $(INCPATH) ipcomm.cpp
m65a.o: m65a.F90
$(FC) -c -fno-second-underscore -DUNIX m65a.F90
extract.o: extract.F
$(FC) -c -fno-second-underscore -DUNIX extract.F
sec_midn.o: sec_midn.f90
$(FC) -c -fno-second-underscore sec_midn.f90
OBJS4 = tastro.o astro0.o libm65.a
tastro: $(OBJS4)
$(FC) $(FFLAGS) -o tastro $(OBJS4) libm65.a
OBJS5 = t1.o timer.o libm65.a
t1: $(OBJS5)
$(FC) $(FFLAGS) -o t1 $(OBJS5) libm65.a
init_rs.o: init_rs.c
$(CC) -c -DBIGSYM=1 -o init_rs.o init_rs.c
encode_rs.o: encode_rs.c
$(CC) -c -DBIGSYM=1 -o encode_rs.o encode_rs.c
decode_rs.o: decode_rs.c
$(CC) -c -DBIGSYM=1 -o decode_rs.o decode_rs.c
.PHONY : clean
clean:
rm -f *.o libm65.a m65 m65a
libm65/afc65b.f
+68 -68
View File
@@ -1,68 +1,68 @@
subroutine afc65b(cx,cy,npts,fsample,nflip,ipol,xpol,a,
+ ccfbest,dtbest)
logical xpol
complex cx(npts)
complex cy(npts)
real a(5),deltaa(5)
a(1)=0.
a(2)=0.
a(3)=0.
a(4)=45.0*(ipol-1.0)
deltaa(1)=2.0
deltaa(2)=2.0
deltaa(3)=2.0
deltaa(4)=22.5
deltaa(5)=0.05
nterms=3
if(xpol) nterms=4
chisqr=0.
C Start the iteration
chisqr0=1.e6
do iter=1,3 !One iteration is enough?
do j=1,nterms
chisq1=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
fn=0.
delta=deltaa(j)
10 a(j)=a(j)+delta
chisq2=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
if(chisq2.eq.chisq1) go to 10
if(chisq2.gt.chisq1) then
delta=-delta !Reverse direction
a(j)=a(j)+delta
tmp=chisq1
chisq1=chisq2
chisq2=tmp
endif
20 fn=fn+1.0
a(j)=a(j)+delta
chisq3=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
if(chisq3.lt.chisq2) then
chisq1=chisq2
chisq2=chisq3
go to 20
endif
C Find minimum of parabola defined by last three points
delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5)
a(j)=a(j)-delta
deltaa(j)=deltaa(j)*fn/3.
enddo
chisqr=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
if(chisqr/chisqr0.gt.0.9999) go to 30
chisqr0=chisqr
enddo
30 ccfbest=ccfmax * (1378.125/fsample)**2
dtbest=dtmax
if(a(4).lt.0.0) a(4)=a(4)+180.0
if(a(4).ge.180.0) a(4)=a(4)-180.0
if(nint(a(4)).eq.180) a(4)=0.
ipol=nint(a(4)/45.0) + 1
if(ipol.gt.4) ipol=ipol-4
return
end
subroutine afc65b(cx,cy,npts,fsample,nflip,ipol,xpol,a,
+ ccfbest,dtbest)
logical xpol
complex cx(npts)
complex cy(npts)
real a(5),deltaa(5)
a(1)=0.
a(2)=0.
a(3)=0.
a(4)=45.0*(ipol-1.0)
deltaa(1)=2.0
deltaa(2)=2.0
deltaa(3)=2.0
deltaa(4)=22.5
deltaa(5)=0.05
nterms=3
if(xpol) nterms=4
chisqr=0.
C Start the iteration
chisqr0=1.e6
do iter=1,3 !One iteration is enough?
do j=1,nterms
chisq1=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
fn=0.
delta=deltaa(j)
10 a(j)=a(j)+delta
chisq2=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
if(chisq2.eq.chisq1) go to 10
if(chisq2.gt.chisq1) then
delta=-delta !Reverse direction
a(j)=a(j)+delta
tmp=chisq1
chisq1=chisq2
chisq2=tmp
endif
20 fn=fn+1.0
a(j)=a(j)+delta
chisq3=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
if(chisq3.lt.chisq2) then
chisq1=chisq2
chisq2=chisq3
go to 20
endif
C Find minimum of parabola defined by last three points
delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5)
a(j)=a(j)-delta
deltaa(j)=deltaa(j)*fn/3.
enddo
chisqr=fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
if(chisqr/chisqr0.gt.0.9999) go to 30
chisqr0=chisqr
enddo
30 ccfbest=ccfmax * (1378.125/fsample)**2
dtbest=dtmax
if(a(4).lt.0.0) a(4)=a(4)+180.0
if(a(4).ge.180.0) a(4)=a(4)-180.0
if(nint(a(4)).eq.180) a(4)=0.
ipol=nint(a(4)/45.0) + 1
if(ipol.gt.4) ipol=ipol-4
return
end
libm65/astro.f
+109 -109
View File
@@ -1,109 +1,109 @@
subroutine astro(nyear,month,nday,uth,nfreq,Mygrid,
+ NStation,MoonDX,AzSun,ElSun,AzMoon0,ElMoon0,
+ ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,
+ poloffset,xnr,day,lon,lat,LST)
C Computes astronomical quantities for display and tracking.
C NB: may want to smooth the Tsky map to 10 degrees or so.
character*6 MyGrid,HisGrid
real LST
real lat,lon
integer*2 nt144(180)
! common/echo/xdop(2),techo,AzMoon,ElMoon,mjd
real xdop(2)
data rad/57.2957795/
data nt144/
+ 234, 246, 257, 267, 275, 280, 283, 286, 291, 298,
+ 305, 313, 322, 331, 341, 351, 361, 369, 376, 381,
+ 383, 382, 379, 374, 370, 366, 363, 361, 363, 368,
+ 376, 388, 401, 415, 428, 440, 453, 467, 487, 512,
+ 544, 579, 607, 618, 609, 588, 563, 539, 512, 482,
+ 450, 422, 398, 379, 363, 349, 334, 319, 302, 282,
+ 262, 242, 226, 213, 205, 200, 198, 197, 196, 197,
+ 200, 202, 204, 205, 204, 203, 202, 201, 203, 206,
+ 212, 218, 223, 227, 231, 236, 240, 243, 247, 257,
+ 276, 301, 324, 339, 346, 344, 339, 331, 323, 316,
+ 312, 310, 312, 317, 327, 341, 358, 375, 392, 407,
+ 422, 437, 451, 466, 480, 494, 511, 530, 552, 579,
+ 612, 653, 702, 768, 863,1008,1232,1557,1966,2385,
+ 2719,2924,3018,3038,2986,2836,2570,2213,1823,1461,
+ 1163, 939, 783, 677, 602, 543, 494, 452, 419, 392,
+ 373, 360, 353, 350, 350, 350, 350, 350, 350, 348,
+ 344, 337, 329, 319, 307, 295, 284, 276, 272, 272,
+ 273, 274, 274, 271, 266, 260, 252, 245, 238, 231/
save
call grid2deg(MyGrid,elon,lat)
lon=-elon
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST,
+ AzSun,ElSun,mjd,day)
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)
C Compute spatial polarization offset
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)*
+ cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
techo=2.0 * dist/2.99792458e5 !Echo delay time
doppler=-freq*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
xdop(NStation)=doppler
if(NStation.eq.2) then
HisGrid=MyGrid
go to 900
endif
doppler00=2.0*xdop(1)
doppler=xdop(1)+xdop(2)
! if(mode.eq.3) doppler=2.0*xdop(1)
dBMoon=-40.0*log10(dist/356903.)
sd=16.23*370152.0/dist
! if(NStation.eq.1 .and. MoonDX.ne.0 .and.
! + (mode.eq.2 .or. mode.eq.5)) then
if(NStation.eq.1 .and. MoonDX.ne.0) then
poloffset=mod(poloffset2-poloffset1+720.0,180.0)
if(poloffset.gt.90.0) poloffset=poloffset-180.0
x1=abs(cos(2*poloffset/rad))
if(x1.lt.0.056234) x1=0.056234
xnr=-20.0*log10(x1)
if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'R') xnr=0
endif
tr=80.0 !Good preamp
tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature
tsysmin=tskymin+tr
tsys=tsky+tr
dgrd=-10.0*log10(tsys/tsysmin) + dbMoon
900 AzMoon0=Azmoon
ElMoon0=Elmoon
ntsky=nint(tsky)
! auxHA = 15.0*(LST-auxra) !HA in degrees
! pi=3.14159265
! pio2=0.5*pi
! call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0,
! + auxdec/rad,azaux,elaux)
! AzAux=azaux*rad
! ElAux=ElAux*rad
return
end
subroutine astro(nyear,month,nday,uth,nfreq,Mygrid,
+ NStation,MoonDX,AzSun,ElSun,AzMoon0,ElMoon0,
+ ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,
+ poloffset,xnr,day,lon,lat,LST)
C Computes astronomical quantities for display and tracking.
C NB: may want to smooth the Tsky map to 10 degrees or so.
character*6 MyGrid,HisGrid
real LST
real lat,lon
integer*2 nt144(180)
! common/echo/xdop(2),techo,AzMoon,ElMoon,mjd
real xdop(2)
data rad/57.2957795/
data nt144/
+ 234, 246, 257, 267, 275, 280, 283, 286, 291, 298,
+ 305, 313, 322, 331, 341, 351, 361, 369, 376, 381,
+ 383, 382, 379, 374, 370, 366, 363, 361, 363, 368,
+ 376, 388, 401, 415, 428, 440, 453, 467, 487, 512,
+ 544, 579, 607, 618, 609, 588, 563, 539, 512, 482,
+ 450, 422, 398, 379, 363, 349, 334, 319, 302, 282,
+ 262, 242, 226, 213, 205, 200, 198, 197, 196, 197,
+ 200, 202, 204, 205, 204, 203, 202, 201, 203, 206,
+ 212, 218, 223, 227, 231, 236, 240, 243, 247, 257,
+ 276, 301, 324, 339, 346, 344, 339, 331, 323, 316,
+ 312, 310, 312, 317, 327, 341, 358, 375, 392, 407,
+ 422, 437, 451, 466, 480, 494, 511, 530, 552, 579,
+ 612, 653, 702, 768, 863,1008,1232,1557,1966,2385,
+ 2719,2924,3018,3038,2986,2836,2570,2213,1823,1461,
+ 1163, 939, 783, 677, 602, 543, 494, 452, 419, 392,
+ 373, 360, 353, 350, 350, 350, 350, 350, 350, 348,
+ 344, 337, 329, 319, 307, 295, 284, 276, 272, 272,
+ 273, 274, 274, 271, 266, 260, 252, 245, 238, 231/
save
call grid2deg(MyGrid,elon,lat)
lon=-elon
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST,
+ AzSun,ElSun,mjd,day)
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)
C Compute spatial polarization offset
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)*
+ cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
techo=2.0 * dist/2.99792458e5 !Echo delay time
doppler=-freq*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
xdop(NStation)=doppler
if(NStation.eq.2) then
HisGrid=MyGrid
go to 900
endif
doppler00=2.0*xdop(1)
doppler=xdop(1)+xdop(2)
! if(mode.eq.3) doppler=2.0*xdop(1)
dBMoon=-40.0*log10(dist/356903.)
sd=16.23*370152.0/dist
! if(NStation.eq.1 .and. MoonDX.ne.0 .and.
! + (mode.eq.2 .or. mode.eq.5)) then
if(NStation.eq.1 .and. MoonDX.ne.0) then
poloffset=mod(poloffset2-poloffset1+720.0,180.0)
if(poloffset.gt.90.0) poloffset=poloffset-180.0
x1=abs(cos(2*poloffset/rad))
if(x1.lt.0.056234) x1=0.056234
xnr=-20.0*log10(x1)
if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'R') xnr=0
endif
tr=80.0 !Good preamp
tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature
tsysmin=tskymin+tr
tsys=tsky+tr
dgrd=-10.0*log10(tsys/tsysmin) + dbMoon
900 AzMoon0=Azmoon
ElMoon0=Elmoon
ntsky=nint(tsky)
! auxHA = 15.0*(LST-auxra) !HA in degrees
! pi=3.14159265
! pio2=0.5*pi
! call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0,
! + auxdec/rad,azaux,elaux)
! AzAux=azaux*rad
! ElAux=ElAux*rad
return
end
libm65/astro0.f90
+81 -81
View File
@@ -1,81 +1,81 @@
subroutine astro0(nyear,month,nday,uth8,nfreq,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)
parameter (DEGS=57.2957795130823d0)
character*6 mygrid,hisgrid
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0,dt
real*8 sd8,poloffset8,day8,width1,width2,w501,w502,xlst8
real*8 uth8
data uth8z/0.d0/
save
uth=uth8
call astro(nyear,month,nday,uth,nfreq,hisgrid,2,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon2,xlat2,xlst)
AzMoonB8=AzMoon
ElMoonB8=ElMoon
call astro(nyear,month,nday,uth,nfreq,mygrid,1,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon1,xlat1,xlst)
day8=day
xlst8=xlst
call tm2(day8,xlat1,xlon1,xl1,b1)
call tm2(day8,xlat2,xlon2,xl2,b2)
call tm2(day8+1.d0/1440.0,xlat1,xlon1,xl1a,b1a)
call tm2(day8+1.d0/1440.0,xlat2,xlon2,xl2a,b2a)
fghz=0.001*nfreq
dldt1=DEGS*(xl1a-xl1)
dbdt1=DEGS*(b1a-b1)
dldt2=DEGS*(xl2a-xl2)
dbdt2=DEGS*(b2a-b2)
rate1=2.0*sqrt(dldt1**2 + dbdt1**2)
width1=0.5*6741*fghz*rate1
rate2=sqrt((dldt1+dldt2)**2 + (dbdt1+dbdt2)**2)
width2=0.5*6741*fghz*rate2
fbend=0.7
a2=0.0045*log(fghz/fbend)/log(1.05)
if(fghz.lt.fbend) a2=0.0
f50=0.19 * (fghz/fbend)**a2
if(f50.gt.1.0) f50=1.0
w501=f50*width1
w502=f50*width2
AzSun8=AzSun
ElSun8=ElSun
AzMoon8=AzMoon
ElMoon8=ElMoon
dbMoon8=dbMoon
RAMoon8=RAMoon/15.0
DecMoon8=DecMoon
HA8=HA
Dgrd8=Dgrd
sd8=sd
poloffset8=poloffset
xnr8=xnr
ndop=nint(doppler)
ndop00=nint(doppler00)
if(uth8z.eq.0.d0) then
uth8z=uth8-1.d0/3600.d0
dopplerz=doppler
doppler00z=doppler00
endif
dt=60.0*(uth8-uth8z)
if(dt.le.0) dt=1.d0/60.d0
dfdt=(doppler-dopplerz)/dt
dfdt0=(doppler00-doppler00z)/dt
uth8z=uth8
dopplerz=doppler
doppler00z=doppler00
return
end subroutine astro0
subroutine astro0(nyear,month,nday,uth8,nfreq,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)
parameter (DEGS=57.2957795130823d0)
character*6 mygrid,hisgrid
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0,dt
real*8 sd8,poloffset8,day8,width1,width2,w501,w502,xlst8
real*8 uth8
data uth8z/0.d0/
save
uth=uth8
call astro(nyear,month,nday,uth,nfreq,hisgrid,2,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon2,xlat2,xlst)
AzMoonB8=AzMoon
ElMoonB8=ElMoon
call astro(nyear,month,nday,uth,nfreq,mygrid,1,1, &
AzSun,ElSun,AzMoon,ElMoon,ntsky,doppler00,doppler, &
dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,poloffset,xnr, &
day,xlon1,xlat1,xlst)
day8=day
xlst8=xlst
call tm2(day8,xlat1,xlon1,xl1,b1)
call tm2(day8,xlat2,xlon2,xl2,b2)
call tm2(day8+1.d0/1440.0,xlat1,xlon1,xl1a,b1a)
call tm2(day8+1.d0/1440.0,xlat2,xlon2,xl2a,b2a)
fghz=0.001*nfreq
dldt1=DEGS*(xl1a-xl1)
dbdt1=DEGS*(b1a-b1)
dldt2=DEGS*(xl2a-xl2)
dbdt2=DEGS*(b2a-b2)
rate1=2.0*sqrt(dldt1**2 + dbdt1**2)
width1=0.5*6741*fghz*rate1
rate2=sqrt((dldt1+dldt2)**2 + (dbdt1+dbdt2)**2)
width2=0.5*6741*fghz*rate2
fbend=0.7
a2=0.0045*log(fghz/fbend)/log(1.05)
if(fghz.lt.fbend) a2=0.0
f50=0.19 * (fghz/fbend)**a2
if(f50.gt.1.0) f50=1.0
w501=f50*width1
w502=f50*width2
AzSun8=AzSun
ElSun8=ElSun
AzMoon8=AzMoon
ElMoon8=ElMoon
dbMoon8=dbMoon
RAMoon8=RAMoon/15.0
DecMoon8=DecMoon
HA8=HA
Dgrd8=Dgrd
sd8=sd
poloffset8=poloffset
xnr8=xnr
ndop=nint(doppler)
ndop00=nint(doppler00)
if(uth8z.eq.0.d0) then
uth8z=uth8-1.d0/3600.d0
dopplerz=doppler
doppler00z=doppler00
endif
dt=60.0*(uth8-uth8z)
if(dt.le.0) dt=1.d0/60.d0
dfdt=(doppler-dopplerz)/dt
dfdt0=(doppler00-doppler00z)/dt
uth8z=uth8
dopplerz=doppler
doppler00z=doppler00
return
end subroutine astro0
libm65/astrosub.f90
+14 -14
View File
@@ -1,14 +1,14 @@
subroutine astrosub(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8)
implicit real*8 (a-h,o-z)
character*6 mygrid,hisgrid
call astro0(nyear,month,nday,uth8,nfreq,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)
return
end subroutine astrosub
subroutine astrosub(nyear,month,nday,uth8,nfreq,mygrid,hisgrid, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8)
implicit real*8 (a-h,o-z)
character*6 mygrid,hisgrid
call astro0(nyear,month,nday,uth8,nfreq,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)
return
end subroutine astrosub
libm65/ccf2.f
+45 -45
View File
@@ -1,45 +1,45 @@
subroutine ccf2(ss,nz,nflip,ccfbest,lagpk)
parameter (LAGMAX=60)
! parameter (LAGMAX=200)
real ss(nz)
real ccf(-LAGMAX:LAGMAX)
integer npr(126)
C The JT65 pseudo-random sync pattern:
data npr/
+ 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0,
+ 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1,
+ 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1,
+ 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1,
+ 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1,
+ 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1,
+ 1,1,1,1,1,1/
save
ccfbest=0.
lag1=-LAGMAX
lag2=LAGMAX
do lag=lag1,lag2
s0=0.
s1=0.
do i=1,126
j=2*(8*i + 43) + lag
if(j.ge.1 .and. j.le.nz-8) then
x=ss(j)+ss(j+8) !Add two half-symbol contributions
if(npr(i).eq.0) then
s0=s0 + x
else
s1=s1 + x
endif
endif
enddo
ccf(lag)=nflip*(s1-s0)
if(ccf(lag).gt.ccfbest) then
ccfbest=ccf(lag)
lagpk=lag
endif
enddo
return
end
subroutine ccf2(ss,nz,nflip,ccfbest,lagpk)
parameter (LAGMAX=60)
! parameter (LAGMAX=200)
real ss(nz)
real ccf(-LAGMAX:LAGMAX)
integer npr(126)
C The JT65 pseudo-random sync pattern:
data npr/
+ 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0,
+ 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1,
+ 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1,
+ 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1,
+ 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1,
+ 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1,
+ 1,1,1,1,1,1/
save
ccfbest=0.
lag1=-LAGMAX
lag2=LAGMAX
do lag=lag1,lag2
s0=0.
s1=0.
do i=1,126
j=2*(8*i + 43) + lag
if(j.ge.1 .and. j.le.nz-8) then
x=ss(j)+ss(j+8) !Add two half-symbol contributions
if(npr(i).eq.0) then
s0=s0 + x
else
s1=s1 + x
endif
endif
enddo
ccf(lag)=nflip*(s1-s0)
if(ccf(lag).gt.ccfbest) then
ccfbest=ccf(lag)
lagpk=lag
endif
enddo
return
end
libm65/ccf65.f90
+118 -118
View File
@@ -1,118 +1,118 @@
subroutine ccf65(ss,nhsym,ssmax,sync1,ipol1,jpz,dt1,flipk,syncshort, &
snr2,ipol2,dt2)
parameter (NFFT=512,NH=NFFT/2)
real ss(4,322) !Input: half-symbol powers, 4 pol'ns
real s(NFFT) !CCF = ss*pr
complex cs(0:NH) !Complex FT of s
real s2(NFFT) !CCF = ss*pr2
complex cs2(0:NH) !Complex FT of s2
real pr(NFFT) !JT65 pseudo-random sync pattern
complex cpr(0:NH) !Complex FT of pr
real pr2(NFFT) !JT65 shorthand pattern
complex cpr2(0:NH) !Complex FT of pr2
real tmp1(322)
real tmp2(322)
real ccf(-27:27,4)
logical first
integer npr(126)
data first/.true./
equivalence (s,cs),(pr,cpr),(s2,cs2),(pr2,cpr2)
save
! The JT65 pseudo-random sync pattern:
data npr/ &
1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
if(first) then
! Initialize pr, pr2; compute cpr, cpr2.
fac=1.0/NFFT
do i=1,NFFT
pr(i)=0.
pr2(i)=0.
k=2*mod((i-1)/8,2)-1
if(i.le.NH) pr2(i)=fac*k
enddo
do i=1,126
j=2*i
pr(j)=fac*(2*npr(i)-1)
! Not sure why, but it works significantly better without the following line:
! pr(j-1)=pr(j)
enddo
call four2a(pr,NFFT,1,-1,0)
call four2a(pr2,NFFT,1,-1,0)
first=.false.
endif
! Look for JT65 sync pattern and shorthand square-wave pattern.
ccfbest=0.
ccfbest2=0.
ipol1=1
ipol2=1
do ip=1,jpz !Do jpz polarizations
do i=1,nhsym-1
! s(i)=ss(ip,i)+ss(ip,i+1)
s(i)=min(ssmax,ss(ip,i)+ss(ip,i+1))
enddo
s(nhsym:NFFT)=0.
call four2a(s,NFFT,1,-1,0) !Real-to-complex FFT
do i=0,NH
cs2(i)=cs(i)*conjg(cpr2(i)) !Mult by complex FFT of pr2
cs(i)=cs(i)*conjg(cpr(i)) !Mult by complex FFT of pr
enddo
call four2a(cs,NFFT,1,1,-1) !Complex-to-real inv-FFT
call four2a(cs2,NFFT,1,1,-1) !Complex-to-real inv-FFT
do lag=-27,27 !Check for best JT65 sync
ccf(lag,ip)=s(lag+28)
if(abs(ccf(lag,ip)).gt.ccfbest) then
ccfbest=abs(ccf(lag,ip))
lagpk=lag
ipol1=ip
flipk=1.0
if(ccf(lag,ip).lt.0.0) flipk=-1.0
endif
enddo
do lag=-8,7 !Check for best shorthand
ccf2=s2(lag+28)
if(ccf2.gt.ccfbest2) then
ccfbest2=ccf2
lagpk2=lag
ipol2=ip
endif
enddo
enddo
! Find rms level on baseline of "ccfblue", for normalization.
sum=0.
do lag=-26,26
if(abs(lag-lagpk).gt.1) sum=sum + ccf(lag,ipol1)
enddo
base=sum/50.0
sq=0.
do lag=-26,26
if(abs(lag-lagpk).gt.1) sq=sq + (ccf(lag,ipol1)-base)**2
enddo
rms=sqrt(sq/49.0)
sync1=ccfbest/rms - 4.0
dt1=2.5 + lagpk*(2048.0/11025.0)
! Find base level for normalizing snr2.
do i=1,nhsym
tmp1(i)=ss(ipol2,i)
enddo
call pctile(tmp1,tmp2,nhsym,40,base)
snr2=0.398107*ccfbest2/base !### empirical
syncshort=0.5*ccfbest2/rms - 4.0 !### better normalizer than rms?
dt2=2.5 + lagpk2*(2048.0/11025.0)
return
end subroutine ccf65
subroutine ccf65(ss,nhsym,ssmax,sync1,ipol1,jpz,dt1,flipk,syncshort, &
snr2,ipol2,dt2)
parameter (NFFT=512,NH=NFFT/2)
real ss(4,322) !Input: half-symbol powers, 4 pol'ns
real s(NFFT) !CCF = ss*pr
complex cs(0:NH) !Complex FT of s
real s2(NFFT) !CCF = ss*pr2
complex cs2(0:NH) !Complex FT of s2
real pr(NFFT) !JT65 pseudo-random sync pattern
complex cpr(0:NH) !Complex FT of pr
real pr2(NFFT) !JT65 shorthand pattern
complex cpr2(0:NH) !Complex FT of pr2
real tmp1(322)
real tmp2(322)
real ccf(-27:27,4)
logical first
integer npr(126)
data first/.true./
equivalence (s,cs),(pr,cpr),(s2,cs2),(pr2,cpr2)
save
! The JT65 pseudo-random sync pattern:
data npr/ &
1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
if(first) then
! Initialize pr, pr2; compute cpr, cpr2.
fac=1.0/NFFT
do i=1,NFFT
pr(i)=0.
pr2(i)=0.
k=2*mod((i-1)/8,2)-1
if(i.le.NH) pr2(i)=fac*k
enddo
do i=1,126
j=2*i
pr(j)=fac*(2*npr(i)-1)
! Not sure why, but it works significantly better without the following line:
! pr(j-1)=pr(j)
enddo
call four2a(pr,NFFT,1,-1,0)
call four2a(pr2,NFFT,1,-1,0)
first=.false.
endif
! Look for JT65 sync pattern and shorthand square-wave pattern.
ccfbest=0.
ccfbest2=0.
ipol1=1
ipol2=1
do ip=1,jpz !Do jpz polarizations
do i=1,nhsym-1
! s(i)=ss(ip,i)+ss(ip,i+1)
s(i)=min(ssmax,ss(ip,i)+ss(ip,i+1))
enddo
s(nhsym:NFFT)=0.
call four2a(s,NFFT,1,-1,0) !Real-to-complex FFT
do i=0,NH
cs2(i)=cs(i)*conjg(cpr2(i)) !Mult by complex FFT of pr2
cs(i)=cs(i)*conjg(cpr(i)) !Mult by complex FFT of pr
enddo
call four2a(cs,NFFT,1,1,-1) !Complex-to-real inv-FFT
call four2a(cs2,NFFT,1,1,-1) !Complex-to-real inv-FFT
do lag=-27,27 !Check for best JT65 sync
ccf(lag,ip)=s(lag+28)
if(abs(ccf(lag,ip)).gt.ccfbest) then
ccfbest=abs(ccf(lag,ip))
lagpk=lag
ipol1=ip
flipk=1.0
if(ccf(lag,ip).lt.0.0) flipk=-1.0
endif
enddo
do lag=-8,7 !Check for best shorthand
ccf2=s2(lag+28)
if(ccf2.gt.ccfbest2) then
ccfbest2=ccf2
lagpk2=lag
ipol2=ip
endif
enddo
enddo
! Find rms level on baseline of "ccfblue", for normalization.
sum=0.
do lag=-26,26
if(abs(lag-lagpk).gt.1) sum=sum + ccf(lag,ipol1)
enddo
base=sum/50.0
sq=0.
do lag=-26,26
if(abs(lag-lagpk).gt.1) sq=sq + (ccf(lag,ipol1)-base)**2
enddo
rms=sqrt(sq/49.0)
sync1=ccfbest/rms - 4.0
dt1=2.5 + lagpk*(2048.0/11025.0)
! Find base level for normalizing snr2.
do i=1,nhsym
tmp1(i)=ss(ipol2,i)
enddo
call pctile(tmp1,tmp2,nhsym,40,base)
snr2=0.398107*ccfbest2/base !### empirical
syncshort=0.5*ccfbest2/rms - 4.0 !### better normalizer than rms?
dt2=2.5 + lagpk2*(2048.0/11025.0)
return
end subroutine ccf65
libm65/chkhist.f
+23 -23
View File
@@ -1,23 +1,23 @@
subroutine chkhist(mrsym,nmax,ipk)
integer mrsym(63)
integer hist(0:63)
do i=0,63
hist(i)=0
enddo
do j=1,63
i=mrsym(j)
hist(i)=hist(i)+1
enddo
nmax=0
do i=0,63
if(hist(i).gt.nmax) then
nmax=hist(i)
ipk=i+1
endif
enddo
return
end
subroutine chkhist(mrsym,nmax,ipk)
integer mrsym(63)
integer hist(0:63)
do i=0,63
hist(i)=0
enddo
do j=1,63
i=mrsym(j)
hist(i)=hist(i)+1
enddo
nmax=0
do i=0,63
if(hist(i).gt.nmax) then
nmax=hist(i)
ipk=i+1
endif
enddo
return
end
libm65/chkmsg.f
+32 -32
View File
@@ -1,32 +1,32 @@
subroutine chkmsg(message,cok,nspecial,flip)
character message*22,cok*3
nspecial=0
flip=1.0
cok=" "
do i=22,1,-1
if(message(i:i).ne.' ') go to 10
enddo
i=22
10 if(i.ge.11) then
if ((message(i-3:i).eq.' OOO') .or.
+ (message(20:22).eq.' OO')) then
cok='OOO'
flip=-1.0
if(message(20:22).eq.' OO') then
message=message(1:19)
else
message=message(1:i-4)
endif
endif
endif
if(message(1:3).eq.'RO ') nspecial=2
if(message(1:4).eq.'RRR ') nspecial=3
if(message(1:3).eq.'73 ') nspecial=4
return
end
subroutine chkmsg(message,cok,nspecial,flip)
character message*22,cok*3
nspecial=0
flip=1.0
cok=" "
do i=22,1,-1
if(message(i:i).ne.' ') go to 10
enddo
i=22
10 if(i.ge.11) then
if ((message(i-3:i).eq.' OOO') .or.
+ (message(20:22).eq.' OO')) then
cok='OOO'
flip=-1.0
if(message(20:22).eq.' OO') then
message=message(1:19)
else
message=message(1:i-4)
endif
endif
endif
if(message(1:3).eq.'RO ') nspecial=2
if(message(1:4).eq.'RRR ') nspecial=3
if(message(1:3).eq.'73 ') nspecial=4
return
end
libm65/coord.f
+41 -41
View File
@@ -1,41 +1,41 @@
SUBROUTINE COORD(A0,B0,AP,BP,A1,B1,A2,B2)
C Examples:
C 1. From ha,dec to az,el:
C call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
C 2. From az,el to ha,dec:
C call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
C 3. From ra,dec to l,b
C call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
C ra,dec,l,b)
C 4. From l,b to ra,dec
C call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
C 0.478220215d0,l,b,ra,dec)
C 5. From ra,dec to ecliptic latitude (eb) and longitude (el):
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
C 6. From ecliptic latitude (eb) and longitude (el) to ra,dec:
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,el,eb,ra,dec)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.e0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
TA2O2=0.0 !Shut up compiler warnings. -db
IF(CA2.LE.0.e0) TA2O2=(1.e0-CA2)/SA2
IF(CA2.GT.0.e0) TA2O2=SA2/(1.e0+CA2)
A2=2.e0*atan(TA2O2)
IF(A2.LT.0.e0) A2=A2+6.2831853
RETURN
END
SUBROUTINE COORD(A0,B0,AP,BP,A1,B1,A2,B2)
C Examples:
C 1. From ha,dec to az,el:
C call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
C 2. From az,el to ha,dec:
C call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
C 3. From ra,dec to l,b
C call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
C ra,dec,l,b)
C 4. From l,b to ra,dec
C call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
C 0.478220215d0,l,b,ra,dec)
C 5. From ra,dec to ecliptic latitude (eb) and longitude (el):
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
C 6. From ecliptic latitude (eb) and longitude (el) to ra,dec:
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,el,eb,ra,dec)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.e0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
TA2O2=0.0 !Shut up compiler warnings. -db
IF(CA2.LE.0.e0) TA2O2=(1.e0-CA2)/SA2
IF(CA2.GT.0.e0) TA2O2=SA2/(1.e0+CA2)
A2=2.e0*atan(TA2O2)
IF(A2.LT.0.e0) A2=A2+6.2831853
RETURN
END
libm65/dcoord.f
+40 -40
View File
@@ -1,40 +1,40 @@
SUBROUTINE DCOORD(A0,B0,AP,BP,A1,B1,A2,B2)
implicit real*8 (a-h,o-z)
C Examples:
C 1. From ha,dec to az,el:
C call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
C 2. From az,el to ha,dec:
C call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
C 3. From ra,dec to l,b
C call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
C ra,dec,l,b)
C 4. From l,b to ra,dec
C call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
C 0.478220215d0,l,b,ra,dec)
C 5. From ecliptic latitude (eb) and longitude (el) to ra, dec:
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.D0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
TA2O2=0.0 !Shut up compiler warnings. -db
IF(CA2.LE.0.D0) TA2O2=(1.D0-CA2)/SA2
IF(CA2.GT.0.D0) TA2O2=SA2/(1.D0+CA2)
A2=2.D0*atan(TA2O2)
IF(A2.LT.0.D0) A2=A2+6.2831853071795864D0
RETURN
END
SUBROUTINE DCOORD(A0,B0,AP,BP,A1,B1,A2,B2)
implicit real*8 (a-h,o-z)
C Examples:
C 1. From ha,dec to az,el:
C call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
C 2. From az,el to ha,dec:
C call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
C 3. From ra,dec to l,b
C call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
C ra,dec,l,b)
C 4. From l,b to ra,dec
C call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
C 0.478220215d0,l,b,ra,dec)
C 5. From ecliptic latitude (eb) and longitude (el) to ra, dec:
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.D0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
TA2O2=0.0 !Shut up compiler warnings. -db
IF(CA2.LE.0.D0) TA2O2=(1.D0-CA2)/SA2
IF(CA2.GT.0.D0) TA2O2=SA2/(1.D0+CA2)
A2=2.D0*atan(TA2O2)
IF(A2.LT.0.D0) A2=A2+6.2831853071795864D0
RETURN
END
libm65/decode0.f90
+64 -64
View File
@@ -1,64 +1,64 @@
subroutine decode0(dd,ss,savg,nstandalone)
parameter (NSMAX=60*96000)
parameter (NFFT=32768)
real*4 dd(4,NSMAX),ss(4,322,NFFT),savg(4,NFFT)
real*8 fcenter
integer hist(0:32768)
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,datetime*20
character mycall0*12,hiscall0*12,hisgrid0*6
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
mycall,mygrid,hiscall,hisgrid,datetime
common/tracer/ limtrace,lu
data neme0/-99/,mcall3b/1/
save
call timer('decode0 ',0)
if(newdat.ne.0) then
nz=52*96000
hist=0
do i=1,nz
j1=min(abs(dd(1,i)),32768.0)
hist(j1)=hist(j1)+1
j2=min(abs(dd(2,i)),32768.0)
hist(j2)=hist(j2)+1
j3=min(abs(dd(3,i)),32768.0)
hist(j3)=hist(j3)+1
j4=min(abs(dd(4,i)),32768.0)
hist(j4)=hist(j4)+1
enddo
m=0
do i=0,32768
m=m+hist(i)
if(m.ge.2*nz) go to 10
enddo
10 rmsdd=1.5*i
endif
nhsym=279
ndphi=0
if(iand(nrxlog,8).ne.0) ndphi=1
if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. &
hisgrid.ne.hisgrid0 .or. mcall3.ne.0 .or. neme.ne.neme0) mcall3b=1
mycall0=mycall
hiscall0=hiscall
hisgrid0=hisgrid
neme0=neme
call timer('map65a ',0)
call map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
nfcal,nkeep,mcall3b,nsave,nxant,rmsdd,mycall,mygrid, &
neme,ndepth,hiscall,hisgrid,nhsym,nfsample,nxpol,mode65)
call timer('map65a ',1)
call timer('decode0 ',1)
if(nstandalone.eq.0) call timer('decode0 ',101)
return
end subroutine decode0
subroutine decode0(dd,ss,savg,nstandalone)
parameter (NSMAX=60*96000)
parameter (NFFT=32768)
real*4 dd(4,NSMAX),ss(4,322,NFFT),savg(4,NFFT)
real*8 fcenter
integer hist(0:32768)
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,datetime*20
character mycall0*12,hiscall0*12,hisgrid0*6
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
mycall,mygrid,hiscall,hisgrid,datetime
common/tracer/ limtrace,lu
data neme0/-99/,mcall3b/1/
save
call timer('decode0 ',0)
if(newdat.ne.0) then
nz=52*96000
hist=0
do i=1,nz
j1=min(abs(dd(1,i)),32768.0)
hist(j1)=hist(j1)+1
j2=min(abs(dd(2,i)),32768.0)
hist(j2)=hist(j2)+1
j3=min(abs(dd(3,i)),32768.0)
hist(j3)=hist(j3)+1
j4=min(abs(dd(4,i)),32768.0)
hist(j4)=hist(j4)+1
enddo
m=0
do i=0,32768
m=m+hist(i)
if(m.ge.2*nz) go to 10
enddo
10 rmsdd=1.5*i
endif
nhsym=279
ndphi=0
if(iand(nrxlog,8).ne.0) ndphi=1
if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. &
hisgrid.ne.hisgrid0 .or. mcall3.ne.0 .or. neme.ne.neme0) mcall3b=1
mycall0=mycall
hiscall0=hiscall
hisgrid0=hisgrid
neme0=neme
call timer('map65a ',0)
call map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
nfcal,nkeep,mcall3b,nsave,nxant,rmsdd,mycall,mygrid, &
neme,ndepth,hiscall,hisgrid,nhsym,nfsample,nxpol,mode65)
call timer('map65a ',1)
call timer('decode0 ',1)
if(nstandalone.eq.0) call timer('decode0 ',101)
return
end subroutine decode0
libm65/decode1a.f
+149 -149
View File
@@ -1,149 +1,149 @@
subroutine decode1a(dd,newdat,f0,nflip,mode65,nfsample,xpol,
+ mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,
+ nutc,nkhz,ndf,ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded)
! Apply AFC corrections to a candidate JT65 signal, then decode it.
parameter (NMAX=60*96000) !Samples per 60 s
real*4 dd(4,NMAX) !92 MB: raw data from Linrad timf2
complex cx(NMAX/64), cy(NMAX/64) !Data at 1378.125 samples/s
complex c5x(NMAX/256),c5y(NMAX/256),c5tmp(NMAX/256) !Data at 344.53125 Hz
complex c5a(512)
complex z
real s2(66,126)
real s3(64,63),sy(63)
real a(5)
logical first,xpol
character decoded*22
character mycall*12,hiscall*12,hisgrid*6
data first/.true./,jjjmin/1000/,jjjmax/-1000/
data nutc0/-999/,nkhz0/-999/
save
! Mix sync tone to baseband, low-pass filter, downsample to 1378.125 Hz
dt00=dt
call timer('filbig ',0)
call filbig(dd,NMAX,f0,newdat,nfsample,xpol,cx,cy,n5)
! NB: cx, cy have sample rate 96000*77125/5376000 = 1378.125 Hz
call timer('filbig ',1)
joff=0
sqa=0.
sqb=0.
do i=1,n5
sqa=sqa + real(cx(i))**2 + aimag(cx(i))**2
sqb=sqb + real(cy(i))**2 + aimag(cy(i))**2
enddo
sqa=sqa/n5
sqb=sqb/n5
! Find best DF, f1, f2, DT, and pol. Start by downsampling to 344.53125 Hz
z=cmplx(cos(dphi),sin(dphi))
cy(:n5)=z*cy(:n5) !Adjust for cable length difference
call timer('fil6521 ',0)
call fil6521(cx,n5,c5x,n6)
call fil6521(cy,n5,c5y,n6)
call timer('fil6521 ',1)
! Add some zeros at start of c5 arrays -- empirical fix for negative DT's
! NB: might be better to add zeros to cx and cy, rather than here.
! Q: is the DT search range big enough?
nadd=200
c5tmp(1:nadd)=0.
c5tmp(1+nadd:n6+nadd)=c5x(1:n6)
c5x(1:n6+nadd)=c5tmp(1:n6+nadd)
c5tmp(1+nadd:n6+nadd)=c5y(1:n6)
c5y(1:n6+nadd)=c5tmp(1:n6+nadd)
n6=n6+nadd
fsample=1378.125/4.
a(5)=dt00
i0=nint((a(5)+0.5)*fsample) - 2 + 200
if(i0.lt.1) then
write(13,*) 'i0 too small in decode1a:',i0,f0
flush(13)
i0=1
endif
nz=n6+1-i0
! We're looking only at sync tone here... so why not downsample by another
! factor of 1/8, say? Should be a significant execution speed-up.
call timer('afc65b ',0)
! Best fit for DF, f1, f2, pol
call afc65b(c5x(i0),c5y(i0),nz,fsample,nflip,ipol,xpol,a,
+ ccfbest,dtbest)
call timer('afc65b ',1)
pol=a(4)/57.2957795
aa=cos(pol)
bb=sin(pol)
sq0=aa*aa*sqa + bb*bb*sqb
sync2=3.7*ccfbest/sq0
! Apply AFC corrections to the time-domain signal
! Now we are back to using the 1378.125 Hz sample rate, enough to
! accommodate the full JT65C bandwidth.
call timer('twkfreq ',0)
call twkfreq(cx,cy,n5,a)
call timer('twkfreq ',1)
! Compute spectrum at best polarization for each half symbol.
! Adding or subtracting a small number (e.g., 5) to j may make it decode.\
! NB: might want to try computing full-symbol spectra (nfft=512, even for
! submodes B and C).
nsym=126
nfft=512/mode65
j=(dt00+dtbest+2.685)*1378.125 + joff
if(j.lt.0) j=0
call timer('sh_ffts ',0)
! Perhaps should try full-symbol-length FFTs even in B, C sub-modes?
! (Tried this, found no significant difference in decodes.)
do k=1,nsym
do n=1,mode65
do i=1,nfft
j=j+1
c5a(i)=aa*cx(j) + bb*cy(j)
enddo
call four2a(c5a,nfft,1,1,1)
if(n.eq.1) then
do i=1,66
s2(i,k)=real(c5a(i))**2 + aimag(c5a(i))**2
enddo
else
do i=1,66
s2(i,k)=s2(i,k) + real(c5a(i))**2 + aimag(c5a(i))**2
enddo
endif
enddo
enddo
call timer('sh_ffts ',1)
flip=nflip
call timer('dec65b ',0)
call decode65b(s2,flip,mycall,hiscall,hisgrid,mode65,neme,ndepth,
+ nqd,nkv,nhist,qual,decoded,s3,sy)
dt=dt00 + dtbest
call timer('dec65b ',1)
if(nqd.eq.1 .and. nkv.eq.0) then
if(nutc.ne.nutc0) syncbest=0.
if(sync2.gt.syncbest) then
if(nutc.eq.nutc0) nsave=nsave-1
if(nkhz.ne.nkhz0) nsave=0
nkhz0=nkhz
nsave=min(32,nsave+1)
npol=nint(57.296*pol)
call s3avg(nsave,mode65,nutc,ndf,dt+0.8,npol,s3,nkv,decoded)
syncbest=sync2
endif
nutc0=nutc
endif
return
end
subroutine decode1a(dd,newdat,f0,nflip,mode65,nfsample,xpol,
+ mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,
+ nutc,nkhz,ndf,ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded)
! Apply AFC corrections to a candidate JT65 signal, then decode it.
parameter (NMAX=60*96000) !Samples per 60 s
real*4 dd(4,NMAX) !92 MB: raw data from Linrad timf2
complex cx(NMAX/64), cy(NMAX/64) !Data at 1378.125 samples/s
complex c5x(NMAX/256),c5y(NMAX/256),c5tmp(NMAX/256) !Data at 344.53125 Hz
complex c5a(512)
complex z
real s2(66,126)
real s3(64,63),sy(63)
real a(5)
logical first,xpol
character decoded*22
character mycall*12,hiscall*12,hisgrid*6
data first/.true./,jjjmin/1000/,jjjmax/-1000/
data nutc0/-999/,nkhz0/-999/
save
! Mix sync tone to baseband, low-pass filter, downsample to 1378.125 Hz
dt00=dt
call timer('filbig ',0)
call filbig(dd,NMAX,f0,newdat,nfsample,xpol,cx,cy,n5)
! NB: cx, cy have sample rate 96000*77125/5376000 = 1378.125 Hz
call timer('filbig ',1)
joff=0
sqa=0.
sqb=0.
do i=1,n5
sqa=sqa + real(cx(i))**2 + aimag(cx(i))**2
sqb=sqb + real(cy(i))**2 + aimag(cy(i))**2
enddo
sqa=sqa/n5
sqb=sqb/n5
! Find best DF, f1, f2, DT, and pol. Start by downsampling to 344.53125 Hz
z=cmplx(cos(dphi),sin(dphi))
cy(:n5)=z*cy(:n5) !Adjust for cable length difference
call timer('fil6521 ',0)
call fil6521(cx,n5,c5x,n6)
call fil6521(cy,n5,c5y,n6)
call timer('fil6521 ',1)
! Add some zeros at start of c5 arrays -- empirical fix for negative DT's
! NB: might be better to add zeros to cx and cy, rather than here.
! Q: is the DT search range big enough?
nadd=200
c5tmp(1:nadd)=0.
c5tmp(1+nadd:n6+nadd)=c5x(1:n6)
c5x(1:n6+nadd)=c5tmp(1:n6+nadd)
c5tmp(1+nadd:n6+nadd)=c5y(1:n6)
c5y(1:n6+nadd)=c5tmp(1:n6+nadd)
n6=n6+nadd
fsample=1378.125/4.
a(5)=dt00
i0=nint((a(5)+0.5)*fsample) - 2 + 200
if(i0.lt.1) then
write(13,*) 'i0 too small in decode1a:',i0,f0
flush(13)
i0=1
endif
nz=n6+1-i0
! We're looking only at sync tone here... so why not downsample by another
! factor of 1/8, say? Should be a significant execution speed-up.
call timer('afc65b ',0)
! Best fit for DF, f1, f2, pol
call afc65b(c5x(i0),c5y(i0),nz,fsample,nflip,ipol,xpol,a,
+ ccfbest,dtbest)
call timer('afc65b ',1)
pol=a(4)/57.2957795
aa=cos(pol)
bb=sin(pol)
sq0=aa*aa*sqa + bb*bb*sqb
sync2=3.7*ccfbest/sq0
! Apply AFC corrections to the time-domain signal
! Now we are back to using the 1378.125 Hz sample rate, enough to
! accommodate the full JT65C bandwidth.
call timer('twkfreq ',0)
call twkfreq(cx,cy,n5,a)
call timer('twkfreq ',1)
! Compute spectrum at best polarization for each half symbol.
! Adding or subtracting a small number (e.g., 5) to j may make it decode.\
! NB: might want to try computing full-symbol spectra (nfft=512, even for
! submodes B and C).
nsym=126
nfft=512/mode65
j=(dt00+dtbest+2.685)*1378.125 + joff
if(j.lt.0) j=0
call timer('sh_ffts ',0)
! Perhaps should try full-symbol-length FFTs even in B, C sub-modes?
! (Tried this, found no significant difference in decodes.)
do k=1,nsym
do n=1,mode65
do i=1,nfft
j=j+1
c5a(i)=aa*cx(j) + bb*cy(j)
enddo
call four2a(c5a,nfft,1,1,1)
if(n.eq.1) then
do i=1,66
s2(i,k)=real(c5a(i))**2 + aimag(c5a(i))**2
enddo
else
do i=1,66
s2(i,k)=s2(i,k) + real(c5a(i))**2 + aimag(c5a(i))**2
enddo
endif
enddo
enddo
call timer('sh_ffts ',1)
flip=nflip
call timer('dec65b ',0)
call decode65b(s2,flip,mycall,hiscall,hisgrid,mode65,neme,ndepth,
+ nqd,nkv,nhist,qual,decoded,s3,sy)
dt=dt00 + dtbest
call timer('dec65b ',1)
if(nqd.eq.1 .and. nkv.eq.0) then
if(nutc.ne.nutc0) syncbest=0.
if(sync2.gt.syncbest) then
if(nutc.eq.nutc0) nsave=nsave-1
if(nkhz.ne.nkhz0) nsave=0
nkhz0=nkhz
nsave=min(32,nsave+1)
npol=nint(57.296*pol)
call s3avg(nsave,mode65,nutc,ndf,dt+0.8,npol,s3,nkv,decoded)
syncbest=sync2
endif
nutc0=nutc
endif
return
end
libm65/decode65b.f
+49 -49
View File
@@ -1,49 +1,49 @@
subroutine decode65b(s2,flip,mycall,hiscall,hisgrid,mode65,
+ neme,ndepth,nqd,nkv,nhist,qual,decoded,s3,sy)
real s2(66,126)
real s3(64,63),sy(63)
logical first,ltext
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
common/prcom/pr(126),mdat(126),mref(126,2),mdat2(126),mref2(126,2)
data first/.true./
save
if(first) call setup65
first=.false.
do j=1,63
k=mdat(j) !Points to data symbol
if(flip.lt.0.0) k=mdat2(j)
do i=1,64
s3(i,j)=s2(i+2,k)
enddo
k=mdat2(j) !Points to data symbol
if(flip.lt.0.0) k=mdat(j)
sy(j)=s2(1,k)
enddo
nadd=mode65
call extract(s3,nadd,ncount,nhist,decoded,ltext) !Extract the message
C Suppress "birdie messages" and other garbage decodes:
if(decoded(1:7).eq.'000AAA ') ncount=-1
if(decoded(1:7).eq.'0L6MWK ') ncount=-1
if(flip.lt.0.0 .and. ltext) ncount=-1
nkv=1
if(ncount.lt.0) then
nkv=0
decoded=' '
endif
qual=0.
if(ndepth.ge.1 .and. (nqd.eq.1 .or. flip.eq.1.0)) then
call deep65(s3,mode65,neme,flip,mycall,hiscall,
+ hisgrid,deepmsg,qual)
if(nqd.ne.1 .and. qual.lt.10.0) qual=0.0
if(ndepth.lt.2 .and. qual.lt.6.0) qual=0.0
endif
if(nkv.eq.0 .and. qual.ge.1.0) decoded=deepmsg
return
end
subroutine decode65b(s2,flip,mycall,hiscall,hisgrid,mode65,
+ neme,ndepth,nqd,nkv,nhist,qual,decoded,s3,sy)
real s2(66,126)
real s3(64,63),sy(63)
logical first,ltext
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
common/prcom/pr(126),mdat(126),mref(126,2),mdat2(126),mref2(126,2)
data first/.true./
save
if(first) call setup65
first=.false.
do j=1,63
k=mdat(j) !Points to data symbol
if(flip.lt.0.0) k=mdat2(j)
do i=1,64
s3(i,j)=s2(i+2,k)
enddo
k=mdat2(j) !Points to data symbol
if(flip.lt.0.0) k=mdat(j)
sy(j)=s2(1,k)
enddo
nadd=mode65
call extract(s3,nadd,ncount,nhist,decoded,ltext) !Extract the message
C Suppress "birdie messages" and other garbage decodes:
if(decoded(1:7).eq.'000AAA ') ncount=-1
if(decoded(1:7).eq.'0L6MWK ') ncount=-1
if(flip.lt.0.0 .and. ltext) ncount=-1
nkv=1
if(ncount.lt.0) then
nkv=0
decoded=' '
endif
qual=0.
if(ndepth.ge.1 .and. (nqd.eq.1 .or. flip.eq.1.0)) then
call deep65(s3,mode65,neme,flip,mycall,hiscall,
+ hisgrid,deepmsg,qual)
if(nqd.ne.1 .and. qual.lt.10.0) qual=0.0
if(ndepth.lt.2 .and. qual.lt.6.0) qual=0.0
endif
if(nkv.eq.0 .and. qual.ge.1.0) decoded=deepmsg
return
end
libm65/decode_rs.c
+263 -263
View File
@@ -1,263 +1,263 @@
/* Reed-Solomon decoder
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#ifdef DEBUG
#include <stdio.h>
#endif
#include <string.h>
#define NULL ((void *)0)
#define min(a,b) ((a) < (b) ? (a) : (b))
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
int DECODE_RS(
#ifdef FIXED
DTYPE *data, int *eras_pos, int no_eras,int pad){
#else
void *p,DTYPE *data, int *eras_pos, int no_eras){
struct rs *rs = (struct rs *)p;
#endif
int deg_lambda, el, deg_omega;
int i, j, r,k;
DTYPE u,q,tmp,num1,num2,den,discr_r;
DTYPE lambda[NROOTS+1], s[NROOTS]; /* Err+Eras Locator poly
* and syndrome poly */
DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1];
DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS];
int syn_error, count;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return -1;
#endif
/* form the syndromes; i.e., evaluate data(x) at roots of g(x) */
for(i=0;i<NROOTS;i++)
s[i] = data[0];
for(j=1;j<NN-PAD;j++){
for(i=0;i<NROOTS;i++){
if(s[i] == 0){
s[i] = data[j];
} else {
s[i] = data[j] ^ ALPHA_TO[MODNN(INDEX_OF[s[i]] + (FCR+i)*PRIM)];
}
}
}
/* Convert syndromes to index form, checking for nonzero condition */
syn_error = 0;
for(i=0;i<NROOTS;i++){
syn_error |= s[i];
s[i] = INDEX_OF[s[i]];
}
if (!syn_error) {
/* if syndrome is zero, data[] is a codeword and there are no
* errors to correct. So return data[] unmodified
*/
count = 0;
goto finish;
}
memset(&lambda[1],0,NROOTS*sizeof(lambda[0]));
lambda[0] = 1;
if (no_eras > 0) {
/* Init lambda to be the erasure locator polynomial */
lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))];
for (i = 1; i < no_eras; i++) {
u = MODNN(PRIM*(NN-1-eras_pos[i]));
for (j = i+1; j > 0; j--) {
tmp = INDEX_OF[lambda[j - 1]];
if(tmp != A0)
lambda[j] ^= ALPHA_TO[MODNN(u + tmp)];
}
}
#if DEBUG >= 1
/* Test code that verifies the erasure locator polynomial just constructed
Needed only for decoder debugging. */
/* find roots of the erasure location polynomial */
for(i=1;i<=no_eras;i++)
reg[i] = INDEX_OF[lambda[i]];
count = 0;
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1;
for (j = 1; j <= no_eras; j++)
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
if (q != 0)
continue;
/* store root and error location number indices */
root[count] = i;
loc[count] = k;
count++;
}
if (count != no_eras) {
printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras);
count = -1;
goto finish;
}
#if DEBUG >= 2
printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n");
for (i = 0; i < count; i++)
printf("%d ", loc[i]);
printf("\n");
#endif
#endif
}
for(i=0;i<NROOTS+1;i++)
// printf("%d %d %d\n",i,lambda[i],INDEX_OF[lambda[i]]);
b[i] = INDEX_OF[lambda[i]];
/*
* Begin Berlekamp-Massey algorithm to determine error+erasure
* locator polynomial
*/
r = no_eras;
el = no_eras;
while (++r <= NROOTS) { /* r is the step number */
/* Compute discrepancy at the r-th step in poly-form */
discr_r = 0;
for (i = 0; i < r; i++){
if ((lambda[i] != 0) && (s[r-i-1] != A0)) {
discr_r ^= ALPHA_TO[MODNN(INDEX_OF[lambda[i]] + s[r-i-1])];
}
}
discr_r = INDEX_OF[discr_r]; /* Index form */
if (discr_r == A0) {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
} else {
/* 7 lines below: T(x) <-- lambda(x) - discr_r*x*b(x) */
t[0] = lambda[0];
for (i = 0 ; i < NROOTS; i++) {
if(b[i] != A0)
t[i+1] = lambda[i+1] ^ ALPHA_TO[MODNN(discr_r + b[i])];
else
t[i+1] = lambda[i+1];
}
if (2 * el <= r + no_eras - 1) {
el = r + no_eras - el;
/*
* 2 lines below: B(x) <-- inv(discr_r) *
* lambda(x)
*/
for (i = 0; i <= NROOTS; i++)
b[i] = (lambda[i] == 0) ? A0 : MODNN(INDEX_OF[lambda[i]] - discr_r + NN);
} else {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
}
memcpy(lambda,t,(NROOTS+1)*sizeof(t[0]));
}
}
/* Convert lambda to index form and compute deg(lambda(x)) */
deg_lambda = 0;
for(i=0;i<NROOTS+1;i++){
lambda[i] = INDEX_OF[lambda[i]];
if(lambda[i] != A0)
deg_lambda = i;
}
/* Find roots of the error+erasure locator polynomial by Chien search */
memcpy(&reg[1],&lambda[1],NROOTS*sizeof(reg[0]));
count = 0; /* Number of roots of lambda(x) */
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1; /* lambda[0] is always 0 */
for (j = deg_lambda; j > 0; j--){
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
}
if (q != 0)
continue; /* Not a root */
/* store root (index-form) and error location number */
#if DEBUG>=2
printf("count %d root %d loc %d\n",count,i,k);
#endif
root[count] = i;
loc[count] = k;
/* If we've already found max possible roots,
* abort the search to save time
*/
if(++count == deg_lambda)
break;
}
if (deg_lambda != count) {
/*
* deg(lambda) unequal to number of roots => uncorrectable
* error detected
*/
count = -1;
goto finish;
}
/*
* Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo
* x**NROOTS). in index form. Also find deg(omega).
*/
deg_omega = deg_lambda-1;
for (i = 0; i <= deg_omega;i++){
tmp = 0;
for(j=i;j >= 0; j--){
if ((s[i - j] != A0) && (lambda[j] != A0))
tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])];
}
omega[i] = INDEX_OF[tmp];
}
/*
* Compute error values in poly-form. num1 = omega(inv(X(l))), num2 =
* inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form
*/
for (j = count-1; j >=0; j--) {
num1 = 0;
for (i = deg_omega; i >= 0; i--) {
if (omega[i] != A0)
num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])];
}
num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)];
den = 0;
/* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */
for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) {
if(lambda[i+1] != A0)
den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])];
}
#if DEBUG >= 1
if (den == 0) {
printf("\n ERROR: denominator = 0\n");
count = -1;
goto finish;
}
#endif
/* Apply error to data */
if (num1 != 0 && loc[j] >= PAD) {
data[loc[j]-PAD] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])];
}
}
finish:
if(eras_pos != NULL){
for(i=0;i<count;i++)
eras_pos[i] = loc[i];
}
return count;
}
/* Reed-Solomon decoder
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#ifdef DEBUG
#include <stdio.h>
#endif
#include <string.h>
#define NULL ((void *)0)
#define min(a,b) ((a) < (b) ? (a) : (b))
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
int DECODE_RS(
#ifdef FIXED
DTYPE *data, int *eras_pos, int no_eras,int pad){
#else
void *p,DTYPE *data, int *eras_pos, int no_eras){
struct rs *rs = (struct rs *)p;
#endif
int deg_lambda, el, deg_omega;
int i, j, r,k;
DTYPE u,q,tmp,num1,num2,den,discr_r;
DTYPE lambda[NROOTS+1], s[NROOTS]; /* Err+Eras Locator poly
* and syndrome poly */
DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1];
DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS];
int syn_error, count;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return -1;
#endif
/* form the syndromes; i.e., evaluate data(x) at roots of g(x) */
for(i=0;i<NROOTS;i++)
s[i] = data[0];
for(j=1;j<NN-PAD;j++){
for(i=0;i<NROOTS;i++){
if(s[i] == 0){
s[i] = data[j];
} else {
s[i] = data[j] ^ ALPHA_TO[MODNN(INDEX_OF[s[i]] + (FCR+i)*PRIM)];
}
}
}
/* Convert syndromes to index form, checking for nonzero condition */
syn_error = 0;
for(i=0;i<NROOTS;i++){
syn_error |= s[i];
s[i] = INDEX_OF[s[i]];
}
if (!syn_error) {
/* if syndrome is zero, data[] is a codeword and there are no
* errors to correct. So return data[] unmodified
*/
count = 0;
goto finish;
}
memset(&lambda[1],0,NROOTS*sizeof(lambda[0]));
lambda[0] = 1;
if (no_eras > 0) {
/* Init lambda to be the erasure locator polynomial */
lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))];
for (i = 1; i < no_eras; i++) {
u = MODNN(PRIM*(NN-1-eras_pos[i]));
for (j = i+1; j > 0; j--) {
tmp = INDEX_OF[lambda[j - 1]];
if(tmp != A0)
lambda[j] ^= ALPHA_TO[MODNN(u + tmp)];
}
}
#if DEBUG >= 1
/* Test code that verifies the erasure locator polynomial just constructed
Needed only for decoder debugging. */
/* find roots of the erasure location polynomial */
for(i=1;i<=no_eras;i++)
reg[i] = INDEX_OF[lambda[i]];
count = 0;
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1;
for (j = 1; j <= no_eras; j++)
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
if (q != 0)
continue;
/* store root and error location number indices */
root[count] = i;
loc[count] = k;
count++;
}
if (count != no_eras) {
printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras);
count = -1;
goto finish;
}
#if DEBUG >= 2
printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n");
for (i = 0; i < count; i++)
printf("%d ", loc[i]);
printf("\n");
#endif
#endif
}
for(i=0;i<NROOTS+1;i++)
// printf("%d %d %d\n",i,lambda[i],INDEX_OF[lambda[i]]);
b[i] = INDEX_OF[lambda[i]];
/*
* Begin Berlekamp-Massey algorithm to determine error+erasure
* locator polynomial
*/
r = no_eras;
el = no_eras;
while (++r <= NROOTS) { /* r is the step number */
/* Compute discrepancy at the r-th step in poly-form */
discr_r = 0;
for (i = 0; i < r; i++){
if ((lambda[i] != 0) && (s[r-i-1] != A0)) {
discr_r ^= ALPHA_TO[MODNN(INDEX_OF[lambda[i]] + s[r-i-1])];
}
}
discr_r = INDEX_OF[discr_r]; /* Index form */
if (discr_r == A0) {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
} else {
/* 7 lines below: T(x) <-- lambda(x) - discr_r*x*b(x) */
t[0] = lambda[0];
for (i = 0 ; i < NROOTS; i++) {
if(b[i] != A0)
t[i+1] = lambda[i+1] ^ ALPHA_TO[MODNN(discr_r + b[i])];
else
t[i+1] = lambda[i+1];
}
if (2 * el <= r + no_eras - 1) {
el = r + no_eras - el;
/*
* 2 lines below: B(x) <-- inv(discr_r) *
* lambda(x)
*/
for (i = 0; i <= NROOTS; i++)
b[i] = (lambda[i] == 0) ? A0 : MODNN(INDEX_OF[lambda[i]] - discr_r + NN);
} else {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
}
memcpy(lambda,t,(NROOTS+1)*sizeof(t[0]));
}
}
/* Convert lambda to index form and compute deg(lambda(x)) */
deg_lambda = 0;
for(i=0;i<NROOTS+1;i++){
lambda[i] = INDEX_OF[lambda[i]];
if(lambda[i] != A0)
deg_lambda = i;
}
/* Find roots of the error+erasure locator polynomial by Chien search */
memcpy(&reg[1],&lambda[1],NROOTS*sizeof(reg[0]));
count = 0; /* Number of roots of lambda(x) */
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1; /* lambda[0] is always 0 */
for (j = deg_lambda; j > 0; j--){
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
}
if (q != 0)
continue; /* Not a root */
/* store root (index-form) and error location number */
#if DEBUG>=2
printf("count %d root %d loc %d\n",count,i,k);
#endif
root[count] = i;
loc[count] = k;
/* If we've already found max possible roots,
* abort the search to save time
*/
if(++count == deg_lambda)
break;
}
if (deg_lambda != count) {
/*
* deg(lambda) unequal to number of roots => uncorrectable
* error detected
*/
count = -1;
goto finish;
}
/*
* Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo
* x**NROOTS). in index form. Also find deg(omega).
*/
deg_omega = deg_lambda-1;
for (i = 0; i <= deg_omega;i++){
tmp = 0;
for(j=i;j >= 0; j--){
if ((s[i - j] != A0) && (lambda[j] != A0))
tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])];
}
omega[i] = INDEX_OF[tmp];
}
/*
* Compute error values in poly-form. num1 = omega(inv(X(l))), num2 =
* inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form
*/
for (j = count-1; j >=0; j--) {
num1 = 0;
for (i = deg_omega; i >= 0; i--) {
if (omega[i] != A0)
num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])];
}
num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)];
den = 0;
/* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */
for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) {
if(lambda[i+1] != A0)
den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])];
}
#if DEBUG >= 1
if (den == 0) {
printf("\n ERROR: denominator = 0\n");
count = -1;
goto finish;
}
#endif
/* Apply error to data */
if (num1 != 0 && loc[j] >= PAD) {
data[loc[j]-PAD] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])];
}
}
finish:
if(eras_pos != NULL){
for(i=0;i<count;i++)
eras_pos[i] = loc[i];
}
return count;
}
libm65/deep65.f90
+169 -169
View File
@@ -1,169 +1,169 @@
subroutine deep65(s3,mode65,neme,flip,mycall,hiscall,hisgrid,decoded,qual)
parameter (MAXCALLS=7000,MAXRPT=63)
real s3(64,63)
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
character*12 mycall,hiscall
character*22 decoded
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*180 line
character*4 rpt(MAXRPT)
integer ncode(63,2*MAXCALLS + 2 + MAXRPT)
real pp(2*MAXCALLS + 2 + MAXRPT)
common/mrscom/ mrs(63),mrs2(63)
common/c3com/ mcall3a
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(mcall3a.eq.0) go to 30
call timer('deep65a ',0)
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 encode65(message,ncode(1,k))
! Insert CQ message
if(j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
enddo
10 continue
enddo
20 continue
ntot=k
call timer('deep65a ',1)
30 continue
call timer('deep65b ',0)
ref0=0.
do j=1,63
ref0=ref0 + s3(mrs(j),j)
enddo
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
sum=0.
ref=ref0
do j=1,63
i=ncode(j,k)+1
sum=sum + s3(i,j)
if(i.eq.mrs(j)) ref=ref - s3(i,j) + s3(mrs2(j),j)
enddo
p=sum/ref
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.
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 deep65'
qual=100.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
call timer('deep65b ',1)
return
end subroutine deep65
subroutine deep65(s3,mode65,neme,flip,mycall,hiscall,hisgrid,decoded,qual)
parameter (MAXCALLS=7000,MAXRPT=63)
real s3(64,63)
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
character*12 mycall,hiscall
character*22 decoded
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*180 line
character*4 rpt(MAXRPT)
integer ncode(63,2*MAXCALLS + 2 + MAXRPT)
real pp(2*MAXCALLS + 2 + MAXRPT)
common/mrscom/ mrs(63),mrs2(63)
common/c3com/ mcall3a
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(mcall3a.eq.0) go to 30
call timer('deep65a ',0)
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 encode65(message,ncode(1,k))
! Insert CQ message
if(j4.lt.1) callgrid(icall)=callsign(1:j2)//' '//grid
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
enddo
10 continue
enddo
20 continue
ntot=k
call timer('deep65a ',1)
30 continue
call timer('deep65b ',0)
ref0=0.
do j=1,63
ref0=ref0 + s3(mrs(j),j)
enddo
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
sum=0.
ref=ref0
do j=1,63
i=ncode(j,k)+1
sum=sum + s3(i,j)
if(i.eq.mrs(j)) ref=ref - s3(i,j) + s3(mrs2(j),j)
enddo
p=sum/ref
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.
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 deep65'
qual=100.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
call timer('deep65b ',1)
return
end subroutine deep65
libm65/deg2grid.f
+30 -30
View File
@@ -1,30 +1,30 @@
subroutine deg2grid(dlong0,dlat,grid)
real dlong !West longitude (deg)
real dlat !Latitude (deg)
character grid*6
dlong=dlong0
if(dlong.lt.-180.0) dlong=dlong+360.0
if(dlong.gt.180.0) dlong=dlong-360.0
C Convert to units of 5 min of longitude, working east from 180 deg.
nlong=60.0*(180.0-dlong)/5.0
n1=nlong/240 !20-degree field
n2=(nlong-240*n1)/24 !2 degree square
n3=nlong-240*n1-24*n2 !5 minute subsquare
grid(1:1)=char(ichar('A')+n1)
grid(3:3)=char(ichar('0')+n2)
grid(5:5)=char(ichar('a')+n3)
C Convert to units of 2.5 min of latitude, working north from -90 deg.
nlat=60.0*(dlat+90)/2.5
n1=nlat/240 !10-degree field
n2=(nlat-240*n1)/24 !1 degree square
n3=nlat-240*n1-24*n2 !2.5 minuts subsquare
grid(2:2)=char(ichar('A')+n1)
grid(4:4)=char(ichar('0')+n2)
grid(6:6)=char(ichar('a')+n3)
return
end
subroutine deg2grid(dlong0,dlat,grid)
real dlong !West longitude (deg)
real dlat !Latitude (deg)
character grid*6
dlong=dlong0
if(dlong.lt.-180.0) dlong=dlong+360.0
if(dlong.gt.180.0) dlong=dlong-360.0
C Convert to units of 5 min of longitude, working east from 180 deg.
nlong=60.0*(180.0-dlong)/5.0
n1=nlong/240 !20-degree field
n2=(nlong-240*n1)/24 !2 degree square
n3=nlong-240*n1-24*n2 !5 minute subsquare
grid(1:1)=char(ichar('A')+n1)
grid(3:3)=char(ichar('0')+n2)
grid(5:5)=char(ichar('a')+n3)
C Convert to units of 2.5 min of latitude, working north from -90 deg.
nlat=60.0*(dlat+90)/2.5
n1=nlat/240 !10-degree field
n2=(nlat-240*n1)/24 !1 degree square
n3=nlat-240*n1-24*n2 !2.5 minuts subsquare
grid(2:2)=char(ichar('A')+n1)
grid(4:4)=char(ichar('0')+n2)
grid(6:6)=char(ichar('a')+n3)
return
end
libm65/demod64a.f
+73 -73
View File
@@ -1,73 +1,73 @@
subroutine demod64a(s3,nadd,mrsym,mrprob,
+ mr2sym,mr2prob,ntest,nlow)
C Demodulate the 64-bin spectra for each of 63 symbols in a frame.
C Parameters
C nadd number of spectra already summed
C mrsym most reliable symbol value
C mr2sym second most likely symbol value
C mrprob probability that mrsym was the transmitted value
C mr2prob probability that mr2sym was the transmitted value
implicit real*8 (a-h,o-z)
real*4 s3(64,63)
real*8 fs(64)
integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63)
common/mrscom/ mrs(63),mrs2(63)
afac=1.1 * float(nadd)**0.64
scale=255.999
C Compute average spectral value
sum=0.
do j=1,63
do i=1,64
sum=sum+s3(i,j)
enddo
enddo
ave=sum/(64.*63.)
i1=1 !Silence warning
i2=1
C Compute probabilities for most reliable symbol values
do j=1,63
s1=-1.e30
fsum=0.
do i=1,64
x=min(afac*s3(i,j)/ave,50.d0)
fs(i)=exp(x)
fsum=fsum+fs(i)
if(s3(i,j).gt.s1) then
s1=s3(i,j)
i1=i !Most reliable
endif
enddo
s2=-1.e30
do i=1,64
if(i.ne.i1 .and. s3(i,j).gt.s2) then
s2=s3(i,j)
i2=i !Second most reliable
endif
enddo
p1=fs(i1)/fsum !Normalized probabilities
p2=fs(i2)/fsum
mrsym(j)=i1-1
mr2sym(j)=i2-1
mrprob(j)=scale*p1
mr2prob(j)=scale*p2
mrs(j)=i1
mrs2(j)=i2
enddo
sum=0.
nlow=0
do j=1,63
sum=sum+mrprob(j)
if(mrprob(j).le.5) nlow=nlow+1
enddo
ntest=sum/63
return
end
subroutine demod64a(s3,nadd,mrsym,mrprob,
+ mr2sym,mr2prob,ntest,nlow)
C Demodulate the 64-bin spectra for each of 63 symbols in a frame.
C Parameters
C nadd number of spectra already summed
C mrsym most reliable symbol value
C mr2sym second most likely symbol value
C mrprob probability that mrsym was the transmitted value
C mr2prob probability that mr2sym was the transmitted value
implicit real*8 (a-h,o-z)
real*4 s3(64,63)
real*8 fs(64)
integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63)
common/mrscom/ mrs(63),mrs2(63)
afac=1.1 * float(nadd)**0.64
scale=255.999
C Compute average spectral value
sum=0.
do j=1,63
do i=1,64
sum=sum+s3(i,j)
enddo
enddo
ave=sum/(64.*63.)
i1=1 !Silence warning
i2=1
C Compute probabilities for most reliable symbol values
do j=1,63
s1=-1.e30
fsum=0.
do i=1,64
x=min(afac*s3(i,j)/ave,50.d0)
fs(i)=exp(x)
fsum=fsum+fs(i)
if(s3(i,j).gt.s1) then
s1=s3(i,j)
i1=i !Most reliable
endif
enddo
s2=-1.e30
do i=1,64
if(i.ne.i1 .and. s3(i,j).gt.s2) then
s2=s3(i,j)
i2=i !Second most reliable
endif
enddo
p1=fs(i1)/fsum !Normalized probabilities
p2=fs(i2)/fsum
mrsym(j)=i1-1
mr2sym(j)=i2-1
mrprob(j)=scale*p1
mr2prob(j)=scale*p2
mrs(j)=i1
mrs2(j)=i2
enddo
sum=0.
nlow=0
do j=1,63
sum=sum+mrprob(j)
if(mrprob(j).le.5) nlow=nlow+1
enddo
ntest=sum/63
return
end
libm65/display.f90
+169 -169
View File
@@ -1,169 +1,169 @@
subroutine display(nkeep,ftol)
parameter (MAXLINES=400,MX=400)
integer indx(MAXLINES),indx2(MX)
character*81 line(MAXLINES),line2(MX),line3(MAXLINES)
character out*50,cfreq0*3,cqlive*52
character*6 callsign,callsign0
character*12 freqcall(100)
real freqkHz(MAXLINES)
integer utc(MAXLINES),utc2(MX),utcz
real*8 f0
rewind 26
do i=1,MAXLINES
read(26,1010,end=10) line(i)
1010 format(a80)
read(line(i),1020) f0,ndf,nh,nm
1020 format(f8.3,i5,25x,i3,i2)
utc(i)=60*nh + nm
freqkHz(i)=1000.d0*(f0-144.d0) + 0.001d0*ndf
enddo
10 nz=i-1
utcz=utc(nz)
nz=nz-1
if(nz.lt.1) go to 999
nquad=max(nkeep/4,3)
do i=1,nz
nage=utcz-utc(i)
if(nage.lt.0) nage=nage+1440
iage=nage/nquad
write(line(i)(80:81),1021) iage
1021 format(i2)
enddo
nage=utcz-utc(1)
if(nage.lt.0) nage=nage+1440
if(nage.gt.nkeep) then
do i=1,nz
nage=utcz-utc(i)
if(nage.lt.0) nage=nage+1440
if(nage.le.nkeep) go to 20
enddo
20 i0=i
nz=nz-i0+1
rewind 26
if(nz.lt.1) go to 999
do i=1,nz
j=i+i0-1
line(i)=line(j)
utc(i)=utc(j)
freqkHz(i)=freqkHz(j)
write(26,1010) line(i)
enddo
endif
call flush(26)
call indexx(nz,freqkHz,indx)
nstart=1
k3=0
k=1
m=indx(1)
if(m.lt.1 .or. m.gt.MAXLINES) then
print*,'Error in display.f90: ',nz,m
m=1
endif
line2(1)=line(m)
utc2(1)=utc(m)
do i=2,nz
j0=indx(i-1)
j=indx(i)
if(freqkHz(j)-freqkHz(j0).gt.2.0*ftol) then
if(nstart.eq.0) then
k=k+1
line2(k)=""
utc2(k)=-1
endif
kz=k
if(nstart.eq.1) then
call indexx(kz,utc2,indx2)
k3=0
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
nstart=0
else
call indexx(kz,utc2,indx2)
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
endif
k=0
endif
if(i.eq.nz) then
k=k+1
line2(k)=""
utc2(k)=-1
endif
k=k+1
line2(k)=line(j)
utc2(k)=utc(j)
j0=j
enddo
kz=k
call indexx(kz,utc2,indx2)
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
rewind 19
rewind 20
cfreq0=' '
nc=0
callsign0=' '
do k=1,k3
out=line3(k)(6:13)//line3(k)(28:31)//line3(k)(39:43)// &
line3(k)(35:38)//line3(k)(44:67)//line3(k)(77:81)
if(out(1:3).ne.' ') then
cfreq0=out(1:3)
if(iw.lt.MAXLINES-1) iw=iw+1
cqlive=line3(k)(6:13)//line3(k)(28:31)//line3(k)(39:43)// &
line3(k)(23:27)//line3(k)(35:38)//line3(k)(44:67)// &
line3(k)(80:81)
if(index(cqlive,' CQ ').gt.0 .or. index(cqlive,' QRZ ').gt.0 .or. &
index(cqlive,' QRT ').gt.0 .or. index(cqlive,' CQV ').gt.0 .or. &
index(cqlive,' CQH ').gt.0) write(19,1029) cqlive
1029 format(a52)
write(*,1030) out
1030 format('@',a50)
i1=index(out(24:),' ')
callsign=out(i1+24:)
i2=index(callsign,' ')
if(i2.gt.1) callsign(i2:)=' '
if(callsign.ne.' ' .and. callsign.ne.callsign0) then
len=i2-1
if(len.lt.0) len=6
if(len.ge.4) then !Omit short "callsigns"
nc=nc+1
freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81)
callsign0=callsign
endif
endif
if(callsign.ne.' ' .and. callsign.eq.callsign0) then
freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81)
endif
endif
enddo
flush(19)
nc=nc+1
freqcall(nc)=' '
nc=nc+1
freqcall(nc)=' '
freqcall(nc+1)=' '
freqcall(nc+2)=' '
iz=(nc+2)/3
do i=1,nc
write(*,1042) freqcall(i)
1042 format('&',a12)
enddo
999 continue
return
end subroutine display
subroutine display(nkeep,ftol)
parameter (MAXLINES=400,MX=400)
integer indx(MAXLINES),indx2(MX)
character*81 line(MAXLINES),line2(MX),line3(MAXLINES)
character out*50,cfreq0*3,cqlive*52
character*6 callsign,callsign0
character*12 freqcall(100)
real freqkHz(MAXLINES)
integer utc(MAXLINES),utc2(MX),utcz
real*8 f0
rewind 26
do i=1,MAXLINES
read(26,1010,end=10) line(i)
1010 format(a80)
read(line(i),1020) f0,ndf,nh,nm
1020 format(f8.3,i5,25x,i3,i2)
utc(i)=60*nh + nm
freqkHz(i)=1000.d0*(f0-144.d0) + 0.001d0*ndf
enddo
10 nz=i-1
utcz=utc(nz)
nz=nz-1
if(nz.lt.1) go to 999
nquad=max(nkeep/4,3)
do i=1,nz
nage=utcz-utc(i)
if(nage.lt.0) nage=nage+1440
iage=nage/nquad
write(line(i)(80:81),1021) iage
1021 format(i2)
enddo
nage=utcz-utc(1)
if(nage.lt.0) nage=nage+1440
if(nage.gt.nkeep) then
do i=1,nz
nage=utcz-utc(i)
if(nage.lt.0) nage=nage+1440
if(nage.le.nkeep) go to 20
enddo
20 i0=i
nz=nz-i0+1
rewind 26
if(nz.lt.1) go to 999
do i=1,nz
j=i+i0-1
line(i)=line(j)
utc(i)=utc(j)
freqkHz(i)=freqkHz(j)
write(26,1010) line(i)
enddo
endif
call flush(26)
call indexx(nz,freqkHz,indx)
nstart=1
k3=0
k=1
m=indx(1)
if(m.lt.1 .or. m.gt.MAXLINES) then
print*,'Error in display.f90: ',nz,m
m=1
endif
line2(1)=line(m)
utc2(1)=utc(m)
do i=2,nz
j0=indx(i-1)
j=indx(i)
if(freqkHz(j)-freqkHz(j0).gt.2.0*ftol) then
if(nstart.eq.0) then
k=k+1
line2(k)=""
utc2(k)=-1
endif
kz=k
if(nstart.eq.1) then
call indexx(kz,utc2,indx2)
k3=0
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
nstart=0
else
call indexx(kz,utc2,indx2)
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
endif
k=0
endif
if(i.eq.nz) then
k=k+1
line2(k)=""
utc2(k)=-1
endif
k=k+1
line2(k)=line(j)
utc2(k)=utc(j)
j0=j
enddo
kz=k
call indexx(kz,utc2,indx2)
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
rewind 19
rewind 20
cfreq0=' '
nc=0
callsign0=' '
do k=1,k3
out=line3(k)(6:13)//line3(k)(28:31)//line3(k)(39:43)// &
line3(k)(35:38)//line3(k)(44:67)//line3(k)(77:81)
if(out(1:3).ne.' ') then
cfreq0=out(1:3)
if(iw.lt.MAXLINES-1) iw=iw+1
cqlive=line3(k)(6:13)//line3(k)(28:31)//line3(k)(39:43)// &
line3(k)(23:27)//line3(k)(35:38)//line3(k)(44:67)// &
line3(k)(80:81)
if(index(cqlive,' CQ ').gt.0 .or. index(cqlive,' QRZ ').gt.0 .or. &
index(cqlive,' QRT ').gt.0 .or. index(cqlive,' CQV ').gt.0 .or. &
index(cqlive,' CQH ').gt.0) write(19,1029) cqlive
1029 format(a52)
write(*,1030) out
1030 format('@',a50)
i1=index(out(24:),' ')
callsign=out(i1+24:)
i2=index(callsign,' ')
if(i2.gt.1) callsign(i2:)=' '
if(callsign.ne.' ' .and. callsign.ne.callsign0) then
len=i2-1
if(len.lt.0) len=6
if(len.ge.4) then !Omit short "callsigns"
nc=nc+1
freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81)
callsign0=callsign
endif
endif
if(callsign.ne.' ' .and. callsign.eq.callsign0) then
freqcall(nc)=cfreq0//' '//callsign//line3(k)(80:81)
endif
endif
enddo
flush(19)
nc=nc+1
freqcall(nc)=' '
nc=nc+1
freqcall(nc)=' '
freqcall(nc+1)=' '
freqcall(nc+2)=' '
iz=(nc+2)/3
do i=1,nc
write(*,1042) freqcall(i)
1042 format('&',a12)
enddo
999 continue
return
end subroutine display
libm65/dot.f
+11 -11
View File
@@ -1,11 +1,11 @@
real*8 function dot(x,y)
real*8 x(3),y(3)
dot=0.d0
do i=1,3
dot=dot+x(i)*y(i)
enddo
return
end
real*8 function dot(x,y)
real*8 x(3),y(3)
dot=0.d0
do i=1,3
dot=dot+x(i)*y(i)
enddo
return
end
libm65/dpol.f90
+41 -41
View File
@@ -1,41 +1,41 @@
real function dpol(mygrid,hisgrid)
! Compute spatial polartzation offset in degrees for the present
! time, between two specified grid locators.
character*6 MyGrid,HisGrid
real lat,lon,LST
character cdate*8,ctime2*10,czone*5,fnamedate*6
integer it(8)
data rad/57.2957795/
call date_and_time(cdate,ctime2,czone,it)
nyear=it(1)
month=it(2)
nday=it(3)
nh=it(5)-it(4)/60
nm=it(6)
ns=it(7)
uth=nh + nm/60.0 + ns/3600.0
call grid2deg(MyGrid,lon,lat)
call MoonDop(nyear,month,nday,uth,-lon,lat,RAMoon,DecMoon, &
LST,HA,AzMoon,ElMoon,vr,dist)
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* &
cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
poloffset1=rad*atan2(yy,xx)
call grid2deg(hisGrid,lon,lat)
call MoonDop(nyear,month,nday,uth,-lon,lat,RAMoon,DecMoon, &
LST,HA,AzMoon,ElMoon,vr,dist)
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* &
cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
poloffset2=rad*atan2(yy,xx)
dpol=mod(poloffset2-poloffset1+720.0,180.0)
if(dpol.gt.90.0) dpol=dpol-180.0
return
end function dpol
real function dpol(mygrid,hisgrid)
! Compute spatial polartzation offset in degrees for the present
! time, between two specified grid locators.
character*6 MyGrid,HisGrid
real lat,lon,LST
character cdate*8,ctime2*10,czone*5,fnamedate*6
integer it(8)
data rad/57.2957795/
call date_and_time(cdate,ctime2,czone,it)
nyear=it(1)
month=it(2)
nday=it(3)
nh=it(5)-it(4)/60
nm=it(6)
ns=it(7)
uth=nh + nm/60.0 + ns/3600.0
call grid2deg(MyGrid,lon,lat)
call MoonDop(nyear,month,nday,uth,-lon,lat,RAMoon,DecMoon, &
LST,HA,AzMoon,ElMoon,vr,dist)
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* &
cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
poloffset1=rad*atan2(yy,xx)
call grid2deg(hisGrid,lon,lat)
call MoonDop(nyear,month,nday,uth,-lon,lat,RAMoon,DecMoon, &
LST,HA,AzMoon,ElMoon,vr,dist)
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* &
cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
poloffset2=rad*atan2(yy,xx)
dpol=mod(poloffset2-poloffset1+720.0,180.0)
if(dpol.gt.90.0) dpol=dpol-180.0
return
end function dpol
libm65/encode65.f
+13 -13
View File
@@ -1,13 +1,13 @@
subroutine encode65(message,sent)
character message*22
integer dgen(12)
integer sent(63)
call packmsg(message,dgen)
call rs_encode(dgen,sent)
call interleave63(sent,1)
call graycode(sent,63,1)
return
end
subroutine encode65(message,sent)
character message*22
integer dgen(12)
integer sent(63)
call packmsg(message,dgen)
call rs_encode(dgen,sent)
call interleave63(sent,1)
call graycode(sent,63,1)
return
end
libm65/encode_rs.c
+52 -52
View File
@@ -1,52 +1,52 @@
/* Reed-Solomon encoder
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <string.h>
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
void ENCODE_RS(
#ifdef FIXED
DTYPE *data, DTYPE *bb,int pad){
#else
void *p,DTYPE *data, DTYPE *bb){
struct rs *rs = (struct rs *)p;
#endif
int i, j;
DTYPE feedback;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return;
#endif
memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS-PAD;i++){
feedback = INDEX_OF[data[i] ^ bb[0]];
if(feedback != A0){ /* feedback term is non-zero */
#ifdef UNNORMALIZED
/* This line is unnecessary when GENPOLY[NROOTS] is unity, as it must
* always be for the polynomials constructed by init_rs()
*/
feedback = MODNN(NN - GENPOLY[NROOTS] + feedback);
#endif
for(j=1;j<NROOTS;j++)
bb[j] ^= ALPHA_TO[MODNN(feedback + GENPOLY[NROOTS-j])];
}
/* Shift */
memmove(&bb[0],&bb[1],sizeof(DTYPE)*(NROOTS-1));
if(feedback != A0)
bb[NROOTS-1] = ALPHA_TO[MODNN(feedback + GENPOLY[0])];
else
bb[NROOTS-1] = 0;
}
}
/* Reed-Solomon encoder
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <string.h>
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
void ENCODE_RS(
#ifdef FIXED
DTYPE *data, DTYPE *bb,int pad){
#else
void *p,DTYPE *data, DTYPE *bb){
struct rs *rs = (struct rs *)p;
#endif
int i, j;
DTYPE feedback;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return;
#endif
memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS-PAD;i++){
feedback = INDEX_OF[data[i] ^ bb[0]];
if(feedback != A0){ /* feedback term is non-zero */
#ifdef UNNORMALIZED
/* This line is unnecessary when GENPOLY[NROOTS] is unity, as it must
* always be for the polynomials constructed by init_rs()
*/
feedback = MODNN(NN - GENPOLY[NROOTS] + feedback);
#endif
for(j=1;j<NROOTS;j++)
bb[j] ^= ALPHA_TO[MODNN(feedback + GENPOLY[NROOTS-j])];
}
/* Shift */
memmove(&bb[0],&bb[1],sizeof(DTYPE)*(NROOTS-1));
if(feedback != A0)
bb[NROOTS-1] = ALPHA_TO[MODNN(feedback + GENPOLY[0])];
else
bb[NROOTS-1] = 0;
}
}
libm65/extract.F
+109 -109
View File
@@ -1,109 +1,109 @@
subroutine extract(s3,nadd,ncount,nhist,decoded,ltext)
real s3(64,63)
real tmp(4032)
character decoded*22
integer era(51),dat4(12),indx(64)
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
logical first,ltext
data first/.true./,nsec1/0/
save
nfail=0
1 continue
! call timer('demod64a',0)
call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! call timer('demod64a',1)
if(ntest.lt.50 .or. nlow.gt.20) then
ncount=-999 !Flag bad data
go to 900
endif
call chkhist(mrsym,nhist,ipk)
if(nhist.ge.20) then
nfail=nfail+1
call pctile(s3,tmp,4032,50,base) ! ### or, use ave from demod64a
do j=1,63
s3(ipk,j)=base
enddo
if(nfail.gt.30) then
decoded=' '
ncount=-1
go to 900
endif
go to 1
endif
call graycode(mrsym,63,-1)
call interleave63(mrsym,-1)
call interleave63(mrprob,-1)
ndec=1
nemax=30 !Was 200 (30)
maxe=8
xlambda=13.0 !Was 12
if(ndec.eq.1) then
call graycode(mr2sym,63,-1)
call interleave63(mr2sym,-1)
call interleave63(mr2prob,-1)
nsec1=nsec1+1
write(22,rec=1) nsec1,xlambda,maxe,200,
+ mrsym,mrprob,mr2sym,mr2prob
call flush(22)
! call timer('kvasd ',0)
#ifdef UNIX
iret=system('./kvasd -q > dev_null')
#else
iret=system('kvasd -q > dev_null')
#endif
! call timer('kvasd ',1)
if(iret.ne.0) then
if(first) write(*,1000) iret
1000 format('Error in KV decoder, or no KV decoder present.'/
+ 'Return code:',i8,'. Will use BM algorithm.')
ndec=0
first=.false.
go to 20
endif
read(22,rec=2) nsec2,ncount,dat4
j=nsec2 !Silence compiler warning
decoded=' '
ltext=.false.
if(ncount.ge.0) then
call unpackmsg(dat4,decoded) !Unpack the user message
if(iand(dat4(10),8).ne.0) ltext=.true.
do i=2,12
if(dat4(i).ne.dat4(1)) go to 20
enddo
write(13,*) 'Bad decode?',nhist,nfail,ipk,
+ ' ',dat4,decoded
ncount=-1 !Suppress supposedly bogus decodes
decoded=' '
endif
endif
20 if(ndec.eq.0) then
call indexx(63,mrprob,indx)
do i=1,nemax
j=indx(i)
if(mrprob(j).gt.120) then
ne2=i-1
go to 2
endif
era(i)=j-1
enddo
ne2=nemax
2 decoded=' '
do nerase=0,ne2,2
call rs_decode(mrsym,era,nerase,dat4,ncount)
if(ncount.ge.0) then
call unpackmsg(dat4,decoded)
go to 900
endif
enddo
endif
900 return
end
subroutine extract(s3,nadd,ncount,nhist,decoded,ltext)
real s3(64,63)
real tmp(4032)
character decoded*22
integer era(51),dat4(12),indx(64)
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
logical first,ltext
data first/.true./,nsec1/0/
save
nfail=0
1 continue
! call timer('demod64a',0)
call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! call timer('demod64a',1)
if(ntest.lt.50 .or. nlow.gt.20) then
ncount=-999 !Flag bad data
go to 900
endif
call chkhist(mrsym,nhist,ipk)
if(nhist.ge.20) then
nfail=nfail+1
call pctile(s3,tmp,4032,50,base) ! ### or, use ave from demod64a
do j=1,63
s3(ipk,j)=base
enddo
if(nfail.gt.30) then
decoded=' '
ncount=-1
go to 900
endif
go to 1
endif
call graycode(mrsym,63,-1)
call interleave63(mrsym,-1)
call interleave63(mrprob,-1)
ndec=1
nemax=30 !Was 200 (30)
maxe=8
xlambda=13.0 !Was 12
if(ndec.eq.1) then
call graycode(mr2sym,63,-1)
call interleave63(mr2sym,-1)
call interleave63(mr2prob,-1)
nsec1=nsec1+1
write(22,rec=1) nsec1,xlambda,maxe,200,
+ mrsym,mrprob,mr2sym,mr2prob
call flush(22)
! call timer('kvasd ',0)
#ifdef UNIX
iret=system('./kvasd -q > dev_null')
#else
iret=system('kvasd -q > dev_null')
#endif
! call timer('kvasd ',1)
if(iret.ne.0) then
if(first) write(*,1000) iret
1000 format('Error in KV decoder, or no KV decoder present.'/
+ 'Return code:',i8,'. Will use BM algorithm.')
ndec=0
first=.false.
go to 20
endif
read(22,rec=2) nsec2,ncount,dat4
j=nsec2 !Silence compiler warning
decoded=' '
ltext=.false.
if(ncount.ge.0) then
call unpackmsg(dat4,decoded) !Unpack the user message
if(iand(dat4(10),8).ne.0) ltext=.true.
do i=2,12
if(dat4(i).ne.dat4(1)) go to 20
enddo
write(13,*) 'Bad decode?',nhist,nfail,ipk,
+ ' ',dat4,decoded
ncount=-1 !Suppress supposedly bogus decodes
decoded=' '
endif
endif
20 if(ndec.eq.0) then
call indexx(63,mrprob,indx)
do i=1,nemax
j=indx(i)
if(mrprob(j).gt.120) then
ne2=i-1
go to 2
endif
era(i)=j-1
enddo
ne2=nemax
2 decoded=' '
do nerase=0,ne2,2
call rs_decode(mrsym,era,nerase,dat4,ncount)
if(ncount.ge.0) then
call unpackmsg(dat4,decoded)
go to 900
endif
enddo
endif
900 return
end
libm65/fchisq.f
+76 -76
View File
@@ -1,76 +1,76 @@
real function fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
parameter (NMAX=60*96000) !Samples per 60 s
complex cx(npts),cy(npts)
real a(5)
complex w,wstep,za,zb,z
real ss(2600)
complex csx(0:NMAX/64),csy(0:NMAX/64)
data twopi/6.283185307/a1,a2,a3/99.,99.,99./
save
call timer('fchisq ',0)
baud=11025.0/4096.0
if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then
a1=a(1)
a2=a(2)
a3=a(3)
C Mix and integrate the complex X and Y signals
csx(0)=0.
csy(0)=0.
w=1.0
x0=0.5*(npts+1)
s=2.0/npts
do i=1,npts
x=s*(i-x0)
if(mod(i,100).eq.1) then
p2=1.5*x*x - 0.5
! p3=2.5*(x**3) - 1.5*x
! p4=4.375*(x**4) - 3.75*(x**2) + 0.375
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/fsample)
wstep=cmplx(cos(dphi),sin(dphi))
endif
w=w*wstep
csx(i)=csx(i-1) + w*cx(i)
csy(i)=csy(i-1) + w*cy(i)
enddo
endif
C Compute 1/2-symbol powers at 1/16-symbol steps.
fac=1.e-4
pol=a(4)/57.2957795
aa=cos(pol)
bb=sin(pol)
nsps=nint(fsample/baud) !Samples per symbol
nsph=nsps/2 !Samples per half-symbol
ndiv=16 !Output ss() steps per symbol
nout=ndiv*npts/nsps
dtstep=1.0/(ndiv*baud) !Time per output step
do i=1,nout
j=i*nsps/ndiv
k=j-nsph
ss(i)=0.
if(k.ge.1) then
za=csx(j)-csx(k)
zb=csy(j)-csy(k)
z=aa*za + bb*zb
ss(i)=fac*(real(z)**2 + aimag(z)**2)
endif
enddo
ccfmax=0.
call timer('ccf2 ',0)
call ccf2(ss,nout,nflip,ccf,lagpk)
call timer('ccf2 ',1)
if(ccf.gt.ccfmax) then
ccfmax=ccf
dtmax=lagpk*dtstep
endif
fchisq=-ccfmax
call timer('fchisq ',1)
return
end
real function fchisq(cx,cy,npts,fsample,nflip,a,ccfmax,dtmax)
parameter (NMAX=60*96000) !Samples per 60 s
complex cx(npts),cy(npts)
real a(5)
complex w,wstep,za,zb,z
real ss(2600)
complex csx(0:NMAX/64),csy(0:NMAX/64)
data twopi/6.283185307/a1,a2,a3/99.,99.,99./
save
call timer('fchisq ',0)
baud=11025.0/4096.0
if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then
a1=a(1)
a2=a(2)
a3=a(3)
C Mix and integrate the complex X and Y signals
csx(0)=0.
csy(0)=0.
w=1.0
x0=0.5*(npts+1)
s=2.0/npts
do i=1,npts
x=s*(i-x0)
if(mod(i,100).eq.1) then
p2=1.5*x*x - 0.5
! p3=2.5*(x**3) - 1.5*x
! p4=4.375*(x**4) - 3.75*(x**2) + 0.375
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/fsample)
wstep=cmplx(cos(dphi),sin(dphi))
endif
w=w*wstep
csx(i)=csx(i-1) + w*cx(i)
csy(i)=csy(i-1) + w*cy(i)
enddo
endif
C Compute 1/2-symbol powers at 1/16-symbol steps.
fac=1.e-4
pol=a(4)/57.2957795
aa=cos(pol)
bb=sin(pol)
nsps=nint(fsample/baud) !Samples per symbol
nsph=nsps/2 !Samples per half-symbol
ndiv=16 !Output ss() steps per symbol
nout=ndiv*npts/nsps
dtstep=1.0/(ndiv*baud) !Time per output step
do i=1,nout
j=i*nsps/ndiv
k=j-nsph
ss(i)=0.
if(k.ge.1) then
za=csx(j)-csx(k)
zb=csy(j)-csy(k)
z=aa*za + bb*zb
ss(i)=fac*(real(z)**2 + aimag(z)**2)
endif
enddo
ccfmax=0.
call timer('ccf2 ',0)
call ccf2(ss,nout,nflip,ccf,lagpk)
call timer('ccf2 ',1)
if(ccf.gt.ccfmax) then
ccfmax=ccf
dtmax=lagpk*dtstep
endif
fchisq=-ccfmax
call timer('fchisq ',1)
return
end
libm65/fftw3.f
+64 -64
View File
@@ -1,64 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)
libm65/fil6521.f
+44 -44
View File
@@ -1,44 +1,44 @@
subroutine fil6521(c1,n1,c2,n2)
C FIR lowpass filter designed using ScopeFIR
C Pass #1 Pass #2
C-----------------------------------------------
C fsample (Hz) 1378.125 Input sample rate
C Ntaps 21 Number of filter taps
C fc (Hz) 40 Cutoff frequency
C fstop (Hz) 172.266 Lower limit of stopband
C Ripple (dB) 0.1 Ripple in passband
C Stop Atten (dB) 38 Stopband attenuation
C fout (Hz) 344.531 Output sample rate
parameter (NTAPS=21)
parameter (NH=NTAPS/2)
parameter (NDOWN=4) !Downsample ratio = 1/4
complex c1(n1)
complex c2(n1/NDOWN)
C Filter coefficients:
real a(-NH:NH)
data a/
+ -0.011958606980,-0.013888627387,-0.015601306443,-0.010602249570,
+ 0.003804023436, 0.028320058273, 0.060903935217, 0.096841904411,
+ 0.129639871228, 0.152644580853, 0.160917511283, 0.152644580853,
+ 0.129639871228, 0.096841904411, 0.060903935217, 0.028320058273,
+ 0.003804023436,-0.010602249570,-0.015601306443,-0.013888627387,
+ -0.011958606980/
n2=(n1-NTAPS+NDOWN)/NDOWN
k0=NH-NDOWN+1
C Loop over all output samples
do i=1,n2
c2(i)=0.
k=k0 + NDOWN*i
do j=-NH,NH
c2(i)=c2(i) + c1(j+k)*a(j)
enddo
enddo
return
end
subroutine fil6521(c1,n1,c2,n2)
C FIR lowpass filter designed using ScopeFIR
C Pass #1 Pass #2
C-----------------------------------------------
C fsample (Hz) 1378.125 Input sample rate
C Ntaps 21 Number of filter taps
C fc (Hz) 40 Cutoff frequency
C fstop (Hz) 172.266 Lower limit of stopband
C Ripple (dB) 0.1 Ripple in passband
C Stop Atten (dB) 38 Stopband attenuation
C fout (Hz) 344.531 Output sample rate
parameter (NTAPS=21)
parameter (NH=NTAPS/2)
parameter (NDOWN=4) !Downsample ratio = 1/4
complex c1(n1)
complex c2(n1/NDOWN)
C Filter coefficients:
real a(-NH:NH)
data a/
+ -0.011958606980,-0.013888627387,-0.015601306443,-0.010602249570,
+ 0.003804023436, 0.028320058273, 0.060903935217, 0.096841904411,
+ 0.129639871228, 0.152644580853, 0.160917511283, 0.152644580853,
+ 0.129639871228, 0.096841904411, 0.060903935217, 0.028320058273,
+ 0.003804023436,-0.010602249570,-0.015601306443,-0.013888627387,
+ -0.011958606980/
n2=(n1-NTAPS+NDOWN)/NDOWN
k0=NH-NDOWN+1
C Loop over all output samples
do i=1,n2
c2(i)=0.
k=k0 + NDOWN*i
do j=-NH,NH
c2(i)=c2(i) + c1(j+k)*a(j)
enddo
enddo
return
end
libm65/filbig.f
+134 -134
View File
@@ -1,134 +1,134 @@
subroutine filbig(dd,nmax,f0,newdat,nfsample,xpol,c4a,c4b,n4)
C Filter and downsample complex data stored in array dd(4,nmax).
C Output is downsampled from 96000 Hz to 1375.125 Hz.
parameter (MAXFFT1=5376000,MAXFFT2=77175)
real*4 dd(4,nmax) !Input data
complex ca(MAXFFT1),cb(MAXFFT1) !FFTs of input
complex c4a(MAXFFT2),c4b(MAXFFT2) !Output data
real*8 df
real halfpulse(8) !Impulse response of filter (one sided)
complex cfilt(MAXFFT2) !Filter (complex; imag = 0)
real rfilt(MAXFFT2) !Filter (real)
integer*8 plan1,plan2,plan3,plan4,plan5
logical first,xpol
include 'fftw3.f'
equivalence (rfilt,cfilt)
data first/.true./,npatience/1/
data halfpulse/114.97547150,36.57879257,-20.93789101,
+ 5.89886379,1.59355187,-2.49138308,0.60910773,-0.04248129/
save
nfft1=MAXFFT1
nfft2=MAXFFT2
if(nfsample.eq.95238) then
nfft1=5120000
nfft2=74088
endif
if(nmax.lt.0) go to 900
if(first) then
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
C Plan the FFTs just once
call timer('FFTplans ',0)
call sfftw_plan_dft_1d(plan1,nfft1,ca,ca,
+ FFTW_BACKWARD,nflags)
call sfftw_plan_dft_1d(plan2,nfft1,cb,cb,
+ FFTW_BACKWARD,nflags)
call sfftw_plan_dft_1d(plan3,nfft2,c4a,c4a,
+ FFTW_FORWARD,nflags)
call sfftw_plan_dft_1d(plan4,nfft2,c4b,c4b,
+ FFTW_FORWARD,nflags)
call sfftw_plan_dft_1d(plan5,nfft2,cfilt,cfilt,
+ FFTW_BACKWARD,nflags)
call timer('FFTplans ',1)
C Convert impulse response to filter function
do i=1,nfft2
cfilt(i)=0.
enddo
fac=0.00625/nfft1
cfilt(1)=fac*halfpulse(1)
do i=2,8
cfilt(i)=fac*halfpulse(i)
cfilt(nfft2+2-i)=fac*halfpulse(i)
enddo
call timer('FFTfilt ',0)
call sfftw_execute(plan5)
call timer('FFTfilt ',1)
base=cfilt(nfft2/2+1)
do i=1,nfft2
rfilt(i)=real(cfilt(i))-base
enddo
df=96000.d0/nfft1
if(nfsample.eq.95238) df=95238.1d0/nfft1
first=.false.
endif
C When new data comes along, we need to compute a new "big FFT"
C If we just have a new f0, continue with the existing ca and cb.
if(newdat.ne.0) then
nz=min(nmax,nfft1)
do i=1,nz
ca(i)=cmplx(dd(1,i),dd(2,i))
if(xpol) cb(i)=cmplx(dd(3,i),dd(4,i))
enddo
if(nmax.lt.nfft1) then
do i=nmax+1,nfft1
ca(i)=0.
if(xpol) cb(i)=0.
enddo
endif
call timer('FFTbig ',0)
call sfftw_execute(plan1)
if(xpol) call sfftw_execute(plan2)
call timer('FFTbig ',1)
newdat=0
endif
C NB: f0 is the frequency at which we want our filter centered.
C i0 is the bin number in ca and cb closest to f0.
i0=nint(f0/df) + 1
nh=nfft2/2
do i=1,nh !Copy data into c4a and c4b,
j=i0+i-1 !and apply the filter function
if(j.ge.1 .and. j.le.nfft1) then
c4a(i)=rfilt(i)*ca(j)
if(xpol) c4b(i)=rfilt(i)*cb(j)
else
c4a(i)=0.
if(xpol) c4b(i)=0.
endif
enddo
do i=nh+1,nfft2
j=i0+i-1-nfft2
if(j.lt.1) j=j+nfft1 !nfft1 was nfft2
c4a(i)=rfilt(i)*ca(j)
if(xpol) c4b(i)=rfilt(i)*cb(j)
enddo
C Do the short reverse transform, to go back to time domain.
call timer('FFTsmall',0)
call sfftw_execute(plan3)
if(xpol) call sfftw_execute(plan4)
call timer('FFTsmall',1)
n4=min(nmax/64,nfft2)
go to 999
900 call sfftw_destroy_plan(plan1)
call sfftw_destroy_plan(plan2)
call sfftw_destroy_plan(plan3)
call sfftw_destroy_plan(plan4)
call sfftw_destroy_plan(plan5)
999 return
end
subroutine filbig(dd,nmax,f0,newdat,nfsample,xpol,c4a,c4b,n4)
C Filter and downsample complex data stored in array dd(4,nmax).
C Output is downsampled from 96000 Hz to 1375.125 Hz.
parameter (MAXFFT1=5376000,MAXFFT2=77175)
real*4 dd(4,nmax) !Input data
complex ca(MAXFFT1),cb(MAXFFT1) !FFTs of input
complex c4a(MAXFFT2),c4b(MAXFFT2) !Output data
real*8 df
real halfpulse(8) !Impulse response of filter (one sided)
complex cfilt(MAXFFT2) !Filter (complex; imag = 0)
real rfilt(MAXFFT2) !Filter (real)
integer*8 plan1,plan2,plan3,plan4,plan5
logical first,xpol
include 'fftw3.f'
equivalence (rfilt,cfilt)
data first/.true./,npatience/1/
data halfpulse/114.97547150,36.57879257,-20.93789101,
+ 5.89886379,1.59355187,-2.49138308,0.60910773,-0.04248129/
save
nfft1=MAXFFT1
nfft2=MAXFFT2
if(nfsample.eq.95238) then
nfft1=5120000
nfft2=74088
endif
if(nmax.lt.0) go to 900
if(first) then
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
C Plan the FFTs just once
call timer('FFTplans ',0)
call sfftw_plan_dft_1d(plan1,nfft1,ca,ca,
+ FFTW_BACKWARD,nflags)
call sfftw_plan_dft_1d(plan2,nfft1,cb,cb,
+ FFTW_BACKWARD,nflags)
call sfftw_plan_dft_1d(plan3,nfft2,c4a,c4a,
+ FFTW_FORWARD,nflags)
call sfftw_plan_dft_1d(plan4,nfft2,c4b,c4b,
+ FFTW_FORWARD,nflags)
call sfftw_plan_dft_1d(plan5,nfft2,cfilt,cfilt,
+ FFTW_BACKWARD,nflags)
call timer('FFTplans ',1)
C Convert impulse response to filter function
do i=1,nfft2
cfilt(i)=0.
enddo
fac=0.00625/nfft1
cfilt(1)=fac*halfpulse(1)
do i=2,8
cfilt(i)=fac*halfpulse(i)
cfilt(nfft2+2-i)=fac*halfpulse(i)
enddo
call timer('FFTfilt ',0)
call sfftw_execute(plan5)
call timer('FFTfilt ',1)
base=cfilt(nfft2/2+1)
do i=1,nfft2
rfilt(i)=real(cfilt(i))-base
enddo
df=96000.d0/nfft1
if(nfsample.eq.95238) df=95238.1d0/nfft1
first=.false.
endif
C When new data comes along, we need to compute a new "big FFT"
C If we just have a new f0, continue with the existing ca and cb.
if(newdat.ne.0) then
nz=min(nmax,nfft1)
do i=1,nz
ca(i)=cmplx(dd(1,i),dd(2,i))
if(xpol) cb(i)=cmplx(dd(3,i),dd(4,i))
enddo
if(nmax.lt.nfft1) then
do i=nmax+1,nfft1
ca(i)=0.
if(xpol) cb(i)=0.
enddo
endif
call timer('FFTbig ',0)
call sfftw_execute(plan1)
if(xpol) call sfftw_execute(plan2)
call timer('FFTbig ',1)
newdat=0
endif
C NB: f0 is the frequency at which we want our filter centered.
C i0 is the bin number in ca and cb closest to f0.
i0=nint(f0/df) + 1
nh=nfft2/2
do i=1,nh !Copy data into c4a and c4b,
j=i0+i-1 !and apply the filter function
if(j.ge.1 .and. j.le.nfft1) then
c4a(i)=rfilt(i)*ca(j)
if(xpol) c4b(i)=rfilt(i)*cb(j)
else
c4a(i)=0.
if(xpol) c4b(i)=0.
endif
enddo
do i=nh+1,nfft2
j=i0+i-1-nfft2
if(j.lt.1) j=j+nfft1 !nfft1 was nfft2
c4a(i)=rfilt(i)*ca(j)
if(xpol) c4b(i)=rfilt(i)*cb(j)
enddo
C Do the short reverse transform, to go back to time domain.
call timer('FFTsmall',0)
call sfftw_execute(plan3)
if(xpol) call sfftw_execute(plan4)
call timer('FFTsmall',1)
n4=min(nmax/64,nfft2)
go to 999
900 call sfftw_destroy_plan(plan1)
call sfftw_destroy_plan(plan2)
call sfftw_destroy_plan(plan3)
call sfftw_destroy_plan(plan4)
call sfftw_destroy_plan(plan5)
999 return
end
libm65/four2a.f90
+89 -89
View File
@@ -1,89 +1,89 @@
subroutine four2a(a,nfft,ndim,isign,iform)
! IFORM = 1, 0 or -1, as data is
! complex, real, or the first half of a complex array. Transform
! values are returned in array DATA. They are complex, real, or
! the first half of a complex array, as IFORM = 1, -1 or 0.
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
! by ... will be returned in the same array, now considered to
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
! IFORM = 0 or -1, N(1) must be even, and enough room must be
! reserved. The missing values may be obtained by complex conjugation.
! The reverse transformation of a half complex array dimensioned
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
! The transform will be real and returned to the input array.
parameter (NPMAX=100)
parameter (NSMALL=16384)
complex a(nfft)
complex aa(NSMALL)
integer nn(NPMAX),ns(NPMAX),nf(NPMAX),nl(NPMAX)
integer*8 plan(NPMAX) !Actually should be i*8, but no matter
data nplan/0/,npatience/1/
include 'fftw3.f'
save plan,nplan,nn,ns,nf,nl
if(nfft.lt.0) go to 999
nloc=loc(a)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
iform.eq.nf(i) .and. nloc.eq.nl(i)) go to 10
enddo
if(nplan.ge.NPMAX) stop 'Too many FFTW plans requested.'
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
! FFTW_PATIENT, FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
do j=1,jz
aa(j)=a(j)
enddo
endif
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
i=nplan
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
do j=1,jz
a(j)=aa(j)
enddo
endif
10 continue
call sfftw_execute(plan(i))
return
999 do i=1,nplan
! The test is only to silence a compiler warning:
if(ndim.ne.-999) call sfftw_destroy_plan(plan(i))
enddo
return
end subroutine four2a
subroutine four2a(a,nfft,ndim,isign,iform)
! IFORM = 1, 0 or -1, as data is
! complex, real, or the first half of a complex array. Transform
! values are returned in array DATA. They are complex, real, or
! the first half of a complex array, as IFORM = 1, -1 or 0.
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
! by ... will be returned in the same array, now considered to
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
! IFORM = 0 or -1, N(1) must be even, and enough room must be
! reserved. The missing values may be obtained by complex conjugation.
! The reverse transformation of a half complex array dimensioned
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
! The transform will be real and returned to the input array.
parameter (NPMAX=100)
parameter (NSMALL=16384)
complex a(nfft)
complex aa(NSMALL)
integer nn(NPMAX),ns(NPMAX),nf(NPMAX),nl(NPMAX)
integer*8 plan(NPMAX) !Actually should be i*8, but no matter
data nplan/0/,npatience/1/
include 'fftw3.f'
save plan,nplan,nn,ns,nf,nl
if(nfft.lt.0) go to 999
nloc=loc(a)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
iform.eq.nf(i) .and. nloc.eq.nl(i)) go to 10
enddo
if(nplan.ge.NPMAX) stop 'Too many FFTW plans requested.'
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
! FFTW_PATIENT, FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
do j=1,jz
aa(j)=a(j)
enddo
endif
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
i=nplan
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
do j=1,jz
a(j)=aa(j)
enddo
endif
10 continue
call sfftw_execute(plan(i))
return
999 do i=1,nplan
! The test is only to silence a compiler warning:
if(ndim.ne.-999) call sfftw_destroy_plan(plan(i))
enddo
return
end subroutine four2a
libm65/ftninit.f90
+63 -63
View File
@@ -1,63 +1,63 @@
! Fortran logical units used in WSJT6
!
! 10 binary input data, *.tf2 files
! 11 prefixes.txt
! 12 timer.out
! 13 map65.log
! 14
! 15
! 16
! 17 saved *.tf2 files
! 18 test file to be transmitted (wsjtgen.f90)
! 19 livecq.txt
! 20
! 21 map65_rx.log
! 22 kvasd.dat
! 23 CALL3.TXT
! 24
! 25
! 26 tmp26.txt
! 27
! 28 fftw_wisdom.dat
!------------------------------------------------ ftn_init
subroutine ftninit(appd)
character*(*) appd
character cjunk*1,firstline*30
character addpfx*8
integer junk(256)
common/pfxcom/addpfx
addpfx=' '
call pfxdump(appd//'/prefixes.txt')
open(12,file=appd//'/timer.out',status='unknown',err=920)
open(13,file=appd//'/map65.log',status='unknown')
open(19,file=appd//'/livecq.txt',status='unknown')
open(21,file=appd//'/map65_rx.log',status='unknown',access='append',err=950)
open(22,file=appd//'/kvasd.dat',access='direct',recl=1024,status='unknown')
read(22,rec=2,err=12) junk
go to 18
12 junk=0
write(22,rec=1) junk
write(22,rec=2) junk
18 open(26,file=appd//'/tmp26.txt',status='unknown')
! Import FFTW wisdom, if available:
open(28,file=appd//'/fftwf_wisdom.dat',status='old',err=30)
read(28,1000,err=30,end=30) firstline
1000 format(a30)
rewind 28
call import_wisdom_from_file(isuccess,28)
close(28)
if(isuccess.ne.0) write(13,1010) firstline
1010 format('Imported FFTW wisdom: ',a30)
30 return
920 write(0,*) '!Error opening timer.out'
stop
950 write(0,*) '!Error opening ALL65.TXT'
stop
end subroutine ftninit
! Fortran logical units used in WSJT6
!
! 10 binary input data, *.tf2 files
! 11 prefixes.txt
! 12 timer.out
! 13 map65.log
! 14
! 15
! 16
! 17 saved *.tf2 files
! 18 test file to be transmitted (wsjtgen.f90)
! 19 livecq.txt
! 20
! 21 map65_rx.log
! 22 kvasd.dat
! 23 CALL3.TXT
! 24
! 25
! 26 tmp26.txt
! 27
! 28 fftw_wisdom.dat
!------------------------------------------------ ftn_init
subroutine ftninit(appd)
character*(*) appd
character cjunk*1,firstline*30
character addpfx*8
integer junk(256)
common/pfxcom/addpfx
addpfx=' '
call pfxdump(appd//'/prefixes.txt')
open(12,file=appd//'/timer.out',status='unknown',err=920)
open(13,file=appd//'/map65.log',status='unknown')
open(19,file=appd//'/livecq.txt',status='unknown')
open(21,file=appd//'/map65_rx.log',status='unknown',access='append',err=950)
open(22,file=appd//'/kvasd.dat',access='direct',recl=1024,status='unknown')
read(22,rec=2,err=12) junk
go to 18
12 junk=0
write(22,rec=1) junk
write(22,rec=2) junk
18 open(26,file=appd//'/tmp26.txt',status='unknown')
! Import FFTW wisdom, if available:
open(28,file=appd//'/fftwf_wisdom.dat',status='old',err=30)
read(28,1000,err=30,end=30) firstline
1000 format(a30)
rewind 28
call import_wisdom_from_file(isuccess,28)
close(28)
if(isuccess.ne.0) write(13,1010) firstline
1010 format('Imported FFTW wisdom: ',a30)
30 return
920 write(0,*) '!Error opening timer.out'
stop
950 write(0,*) '!Error opening ALL65.TXT'
stop
end subroutine ftninit
libm65/ftnquit.f90
+9 -9
View File
@@ -1,9 +1,9 @@
subroutine ftnquit
! Destroy the FFTW plans
call four2a(a,-1,1,1,1)
call filbig(id,-1,f0,newdat,nfsample,c4a,c4b,n4)
stop
return
end subroutine ftnquit
subroutine ftnquit
! Destroy the FFTW plans
call four2a(a,-1,1,1,1)
call filbig(id,-1,f0,newdat,nfsample,c4a,c4b,n4)
stop
return
end subroutine ftnquit
libm65/gen65.f90
+93 -93
View File
@@ -1,93 +1,93 @@
subroutine gen65(message,mode65,samfac,nsendingsh,msgsent,iwave,nwave)
! Encodes a JT65 message into a wavefile.
! Executes in 17 ms on opti-745.
parameter (NMAX=60*11025) !Max length of wave file
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
character*3 cok !' ' or 'OOO'
real*8 dt,phi,f,f0,dfgen,dphi,twopi,samfac
integer*2 iwave(NMAX) !Generated wave file
integer dgen(12)
integer sent(63)
logical first
integer nprc(126)
real pr(126)
data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
data twopi/6.283185307179586476d0/,first/.true./
save
if(first) then
do i=1,126
pr(i)=2*nprc(i)-1
enddo
first=.false.
endif
call chkmsg(message,cok,nspecial,flip)
if(nspecial.eq.0) then
call packmsg(message,dgen) !Pack message into 72 bits
nsendingsh=0
if(iand(dgen(10),8).ne.0) nsendingsh=-1 !Plain text flag
call rs_encode(dgen,sent)
call interleave63(sent,1) !Apply interleaving
call graycode(sent,63,1) !Apply Gray code
nsym=126 !Symbols per transmission
nsps=4096
else
nsym=32
nsps=16384
nsendingsh=1 !Flag for shorthand message
endif
if(mode65.eq.0) go to 900
! Set up necessary constants
dt=1.d0/(samfac*11025.d0)
f0=118*11025.d0/1024
dfgen=mode65*11025.d0/4096.d0
phi=0.d0
i=0
k=0
do j=1,nsym
f=f0
if(nspecial.ne.0 .and. mod(j,2).eq.0) f=f0+10*nspecial*dfgen
if(nspecial.eq.0 .and. flip*pr(j).lt.0.0) then
k=k+1
f=f0+(sent(k)+2)*dfgen
endif
dphi=twopi*dt*f
do ii=1,nsps
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
i=i+1
iwave(i)=32767.0*sin(xphi)
enddo
enddo
iwave(nsym*nsps+1:)=0
nwave=nsym*nsps + 5512
call unpackmsg(dgen,msgsent)
if(flip.lt.0.0) then
do i=22,1,-1
if(msgsent(i:i).ne.' ') goto 10
enddo
10 msgsent=msgsent(1:i)//' OOO'
endif
if(nsendingsh.eq.1) then
if(nspecial.eq.2) msgsent='RO'
if(nspecial.eq.3) msgsent='RRR'
if(nspecial.eq.4) msgsent='73'
endif
900 return
end subroutine gen65
subroutine gen65(message,mode65,samfac,nsendingsh,msgsent,iwave,nwave)
! Encodes a JT65 message into a wavefile.
! Executes in 17 ms on opti-745.
parameter (NMAX=60*11025) !Max length of wave file
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
character*3 cok !' ' or 'OOO'
real*8 dt,phi,f,f0,dfgen,dphi,twopi,samfac
integer*2 iwave(NMAX) !Generated wave file
integer dgen(12)
integer sent(63)
logical first
integer nprc(126)
real pr(126)
data nprc/1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0, &
0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1, &
0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1, &
0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1, &
1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1, &
0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1, &
1,1,1,1,1,1/
data twopi/6.283185307179586476d0/,first/.true./
save
if(first) then
do i=1,126
pr(i)=2*nprc(i)-1
enddo
first=.false.
endif
call chkmsg(message,cok,nspecial,flip)
if(nspecial.eq.0) then
call packmsg(message,dgen) !Pack message into 72 bits
nsendingsh=0
if(iand(dgen(10),8).ne.0) nsendingsh=-1 !Plain text flag
call rs_encode(dgen,sent)
call interleave63(sent,1) !Apply interleaving
call graycode(sent,63,1) !Apply Gray code
nsym=126 !Symbols per transmission
nsps=4096
else
nsym=32
nsps=16384
nsendingsh=1 !Flag for shorthand message
endif
if(mode65.eq.0) go to 900
! Set up necessary constants
dt=1.d0/(samfac*11025.d0)
f0=118*11025.d0/1024
dfgen=mode65*11025.d0/4096.d0
phi=0.d0
i=0
k=0
do j=1,nsym
f=f0
if(nspecial.ne.0 .and. mod(j,2).eq.0) f=f0+10*nspecial*dfgen
if(nspecial.eq.0 .and. flip*pr(j).lt.0.0) then
k=k+1
f=f0+(sent(k)+2)*dfgen
endif
dphi=twopi*dt*f
do ii=1,nsps
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
i=i+1
iwave(i)=32767.0*sin(xphi)
enddo
enddo
iwave(nsym*nsps+1:)=0
nwave=nsym*nsps + 5512
call unpackmsg(dgen,msgsent)
if(flip.lt.0.0) then
do i=22,1,-1
if(msgsent(i:i).ne.' ') goto 10
enddo
10 msgsent=msgsent(1:i)//' OOO'
endif
if(nsendingsh.eq.1) then
if(nspecial.eq.2) msgsent='RO'
if(nspecial.eq.3) msgsent='RRR'
if(nspecial.eq.4) msgsent='73'
endif
900 return
end subroutine gen65
libm65/geocentric.f
+17 -17
View File
@@ -1,17 +1,17 @@
subroutine geocentric(alat,elev,hlt,erad)
implicit real*8 (a-h,o-z)
C IAU 1976 flattening f, equatorial radius a
f = 1.d0/298.257d0
a = 6378140.d0
c = 1.d0/sqrt(1.d0 + (-2.d0 + f)*f*sin(alat)*sin(alat))
arcf = (a*c + elev)*cos(alat)
arsf = (a*(1.d0 - f)*(1.d0 - f)*c + elev)*sin(alat)
hlt = datan2(arsf,arcf)
erad = sqrt(arcf*arcf + arsf*arsf)
erad = 0.001d0*erad
return
end
subroutine geocentric(alat,elev,hlt,erad)
implicit real*8 (a-h,o-z)
C IAU 1976 flattening f, equatorial radius a
f = 1.d0/298.257d0
a = 6378140.d0
c = 1.d0/sqrt(1.d0 + (-2.d0 + f)*f*sin(alat)*sin(alat))
arcf = (a*c + elev)*cos(alat)
arsf = (a*(1.d0 - f)*(1.d0 - f)*c + elev)*sin(alat)
hlt = datan2(arsf,arcf)
erad = sqrt(arcf*arcf + arsf*arsf)
erad = 0.001d0*erad
return
end
libm65/getdphi.f90
+18 -18
View File
@@ -1,18 +1,18 @@
subroutine getdphi(qphi)
real qphi(12)
s=0.
c=0.
do i=1,12
th=i*30/57.2957795
s=s+qphi(i)*sin(th)
c=c+qphi(i)*cos(th)
enddo
dphi=57.2957795*atan2(s,c)
write(*,1010) nint(dphi)
1010 format('!Best-fit Dphi =',i4,' deg')
return
end
subroutine getdphi(qphi)
real qphi(12)
s=0.
c=0.
do i=1,12
th=i*30/57.2957795
s=s+qphi(i)*sin(th)
c=c+qphi(i)*cos(th)
enddo
dphi=57.2957795*atan2(s,c)
write(*,1010) nint(dphi)
1010 format('!Best-fit Dphi =',i4,' deg')
return
end
libm65/getpfx1.f
+96 -96
View File
@@ -1,96 +1,96 @@
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.f'
callsign0=callsign
nv2=0
iz=index(callsign,' ') - 1
if(iz.lt.0) iz=12
islash=index(callsign(1:iz),'/')
k=0
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
go to 10
endif
enddo
if(addpfx.eq.c) then
k=449
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
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
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=1
i=index(callsign0,'/')
callsign=callsign0(:i-1)
callsign=callsign0(i+1:)
endif
if(issfx) then
tsfx=rof
k=nchar(tsfx(1:1))
k=37*k + nchar(tsfx(2:2))
k=37*k + nchar(tsfx(3:3))
nv2=2
i=index(callsign0,'/')
callsign=callsign0(:i-1)
endif
endif
endif
return
end
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.f'
callsign0=callsign
nv2=0
iz=index(callsign,' ') - 1
if(iz.lt.0) iz=12
islash=index(callsign(1:iz),'/')
k=0
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
go to 10
endif
enddo
if(addpfx.eq.c) then
k=449
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
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
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=1
i=index(callsign0,'/')
callsign=callsign0(:i-1)
callsign=callsign0(i+1:)
endif
if(issfx) then
tsfx=rof
k=nchar(tsfx(1:1))
k=37*k + nchar(tsfx(2:2))
k=37*k + nchar(tsfx(3:3))
nv2=2
i=index(callsign0,'/')
callsign=callsign0(:i-1)
endif
endif
endif
return
end
libm65/getpfx2.f
+24 -24
View File
@@ -1,24 +1,24 @@
subroutine getpfx2(k0,callsign)
character callsign*12
include 'pfx.f'
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(k0,callsign)
character callsign*12
include 'pfx.f'
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
libm65/graycode.f
+10 -10
View File
@@ -1,10 +1,10 @@
subroutine graycode(dat,n,idir)
integer dat(n)
do i=1,n
dat(i)=igray(dat(i),idir)
enddo
return
end
subroutine graycode(dat,n,idir)
integer dat(n)
do i=1,n
dat(i)=igray(dat(i),idir)
enddo
return
end
libm65/grid2deg.f
+38 -38
View File
@@ -1,38 +1,38 @@
subroutine grid2deg(grid0,dlong,dlat)
C Converts Maidenhead grid locator to degrees of West longitude
C and North latitude.
character*6 grid0,grid
character*1 g1,g2,g3,g4,g5,g6
grid=grid0
i=ichar(grid(5:5))
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)=
+ char(ichar(grid(1:1))+ichar('A')-ichar('a'))
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)=
+ char(ichar(grid(2:2))+ichar('A')-ichar('a'))
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)=
+ char(ichar(grid(5:5))-ichar('A')+ichar('a'))
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)=
+ char(ichar(grid(6:6))-ichar('A')+ichar('a'))
g1=grid(1:1)
g2=grid(2:2)
g3=grid(3:3)
g4=grid(4:4)
g5=grid(5:5)
g6=grid(6:6)
nlong = 180 - 20*(ichar(g1)-ichar('A'))
n20d = 2*(ichar(g3)-ichar('0'))
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
dlong = nlong - n20d - xminlong/60.0
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
dlat = nlat + xminlat/60.0
return
end
subroutine grid2deg(grid0,dlong,dlat)
C Converts Maidenhead grid locator to degrees of West longitude
C and North latitude.
character*6 grid0,grid
character*1 g1,g2,g3,g4,g5,g6
grid=grid0
i=ichar(grid(5:5))
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)=
+ char(ichar(grid(1:1))+ichar('A')-ichar('a'))
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)=
+ char(ichar(grid(2:2))+ichar('A')-ichar('a'))
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)=
+ char(ichar(grid(5:5))-ichar('A')+ichar('a'))
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)=
+ char(ichar(grid(6:6))-ichar('A')+ichar('a'))
g1=grid(1:1)
g2=grid(2:2)
g3=grid(3:3)
g4=grid(4:4)
g5=grid(5:5)
g6=grid(6:6)
nlong = 180 - 20*(ichar(g1)-ichar('A'))
n20d = 2*(ichar(g3)-ichar('0'))
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
dlong = nlong - n20d - xminlong/60.0
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
dlat = nlat + xminlat/60.0
return
end
libm65/grid2k.f
+12 -12
View File
@@ -1,12 +1,12 @@
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(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
libm65/igray.c
+22 -22
View File
@@ -1,22 +1,22 @@
#ifdef CVF
extern int __stdcall IGRAY(int *n0, int *idir)
#else
int igray_(int *n0, int *idir)
#endif
{
int n;
unsigned long sh;
unsigned long nn;
n=*n0;
if(*idir>0) return (n ^ (n >> 1));
sh = 1;
nn = (n >> sh);
while (nn > 0) {
n ^= nn;
sh <<= 1;
nn = (n >> sh);
}
return (n);
}
#ifdef CVF
extern int __stdcall IGRAY(int *n0, int *idir)
#else
int igray_(int *n0, int *idir)
#endif
{
int n;
unsigned long sh;
unsigned long nn;
n=*n0;
if(*idir>0) return (n ^ (n >> 1));
sh = 1;
nn = (n >> sh);
while (nn > 0) {
n ^= nn;
sh <<= 1;
nn = (n >> sh);
}
return (n);
}
libm65/indexx.f
+19 -19
View File
@@ -1,19 +1,19 @@
subroutine indexx(n,arr,indx)
parameter (NMAX=3000)
integer indx(n)
real arr(n)
real brr(NMAX)
if(n.gt.NMAX) then
print*,'n=',n,' too big in indexx.'
stop
endif
do i=1,n
brr(i)=arr(i)
indx(i)=i
enddo
call ssort(brr,indx,n,2)
return
end
subroutine indexx(n,arr,indx)
parameter (NMAX=3000)
integer indx(n)
real arr(n)
real brr(NMAX)
if(n.gt.NMAX) then
print*,'n=',n,' too big in indexx.'
stop
endif
do i=1,n
brr(i)=arr(i)
indx(i)=i
enddo
call ssort(brr,indx,n,2)
return
end
libm65/init_rs.c
+126 -126
View File
@@ -1,126 +1,126 @@
/* Initialize a RS codec
*
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <stdlib.h>
#ifdef CCSDS
#include "ccsds.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
#define NULL ((void *)0)
void FREE_RS(void *p){
struct rs *rs = (struct rs *)p;
free(rs->alpha_to);
free(rs->index_of);
free(rs->genpoly);
free(rs);
}
/* Initialize a Reed-Solomon codec
* symsize = symbol size, bits (1-8)
* gfpoly = Field generator polynomial coefficients
* fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of roots)
* pad = padding bytes at front of shortened block
*/
void *INIT_RS(int symsize,int gfpoly,int fcr,int prim,
int nroots,int pad){
struct rs *rs;
int i, j, sr,root,iprim;
/* Check parameter ranges */
if(symsize < 0 || symsize > 8*sizeof(DTYPE))
return NULL; /* Need version with ints rather than chars */
if(fcr < 0 || fcr >= (1<<symsize))
return NULL;
if(prim <= 0 || prim >= (1<<symsize))
return NULL;
if(nroots < 0 || nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */
if(pad < 0 || pad >= ((1<<symsize) -1 - nroots))
return NULL; /* Too much padding */
rs = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize;
rs->nn = (1<<symsize)-1;
rs->pad = pad;
rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->alpha_to == NULL){
free(rs);
return NULL;
}
rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->index_of == NULL){
free(rs->alpha_to);
free(rs);
return NULL;
}
/* Generate Galois field lookup tables */
rs->index_of[0] = A0; /* log(zero) = -inf */
rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */
sr = 1;
for(i=0;i<rs->nn;i++){
rs->index_of[sr] = i;
rs->alpha_to[i] = sr;
sr <<= 1;
if(sr & (1<<symsize))
sr ^= gfpoly;
sr &= rs->nn;
}
if(sr != 1){
/* field generator polynomial is not primitive! */
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
/* Form RS code generator polynomial from its roots */
rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1));
if(rs->genpoly == NULL){
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
rs->fcr = fcr;
rs->prim = prim;
rs->nroots = nroots;
/* Find prim-th root of 1, used in decoding */
for(iprim=1;(iprim % prim) != 0;iprim += rs->nn)
;
rs->iprim = iprim / prim;
rs->genpoly[0] = 1;
for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) {
rs->genpoly[i+1] = 1;
/* Multiply rs->genpoly[] by @**(root + x) */
for (j = i; j > 0; j--){
if (rs->genpoly[j] != 0)
rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)];
else
rs->genpoly[j] = rs->genpoly[j-1];
}
/* rs->genpoly[0] can never be zero */
rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)];
}
/* convert rs->genpoly[] to index form for quicker encoding */
for (i = 0; i <= nroots; i++)
rs->genpoly[i] = rs->index_of[rs->genpoly[i]];
return rs;
}
/* Initialize a RS codec
*
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <stdlib.h>
#ifdef CCSDS
#include "ccsds.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
#define NULL ((void *)0)
void FREE_RS(void *p){
struct rs *rs = (struct rs *)p;
free(rs->alpha_to);
free(rs->index_of);
free(rs->genpoly);
free(rs);
}
/* Initialize a Reed-Solomon codec
* symsize = symbol size, bits (1-8)
* gfpoly = Field generator polynomial coefficients
* fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of roots)
* pad = padding bytes at front of shortened block
*/
void *INIT_RS(int symsize,int gfpoly,int fcr,int prim,
int nroots,int pad){
struct rs *rs;
int i, j, sr,root,iprim;
/* Check parameter ranges */
if(symsize < 0 || symsize > 8*sizeof(DTYPE))
return NULL; /* Need version with ints rather than chars */
if(fcr < 0 || fcr >= (1<<symsize))
return NULL;
if(prim <= 0 || prim >= (1<<symsize))
return NULL;
if(nroots < 0 || nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */
if(pad < 0 || pad >= ((1<<symsize) -1 - nroots))
return NULL; /* Too much padding */
rs = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize;
rs->nn = (1<<symsize)-1;
rs->pad = pad;
rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->alpha_to == NULL){
free(rs);
return NULL;
}
rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->index_of == NULL){
free(rs->alpha_to);
free(rs);
return NULL;
}
/* Generate Galois field lookup tables */
rs->index_of[0] = A0; /* log(zero) = -inf */
rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */
sr = 1;
for(i=0;i<rs->nn;i++){
rs->index_of[sr] = i;
rs->alpha_to[i] = sr;
sr <<= 1;
if(sr & (1<<symsize))
sr ^= gfpoly;
sr &= rs->nn;
}
if(sr != 1){
/* field generator polynomial is not primitive! */
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
/* Form RS code generator polynomial from its roots */
rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1));
if(rs->genpoly == NULL){
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
rs->fcr = fcr;
rs->prim = prim;
rs->nroots = nroots;
/* Find prim-th root of 1, used in decoding */
for(iprim=1;(iprim % prim) != 0;iprim += rs->nn)
;
rs->iprim = iprim / prim;
rs->genpoly[0] = 1;
for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) {
rs->genpoly[i+1] = 1;
/* Multiply rs->genpoly[] by @**(root + x) */
for (j = i; j > 0; j--){
if (rs->genpoly[j] != 0)
rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)];
else
rs->genpoly[j] = rs->genpoly[j-1];
}
/* rs->genpoly[0] can never be zero */
rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)];
}
/* convert rs->genpoly[] to index form for quicker encoding */
for (i = 0; i <= nroots; i++)
rs->genpoly[i] = rs->index_of[rs->genpoly[i]];
return rs;
}
libm65/int.h
+57 -57
View File
@@ -1,57 +1,57 @@
/* Include file to configure the RS codec for integer symbols
*
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE int
/* Reed-Solomon codec control block */
struct rs {
int mm; /* Bits per symbol */
int nn; /* Symbols per block (= (1<<mm)-1) */
DTYPE *alpha_to; /* log lookup table */
DTYPE *index_of; /* Antilog lookup table */
DTYPE *genpoly; /* Generator polynomial */
int nroots; /* Number of generator roots = number of parity symbols */
int fcr; /* First consecutive root, index form */
int prim; /* Primitive element, index form */
int iprim; /* prim-th root of 1, index form */
int pad; /* Padding bytes in shortened block */
};
static int modnn(struct rs *rs,int x){
while (x >= rs->nn) {
x -= rs->nn;
x = (x >> rs->mm) + (x & rs->nn);
}
return x;
}
#define MODNN(x) modnn(rs,x)
#define MM (rs->mm)
#define NN (rs->nn)
#define ALPHA_TO (rs->alpha_to)
#define INDEX_OF (rs->index_of)
#define GENPOLY (rs->genpoly)
//#define NROOTS (rs->nroots)
#define NROOTS (51)
#define FCR (rs->fcr)
#define PRIM (rs->prim)
#define IPRIM (rs->iprim)
#define PAD (rs->pad)
#define A0 (NN)
#define ENCODE_RS encode_rs_int
#define DECODE_RS decode_rs_int
#define INIT_RS init_rs_int
#define FREE_RS free_rs_int
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras);
void *INIT_RS(int symsize,int gfpoly,int fcr,
int prim,int nroots,int pad);
void FREE_RS(void *p);
/* Include file to configure the RS codec for integer symbols
*
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE int
/* Reed-Solomon codec control block */
struct rs {
int mm; /* Bits per symbol */
int nn; /* Symbols per block (= (1<<mm)-1) */
DTYPE *alpha_to; /* log lookup table */
DTYPE *index_of; /* Antilog lookup table */
DTYPE *genpoly; /* Generator polynomial */
int nroots; /* Number of generator roots = number of parity symbols */
int fcr; /* First consecutive root, index form */
int prim; /* Primitive element, index form */
int iprim; /* prim-th root of 1, index form */
int pad; /* Padding bytes in shortened block */
};
static int modnn(struct rs *rs,int x){
while (x >= rs->nn) {
x -= rs->nn;
x = (x >> rs->mm) + (x & rs->nn);
}
return x;
}
#define MODNN(x) modnn(rs,x)
#define MM (rs->mm)
#define NN (rs->nn)
#define ALPHA_TO (rs->alpha_to)
#define INDEX_OF (rs->index_of)
#define GENPOLY (rs->genpoly)
//#define NROOTS (rs->nroots)
#define NROOTS (51)
#define FCR (rs->fcr)
#define PRIM (rs->prim)
#define IPRIM (rs->iprim)
#define PAD (rs->pad)
#define A0 (NN)
#define ENCODE_RS encode_rs_int
#define DECODE_RS decode_rs_int
#define INIT_RS init_rs_int
#define FREE_RS free_rs_int
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras);
void *INIT_RS(int symsize,int gfpoly,int fcr,
int prim,int nroots,int pad);
void FREE_RS(void *p);
libm65/interleave63.f
+25 -25
View File
@@ -1,25 +1,25 @@
subroutine interleave63(d1,idir)
C Interleave (idir=1) or de-interleave (idir=-1) the array d1.
integer d1(0:6,0:8)
integer d2(0:8,0:6)
if(idir.ge.0) then
do i=0,6
do j=0,8
d2(j,i)=d1(i,j)
enddo
enddo
call move(d2,d1,63)
else
call move(d1,d2,63)
do i=0,6
do j=0,8
d1(i,j)=d2(j,i)
enddo
enddo
endif
return
end
subroutine interleave63(d1,idir)
C Interleave (idir=1) or de-interleave (idir=-1) the array d1.
integer d1(0:6,0:8)
integer d2(0:8,0:6)
if(idir.ge.0) then
do i=0,6
do j=0,8
d2(j,i)=d1(i,j)
enddo
enddo
call move(d2,d1,63)
else
call move(d1,d2,63)
do i=0,6
do j=0,8
d1(i,j)=d2(j,i)
enddo
enddo
endif
return
end
libm65/ipcomm.cpp
+34 -34
View File
@@ -1,34 +1,34 @@
#include <QDebug>
#include <qsharedmemory.h>
#include <QSystemSemaphore>
QSharedMemory mem_m65("mem_m65");
QSystemSemaphore sem_m65("sem_m65", 1, QSystemSemaphore::Open);
extern "C" {
bool attach_m65_();
bool create_m65_(int nsize);
bool detach_m65_();
bool lock_m65_();
bool unlock_m65_();
char* address_m65_();
int size_m65_();
bool acquire_m65_();
bool release_m65_();
extern struct {
char c[10];
} m65com_;
}
bool attach_m65_() {return mem_m65.attach();}
bool create_m65_(int nsize) {return mem_m65.create(nsize);}
bool detach_m65_() {return mem_m65.detach();}
bool lock_m65_() {return mem_m65.lock();}
bool unlock_m65_() {return mem_m65.unlock();}
char* address_m65_() {return (char*)mem_m65.constData();}
int size_m65_() {return (int)mem_m65.size();}
bool acquire_m65_() {return sem_m65.acquire();}
bool release_m65_() {return sem_m65.release();}
#include <QDebug>
#include <qsharedmemory.h>
#include <QSystemSemaphore>
QSharedMemory mem_m65("mem_m65");
QSystemSemaphore sem_m65("sem_m65", 1, QSystemSemaphore::Open);
extern "C" {
bool attach_m65_();
bool create_m65_(int nsize);
bool detach_m65_();
bool lock_m65_();
bool unlock_m65_();
char* address_m65_();
int size_m65_();
bool acquire_m65_();
bool release_m65_();
extern struct {
char c[10];
} m65com_;
}
bool attach_m65_() {return mem_m65.attach();}
bool create_m65_(int nsize) {return mem_m65.create(nsize);}
bool detach_m65_() {return mem_m65.detach();}
bool lock_m65_() {return mem_m65.lock();}
bool unlock_m65_() {return mem_m65.unlock();}
char* address_m65_() {return (char*)mem_m65.constData();}
int size_m65_() {return (int)mem_m65.size();}
bool acquire_m65_() {return sem_m65.acquire();}
bool release_m65_() {return sem_m65.release();}
libm65/iqcal.f90
+30 -30
View File
@@ -1,30 +1,30 @@
subroutine iqcal(nn,c,nfft,gain,phase,zsum,ipk,reject)
complex c(0:nfft-1)
complex z,zsum,zave
if(nn.eq.0) then
zsum=0.
endif
nn=nn+1
smax=0.
ipk=1
do i=1,nfft-1 !Find strongest signal
s=real(c(i))**2 + aimag(c(i))**2
if(s.gt.smax) then
smax=s
ipk=i
endif
enddo
pimage=real(c(nfft-ipk))**2 + aimag(c(nfft-ipk))**2
p=smax + pimage
z=c(ipk)*c(nfft-ipk)/p !Synchronous detection of image
zsum=zsum+z
zave=zsum/nn
tmp=sqrt(1.0 - (2.0*real(zave))**2)
phase=asin(2.0*aimag(zave)/tmp) !Estimate phase
gain=tmp/(1.0-2.0*real(zave)) !Estimate gain
reject=10.0*log10(pimage/smax)
return
end subroutine iqcal
subroutine iqcal(nn,c,nfft,gain,phase,zsum,ipk,reject)
complex c(0:nfft-1)
complex z,zsum,zave
if(nn.eq.0) then
zsum=0.
endif
nn=nn+1
smax=0.
ipk=1
do i=1,nfft-1 !Find strongest signal
s=real(c(i))**2 + aimag(c(i))**2
if(s.gt.smax) then
smax=s
ipk=i
endif
enddo
pimage=real(c(nfft-ipk))**2 + aimag(c(nfft-ipk))**2
p=smax + pimage
z=c(ipk)*c(nfft-ipk)/p !Synchronous detection of image
zsum=zsum+z
zave=zsum/nn
tmp=sqrt(1.0 - (2.0*real(zave))**2)
phase=asin(2.0*aimag(zave)/tmp) !Estimate phase
gain=tmp/(1.0-2.0*real(zave)) !Estimate gain
reject=10.0*log10(pimage/smax)
return
end subroutine iqcal
libm65/iqfix.f90
+29 -29
View File
@@ -1,29 +1,29 @@
subroutine iqfix(c,nfft,gain,phase)
complex c(0:nfft-1)
complex z,h,u,v
real*8 sq1,sq2
nh=nfft/2
h=gain*cmplx(cos(phase),sin(phase))
do i=1,nh-1
u=c(i)
v=c(nfft-i)
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
c(i)=0.5*cmplx(x,y)
z=u
u=v
v=z
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
c(nfft-i)=0.5*cmplx(x,y)
enddo
return
end subroutine iqfix
subroutine iqfix(c,nfft,gain,phase)
complex c(0:nfft-1)
complex z,h,u,v
real*8 sq1,sq2
nh=nfft/2
h=gain*cmplx(cos(phase),sin(phase))
do i=1,nh-1
u=c(i)
v=c(nfft-i)
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
c(i)=0.5*cmplx(x,y)
z=u
u=v
v=z
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
c(nfft-i)=0.5*cmplx(x,y)
enddo
return
end subroutine iqfix
libm65/k2grid.f
+12 -12
View File
@@ -1,12 +1,12 @@
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(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
libm65/m65.f90
+130 -130
View File
@@ -1,130 +1,130 @@
program m65
! Decoder for map65. Can run stand-alone, reading data from *.tf2 files;
! or as the back end of map65, with data placed in a shared memory region.
parameter (NSMAX=60*96000)
parameter (NFFT=32768)
integer*2 i2(4,87)
real*8 hsym
real*4 ssz5a(NFFT)
logical*1 lstrong(0:1023)
common/tracer/limtrace,lu
real*8 fc0,fcenter
character*80 arg,infile
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,datetime*20
common/datcom/dd(4,5760000),ss(4,322,NFFT),savg(4,NFFT),fc0,nutc0,junk(34)
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
mycall,mygrid,hiscall,hisgrid,datetime
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: m65 [95238] file1 [file2 ...]'
print*,' Reads data from *.tf2 files.'
print*,''
print*,' m65 -s'
print*,' Gets data from shared memory region.'
go to 999
endif
call getarg(1,arg)
if(arg(1:2).eq.'-s') then
call m65a
call ftnquit
go to 999
endif
nfsample=96000
nxpol=1
mode65=2
ifile1=1
if(arg.eq.'95238') then
nfsample=95238
call getarg(2,arg)
ifile1=2
endif
limtrace=0
lu=12
nfa=100
nfb=162
nfshift=6
ndepth=2
nfcal=344
idphi=-50
ntol=500
nkeep=10
call ftninit('.')
do ifile=ifile1,nargs
call getarg(ifile,infile)
open(10,file=infile,access='stream',status='old',err=998)
i1=index(infile,'.tf2')
read(infile(i1-4:i1-1),*,err=1) nutc0
go to 2
1 nutc0=0
2 hsym=2048.d0*96000.d0/11025.d0 !Samples per half symbol
nhsym0=-999
k=0
fcenter=144.125d0
mousedf=0
mousefqso=125
newdat=1
mycall='K1JT'
if(ifile.eq.ifile1) call timer('m65 ',0)
do irec=1,9999999
call timer('read_tf2',0)
read(10) i2
call timer('read_tf2',1)
call timer('float ',0)
do i=1,87
k=k+1
dd(1,k)=i2(1,i)
dd(2,k)=i2(2,i)
dd(3,k)=i2(3,i)
dd(4,k)=i2(4,i)
enddo
call timer('float ',1)
nhsym=(k-2048)/hsym
if(nhsym.ge.1 .and. nhsym.ne.nhsym0) then
ndiskdat=1
nb=0
! Emit signal readyForFFT
call timer('symspec ',0)
fgreen=-13.0
iqadjust=1
iqapply=1
nbslider=100
gainx=0.9962
gainy=1.0265
phasex=0.01426
phasey=-0.01195
call symspec(k,nxpol,ndiskdat,nb,nbslider,idphi,nfsample,fgreen, &
iqadjust,iqapply,gainx,gainy,phasex,phasey,rejectx,rejecty, &
pxdb,pydb,ssz5a,nkhz,ihsym,nzap,slimit,lstrong)
call timer('symspec ',1)
nhsym0=nhsym
if(ihsym.ge.278) go to 10
endif
enddo
10 continue
if(iqadjust.ne.0) write(*,3002) rejectx,rejecty
3002 format('Image rejection:',2f7.1,' dB')
nutc=nutc0
nstandalone=1
call decode0(dd,ss,savg,nstandalone,nfsample)
enddo
call timer('m65 ',1)
call timer('m65 ',101)
call ftnquit
go to 999
998 print*,'Cannot open file:'
print*,infile
999 end program m65
program m65
! Decoder for map65. Can run stand-alone, reading data from *.tf2 files;
! or as the back end of map65, with data placed in a shared memory region.
parameter (NSMAX=60*96000)
parameter (NFFT=32768)
integer*2 i2(4,87)
real*8 hsym
real*4 ssz5a(NFFT)
logical*1 lstrong(0:1023)
common/tracer/limtrace,lu
real*8 fc0,fcenter
character*80 arg,infile
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,datetime*20
common/datcom/dd(4,5760000),ss(4,322,NFFT),savg(4,NFFT),fc0,nutc0,junk(34)
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
mycall,mygrid,hiscall,hisgrid,datetime
nargs=iargc()
if(nargs.lt.1) then
print*,'Usage: m65 [95238] file1 [file2 ...]'
print*,' Reads data from *.tf2 files.'
print*,''
print*,' m65 -s'
print*,' Gets data from shared memory region.'
go to 999
endif
call getarg(1,arg)
if(arg(1:2).eq.'-s') then
call m65a
call ftnquit
go to 999
endif
nfsample=96000
nxpol=1
mode65=2
ifile1=1
if(arg.eq.'95238') then
nfsample=95238
call getarg(2,arg)
ifile1=2
endif
limtrace=0
lu=12
nfa=100
nfb=162
nfshift=6
ndepth=2
nfcal=344
idphi=-50
ntol=500
nkeep=10
call ftninit('.')
do ifile=ifile1,nargs
call getarg(ifile,infile)
open(10,file=infile,access='stream',status='old',err=998)
i1=index(infile,'.tf2')
read(infile(i1-4:i1-1),*,err=1) nutc0
go to 2
1 nutc0=0
2 hsym=2048.d0*96000.d0/11025.d0 !Samples per half symbol
nhsym0=-999
k=0
fcenter=144.125d0
mousedf=0
mousefqso=125
newdat=1
mycall='K1JT'
if(ifile.eq.ifile1) call timer('m65 ',0)
do irec=1,9999999
call timer('read_tf2',0)
read(10) i2
call timer('read_tf2',1)
call timer('float ',0)
do i=1,87
k=k+1
dd(1,k)=i2(1,i)
dd(2,k)=i2(2,i)
dd(3,k)=i2(3,i)
dd(4,k)=i2(4,i)
enddo
call timer('float ',1)
nhsym=(k-2048)/hsym
if(nhsym.ge.1 .and. nhsym.ne.nhsym0) then
ndiskdat=1
nb=0
! Emit signal readyForFFT
call timer('symspec ',0)
fgreen=-13.0
iqadjust=1
iqapply=1
nbslider=100
gainx=0.9962
gainy=1.0265
phasex=0.01426
phasey=-0.01195
call symspec(k,nxpol,ndiskdat,nb,nbslider,idphi,nfsample,fgreen, &
iqadjust,iqapply,gainx,gainy,phasex,phasey,rejectx,rejecty, &
pxdb,pydb,ssz5a,nkhz,ihsym,nzap,slimit,lstrong)
call timer('symspec ',1)
nhsym0=nhsym
if(ihsym.ge.278) go to 10
endif
enddo
10 continue
if(iqadjust.ne.0) write(*,3002) rejectx,rejecty
3002 format('Image rejection:',2f7.1,' dB')
nutc=nutc0
nstandalone=1
call decode0(dd,ss,savg,nstandalone,nfsample)
enddo
call timer('m65 ',1)
call timer('m65 ',101)
call ftnquit
go to 999
998 print*,'Cannot open file:'
print*,infile
999 end program m65
libm65/m65a.F90
+97 -97
View File
@@ -1,97 +1,97 @@
subroutine m65a
! NB: this interface block is required by g95, but must be omitted
! for gfortran. (????)
#ifndef UNIX
interface
function address_m65()
end function address_m65
end interface
#endif
integer*1 attach_m65,lock_m65,unlock_m65
integer size_m65
integer*1, pointer :: address_m65,p_m65
character*80 cwd
logical fileExists
common/tracer/limtrace,lu
call getcwd(cwd)
call ftninit(trim(cwd))
limtrace=0
lu=12
i1=attach_m65()
10 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
if(fileExists) then
call sleep_msec(100)
go to 10
endif
inquire(file=trim(cwd)//'/.quit',exist=fileExists)
if(fileExists) then
call ftnquit
i=detach_m65()
go to 999
endif
nbytes=size_m65()
if(nbytes.le.0) then
print*,'m65a: Shared memory mem_m65 does not exist.'
print*,'Program m65a should be started automatically from within map65.'
go to 999
endif
p_m65=>address_m65()
call m65b(p_m65,nbytes)
write(*,1010)
1010 format('<m65aFinished>')
flush(6)
100 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
if(fileExists) go to 10
call sleep_msec(100)
go to 100
999 return
end subroutine m65a
subroutine m65b(m65com,nbytes)
integer*1 m65com(0:nbytes-1)
kss=4*4*60*96000
ksavg=kss+4*4*322*32768
kfcenter=ksavg+4*4*32768
call m65c(m65com(0),m65com(kss),m65com(ksavg),m65com(kfcenter))
return
end subroutine m65b
subroutine m65c(dd,ss,savg,nparams0)
integer*1 detach_m65
real*4 dd(4,5760000),ss(4,322,32768),savg(4,32768)
real*8 fcenter
integer nparams0(37),nparams(37)
character*12 mycall,hiscall
character*6 mygrid,hisgrid
character*20 datetime
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
mycall,mygrid,hiscall,hisgrid,datetime
equivalence (nparams,fcenter)
nparams=nparams0 !Copy parameters into common/npar/
npatience=1
if(iand(nrxlog,1).ne.0) then
write(21,1000) datetime(:17)
1000 format(/'UTC Date: 'a17/78('-'))
flush(21)
endif
if(iand(nrxlog,2).ne.0) rewind 21
if(iand(nrxlog,4).ne.0) rewind 26
nstandalone=0
if(sum(nparams).ne.0) call decode0(dd,ss,savg,nstandalone)
return
end subroutine m65c
subroutine m65a
! NB: this interface block is required by g95, but must be omitted
! for gfortran. (????)
#ifndef UNIX
interface
function address_m65()
end function address_m65
end interface
#endif
integer*1 attach_m65,lock_m65,unlock_m65
integer size_m65
integer*1, pointer :: address_m65,p_m65
character*80 cwd
logical fileExists
common/tracer/limtrace,lu
call getcwd(cwd)
call ftninit(trim(cwd))
limtrace=0
lu=12
i1=attach_m65()
10 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
if(fileExists) then
call sleep_msec(100)
go to 10
endif
inquire(file=trim(cwd)//'/.quit',exist=fileExists)
if(fileExists) then
call ftnquit
i=detach_m65()
go to 999
endif
nbytes=size_m65()
if(nbytes.le.0) then
print*,'m65a: Shared memory mem_m65 does not exist.'
print*,'Program m65a should be started automatically from within map65.'
go to 999
endif
p_m65=>address_m65()
call m65b(p_m65,nbytes)
write(*,1010)
1010 format('<m65aFinished>')
flush(6)
100 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
if(fileExists) go to 10
call sleep_msec(100)
go to 100
999 return
end subroutine m65a
subroutine m65b(m65com,nbytes)
integer*1 m65com(0:nbytes-1)
kss=4*4*60*96000
ksavg=kss+4*4*322*32768
kfcenter=ksavg+4*4*32768
call m65c(m65com(0),m65com(kss),m65com(ksavg),m65com(kfcenter))
return
end subroutine m65b
subroutine m65c(dd,ss,savg,nparams0)
integer*1 detach_m65
real*4 dd(4,5760000),ss(4,322,32768),savg(4,32768)
real*8 fcenter
integer nparams0(37),nparams(37)
character*12 mycall,hiscall
character*6 mygrid,hisgrid
character*20 datetime
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
mycall,mygrid,hiscall,hisgrid,datetime
equivalence (nparams,fcenter)
nparams=nparams0 !Copy parameters into common/npar/
npatience=1
if(iand(nrxlog,1).ne.0) then
write(21,1000) datetime(:17)
1000 format(/'UTC Date: 'a17/78('-'))
flush(21)
endif
if(iand(nrxlog,2).ne.0) rewind 21
if(iand(nrxlog,4).ne.0) rewind 26
nstandalone=0
if(sum(nparams).ne.0) call decode0(dd,ss,savg,nstandalone)
return
end subroutine m65c
libm65/map65a.f90
+438 -438
View File
@@ -1,438 +1,438 @@
subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
nfcal,nkeep,mcall3b,nsave,nxant,rmsdd,mycall,mygrid, &
neme,ndepth,hiscall,hisgrid,nhsym,nfsample,nxpol,mode65)
! Processes timf2 data from Linrad to find and decode JT65 signals.
parameter (MAXMSG=1000) !Size of decoded message list
parameter (NSMAX=60*96000)
parameter (NFFT=32768)
real dd(4,NSMAX)
real*4 ss(4,322,NFFT),savg(4,NFFT)
real tavg(-50:50) !Temp for finding local base level
real base(4) !Local basel level at 4 pol'ns
real tmp (200) !Temp storage for pctile sorting
real sig(MAXMSG,30) !Parameters of detected signals
real a(5)
real*8 fcenter
character*22 msg(MAXMSG)
character*3 shmsg0(4)
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,grid*6,cp*1
integer indx(MAXMSG),nsiz(MAXMSG)
logical done(MAXMSG)
logical xpol
character decoded*22,blank*22
real short(3,NFFT) !SNR dt ipol for potential shorthands
real qphi(12)
common/c3com/ mcall3a
common/testcom/ifreq
data blank/' '/
data shmsg0/'ATT','RO ','RRR','73 '/
data nfile/0/,nutc0/-999/,nid/0/,ip000/1/,ip001/1/,mousefqso0/-999/
save
mcall3a=mcall3b
mousefqso0=mousefqso
xpol=(nxpol.ne.0)
if(.not.xpol) ndphi=0
!### Should use AppDir! ###
! open(23,file='release/CALL3.TXT',status='unknown')
open(23,file='CALL3.TXT',status='unknown')
if(nutc.ne.nutc0) nfile=nfile+1
nutc0=nutc
df=96000.0/NFFT !df = 96000/NFFT = 2.930 Hz
if(nfsample.eq.95238) df=95238.1/NFFT
ftol=0.010 !Frequency tolerance (kHz)
dphi=idphi/57.2957795
foffset=0.001*(1270 + nfcal) !Offset from sync tone, plus CAL
fqso=mousefqso + foffset - 0.5*(nfa+nfb) + nfshift !fqso at baseband (khz)
iloop=0
2 if(ndphi.eq.1) dphi=30*iloop/57.2957795
do nqd=1,0,-1
if(nqd.eq.1) then !Quick decode, at fQSO
fa=1000.0*(fqso+0.001*mousedf) - ntol
fb=1000.0*(fqso+0.001*mousedf) + ntol + 4*53.8330078
else !Wideband decode at all freqs
fa=-1000*0.5*(nfb-nfa) + 1000*nfshift
fb= 1000*0.5*(nfb-nfa) + 1000*nfshift
endif
ia=nint(fa/df) + 16385
ib=nint(fb/df) + 16385
ia=max(51,ia)
ib=min(32768-51,ib)
km=0
nkm=1
nz=n/8
freq0=-999.
sync10=-999.
fshort0=-999.
syncshort0=-999.
ntry=0
short=0. !Zero the whole short array
jpz=1
if(xpol) jpz=4
do i=ia,ib !Search over freq range
freq=0.001*(i-16385)*df
! Find the local base level for each polarization; update every 10 bins.
if(mod(i-ia,10).eq.0) then
do jp=1,jpz
do ii=-50,50
iii=i+ii
if(iii.ge.1 .and. iii.le.32768) then
tavg(ii)=savg(jp,iii)
else
write(13,*) ,'Error in iii:',iii,ia,ib,fa,fb
flush(13)
go to 999
endif
enddo
call pctile(tavg,tmp,101,50,base(jp))
enddo
endif
! Find max signal at this frequency
smax=0.
do jp=1,jpz
if(savg(jp,i)/base(jp).gt.smax) then
smax=savg(jp,i)/base(jp)
jpmax=jp
endif
enddo
if(smax.gt.1.1) then
! Look for JT65 sync patterns and shorthand square-wave patterns.
call timer('ccf65 ',0)
! ssmax=4.0*(rmsdd/22.5)**2
ssmax=savg(jpmax,i)
call ccf65(ss(1,1,i),nhsym,ssmax,sync1,ipol,jpz,dt,flipk, &
syncshort,snr2,ipol2,dt2)
call timer('ccf65 ',1)
! ########################### Search for Shorthand Messages #################
! Is there a shorthand tone above threshold?
thresh0=1.0
! Use lower thresh0 at fQSO
if(nqd.eq.1 .and. ntol.le.100) thresh0=0.
if(syncshort.gt.thresh0) then
! ### Do shorthand AFC here (or maybe after finding a pair?) ###
short(1,i)=syncshort
short(2,i)=dt2
short(3,i)=ipol2
! Check to see if lower tone of shorthand pair was found.
do j=2,4
i0=i-nint(j*mode65*10.0*(11025.0/4096.0)/df)
! Should this be i0 +/- 1, or just i0?
! Should we also insist that difference in DT be either 1.5 or -1.5 s?
if(short(1,i0).gt.thresh0) then
fshort=0.001*(i0-16385)*df
noffset=0
if(nqd.eq.1) noffset=nint(1000.0*(fshort-fqso)-mousedf)
if(abs(noffset).le.ntol) then
! Keep only the best candidate within ftol.
!### NB: sync2 was not defined here!
! sync2=syncshort !### try this ???
if(fshort-fshort0.le.ftol .and. syncshort.gt.syncshort0 &
.and. nkm.eq.2) km=km-1
if(fshort-fshort0.gt.ftol .or. &
syncshort.gt.syncshort0) then
if(km.lt.MAXMSG) km=km+1
sig(km,1)=nfile
sig(km,2)=nutc
sig(km,3)=fshort + 0.5*(nfa+nfb)
sig(km,4)=syncshort
sig(km,5)=dt2
sig(km,6)=45*(ipol2-1)/57.2957795
sig(km,7)=0
sig(km,8)=snr2
sig(km,9)=0
sig(km,10)=0
! sig(km,11)=rms0
sig(km,12)=savg(ipol2,i)
sig(km,13)=0
sig(km,14)=0
sig(km,15)=0
sig(km,16)=0
! sig(km,17)=0
sig(km,18)=0
msg(km)=shmsg0(j)
fshort0=fshort
syncshort0=syncshort
nkm=2
endif
endif
endif
enddo
endif
! ########################### Search for Normal Messages ###########
! Is sync1 above threshold?
thresh1=1.0
! Use lower thresh1 at fQSO
if(nqd.eq.1 .and. ntol.le.100) thresh1=0.
noffset=0
if(nqd.eq.1) noffset=nint(1000.0*(freq-fqso)-mousedf)
if(sync1.gt.thresh1 .and. abs(noffset).le.ntol) then
! Keep only the best candidate within ftol.
! (Am I deleting any good decodes by doing this?)
if(freq-freq0.le.ftol .and. sync1.gt.sync10 .and. &
nkm.eq.1) km=km-1
if(freq-freq0.gt.ftol .or. sync1.gt.sync10) then
nflip=nint(flipk)
f00=(i-1)*df !Freq of detected sync tone (0-96000 Hz)
ntry=ntry+1
if((nqd.eq.1 .and. ntry.ge.40) .or. &
(nqd.eq.0 .and. ntry.ge.400)) then
! Too many calls to decode1a!
write(*,*) '! Signal too strong? Decoding aborted.'
write(13,*) 'Signal too strong? Decoding aborted.'
call flush(13)
go to 999
endif
call timer('decode1a',0)
ifreq=i
ikHz=nint(freq+0.5*(nfa+nfb)-foffset)-nfshift
idf=nint(1000.0*(freq+0.5*(nfa+nfb)-foffset-(ikHz+nfshift)))
call decode1a(dd,newdat,f00,nflip,mode65,nfsample,xpol, &
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi, &
nutc,ikHz,idf,ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded)
dt=dt+0.8 !### empirical tweak
call timer('decode1a',1)
if(km.lt.MAXMSG) km=km+1
sig(km,1)=nfile
sig(km,2)=nutc
sig(km,3)=freq + 0.5*(nfa+nfb)
sig(km,4)=sync1
sig(km,5)=dt
sig(km,6)=pol
sig(km,7)=flipk
sig(km,8)=sync2
sig(km,9)=nkv
sig(km,10)=qual
! sig(km,11)=idphi
sig(km,12)=savg(ipol,i)
sig(km,13)=a(1)
sig(km,14)=a(2)
sig(km,15)=a(3)
sig(km,16)=a(4)
! sig(km,17)=a(5)
sig(km,18)=nhist
msg(km)=decoded
freq0=freq
sync10=sync1
nkm=1
endif
endif
endif
!70 continue
enddo
if(nqd.eq.1) then
nwrite=0
do k=1,km
decoded=msg(k)
if(decoded.ne.' ') then
nutc=sig(k,2)
freq=sig(k,3)
sync1=sig(k,4)
dt=sig(k,5)
npol=nint(57.2957795*sig(k,6))
flip=sig(k,7)
sync2=sig(k,8)
nkv=sig(k,9)
nqual=sig(k,10)
! idphi=nint(sig(k,11))
if(flip.lt.0.0) then
do i=22,1,-1
if(decoded(i:i).ne.' ') go to 8
enddo
stop 'Error in message format'
8 if(i.le.18) decoded(i+2:i+4)='OOO'
endif
nkHz=nint(freq-foffset)-nfshift
mhz=fcenter ! ... +fadd ???
f0=mhz+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-(nkHz+nfshift)))
nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6
nwrite=nwrite+1
if(nxant.ne.0) then
npol=npol-45
if(npol.lt.0) npol=npol+180
endif
! If Tx station's grid is in decoded message, compute optimum TxPol
i1=index(decoded,' ')
i2=index(decoded(i1+1:),' ') + i1
grid=' '
if(i2.ge.8 .and. i2.le.18) grid=decoded(i2+1:i2+4)//'mm'
ntxpol=0
cp=' '
if(xpol) then
if(grid(1:1).ge.'A' .and. grid(1:1).le.'R' .and. &
grid(2:2).ge.'A' .and. grid(2:2).le.'R' .and. &
grid(3:3).ge.'0' .and. grid(3:3).le.'9' .and. &
grid(4:4).ge.'0' .and. grid(4:4).le.'9') then
ntxpol=mod(npol-nint(2.0*dpol(mygrid,grid))+720,180)
if(nxant.eq.0) then
cp='H'
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
else
cp='/'
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
endif
endif
endif
if(ndphi.eq.0) then
write(*,1010) nkHz,ndf,npol,nutc,dt,nsync2, &
decoded,nkv,nqual,ntxpol,cp
1010 format('!',i3,i5,i4,i5.4,f5.1,i4,2x,a22,i5,i4,i5,1x,a1)
else
if(iloop.ge.1) qphi(iloop)=sig(k,10)
write(*,1010) nkHz,ndf,npol,nutc,dt,nsync2, &
decoded,nkv,nqual,30*iloop
write(27,1011) 30*iloop,nkHz,ndf,npol,nutc, &
dt,sync2,nkv,nqual,decoded
1011 format(i3,i4,i5,i4,i5.4,f5.1,f7.1,i3,i5,2x,a22)
endif
endif
enddo
if(nwrite.eq.0) then
write(*,1012) mousefqso,nutc
1012 format('!',i3,9x,i5.4,' ')
endif
endif
if(ndphi.eq.1 .and.iloop.lt.12) then
iloop=iloop+1
go to 2
endif
if(ndphi.eq.1 .and.iloop.eq.12) call getdphi(qphi)
if(nagain.eq.1) go to 999
enddo
! Trim the list and produce a sorted index and sizes of groups.
! (Should trimlist remove all but best SNR for given UTC and message content?)
call trimlist(sig,km,ftol,indx,nsiz,nz)
do i=1,km
done(i)=.false.
enddo
j=0
ilatest=-1
do n=1,nz
ifile0=0
do m=1,nsiz(n)
i=indx(j+m)
ifile=sig(i,1)
if(ifile.gt.ifile0 .and.msg(i).ne.blank) then
ilatest=i
ifile0=ifile
endif
enddo
i=ilatest
if(i.ge.1) then
if(.not.done(i)) then
done(i)=.true.
nutc=sig(i,2)
freq=sig(i,3)
sync1=sig(i,4)
dt=sig(i,5)
npol=nint(57.2957795*sig(i,6))
flip=sig(i,7)
sync2=sig(i,8)
nkv=sig(i,9)
nqual=min(sig(i,10),10.0)
! rms0=sig(i,11)
do k=1,5
a(k)=sig(i,12+k)
enddo
nhist=sig(i,18)
decoded=msg(i)
if(flip.lt.0.0) then
do i=22,1,-1
if(decoded(i:i).ne.' ') go to 10
enddo
stop 'Error in message format'
10 if(i.le.18) decoded(i+2:i+4)='OOO'
endif
mhz=fcenter !... +fadd ???
nkHz=nint(freq-foffset)-nfshift
f0=mhz+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-(nkHz+nfshift)))
ndf0=nint(a(1))
ndf1=nint(a(2))
ndf2=nint(a(3))
nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6
if(nxant.ne.0) then
npol=npol-45
if(npol.lt.0) npol=npol+180
endif
! If Tx station's grid is in decoded message, compute optimum TxPol
i1=index(decoded,' ')
i2=index(decoded(i1+1:),' ') + i1
grid=' '
if(i2.ge.8 .and. i2.le.18) grid=decoded(i2+1:i2+4)//'mm'
ntxpol=0
cp=' '
if(xpol) then
if(grid(1:1).ge.'A' .and. grid(1:1).le.'R' .and. &
grid(2:2).ge.'A' .and. grid(2:2).le.'R' .and. &
grid(3:3).ge.'0' .and. grid(3:3).le.'9' .and. &
grid(4:4).ge.'0' .and. grid(4:4).le.'9') then
ntxpol=mod(npol-nint(2.0*dpol(mygrid,grid))+720,180)
if(nxant.eq.0) then
cp='H'
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
else
cp='/'
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
endif
endif
endif
write(26,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist,cp
write(21,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist
1014 format(f8.3,i5,3i3,f5.1,i4,i3,i4,i5.4,2x,a22,3i3,1x,a1)
endif
endif
j=j+nsiz(n)
enddo
write(26,1015) nutc
1015 format(39x,i4.4)
call flush(21)
call flush(26)
call display(nkeep,ftol)
ndecdone=2
999 close(23)
ndphi=0
nagain=0
mcall3b=mcall3a
return
end subroutine map65a
subroutine map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
nfcal,nkeep,mcall3b,nsave,nxant,rmsdd,mycall,mygrid, &
neme,ndepth,hiscall,hisgrid,nhsym,nfsample,nxpol,mode65)
! Processes timf2 data from Linrad to find and decode JT65 signals.
parameter (MAXMSG=1000) !Size of decoded message list
parameter (NSMAX=60*96000)
parameter (NFFT=32768)
real dd(4,NSMAX)
real*4 ss(4,322,NFFT),savg(4,NFFT)
real tavg(-50:50) !Temp for finding local base level
real base(4) !Local basel level at 4 pol'ns
real tmp (200) !Temp storage for pctile sorting
real sig(MAXMSG,30) !Parameters of detected signals
real a(5)
real*8 fcenter
character*22 msg(MAXMSG)
character*3 shmsg0(4)
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,grid*6,cp*1
integer indx(MAXMSG),nsiz(MAXMSG)
logical done(MAXMSG)
logical xpol
character decoded*22,blank*22
real short(3,NFFT) !SNR dt ipol for potential shorthands
real qphi(12)
common/c3com/ mcall3a
common/testcom/ifreq
data blank/' '/
data shmsg0/'ATT','RO ','RRR','73 '/
data nfile/0/,nutc0/-999/,nid/0/,ip000/1/,ip001/1/,mousefqso0/-999/
save
mcall3a=mcall3b
mousefqso0=mousefqso
xpol=(nxpol.ne.0)
if(.not.xpol) ndphi=0
!### Should use AppDir! ###
! open(23,file='release/CALL3.TXT',status='unknown')
open(23,file='CALL3.TXT',status='unknown')
if(nutc.ne.nutc0) nfile=nfile+1
nutc0=nutc
df=96000.0/NFFT !df = 96000/NFFT = 2.930 Hz
if(nfsample.eq.95238) df=95238.1/NFFT
ftol=0.010 !Frequency tolerance (kHz)
dphi=idphi/57.2957795
foffset=0.001*(1270 + nfcal) !Offset from sync tone, plus CAL
fqso=mousefqso + foffset - 0.5*(nfa+nfb) + nfshift !fqso at baseband (khz)
iloop=0
2 if(ndphi.eq.1) dphi=30*iloop/57.2957795
do nqd=1,0,-1
if(nqd.eq.1) then !Quick decode, at fQSO
fa=1000.0*(fqso+0.001*mousedf) - ntol
fb=1000.0*(fqso+0.001*mousedf) + ntol + 4*53.8330078
else !Wideband decode at all freqs
fa=-1000*0.5*(nfb-nfa) + 1000*nfshift
fb= 1000*0.5*(nfb-nfa) + 1000*nfshift
endif
ia=nint(fa/df) + 16385
ib=nint(fb/df) + 16385
ia=max(51,ia)
ib=min(32768-51,ib)
km=0
nkm=1
nz=n/8
freq0=-999.
sync10=-999.
fshort0=-999.
syncshort0=-999.
ntry=0
short=0. !Zero the whole short array
jpz=1
if(xpol) jpz=4
do i=ia,ib !Search over freq range
freq=0.001*(i-16385)*df
! Find the local base level for each polarization; update every 10 bins.
if(mod(i-ia,10).eq.0) then
do jp=1,jpz
do ii=-50,50
iii=i+ii
if(iii.ge.1 .and. iii.le.32768) then
tavg(ii)=savg(jp,iii)
else
write(13,*) ,'Error in iii:',iii,ia,ib,fa,fb
flush(13)
go to 999
endif
enddo
call pctile(tavg,tmp,101,50,base(jp))
enddo
endif
! Find max signal at this frequency
smax=0.
do jp=1,jpz
if(savg(jp,i)/base(jp).gt.smax) then
smax=savg(jp,i)/base(jp)
jpmax=jp
endif
enddo
if(smax.gt.1.1) then
! Look for JT65 sync patterns and shorthand square-wave patterns.
call timer('ccf65 ',0)
! ssmax=4.0*(rmsdd/22.5)**2
ssmax=savg(jpmax,i)
call ccf65(ss(1,1,i),nhsym,ssmax,sync1,ipol,jpz,dt,flipk, &
syncshort,snr2,ipol2,dt2)
call timer('ccf65 ',1)
! ########################### Search for Shorthand Messages #################
! Is there a shorthand tone above threshold?
thresh0=1.0
! Use lower thresh0 at fQSO
if(nqd.eq.1 .and. ntol.le.100) thresh0=0.
if(syncshort.gt.thresh0) then
! ### Do shorthand AFC here (or maybe after finding a pair?) ###
short(1,i)=syncshort
short(2,i)=dt2
short(3,i)=ipol2
! Check to see if lower tone of shorthand pair was found.
do j=2,4
i0=i-nint(j*mode65*10.0*(11025.0/4096.0)/df)
! Should this be i0 +/- 1, or just i0?
! Should we also insist that difference in DT be either 1.5 or -1.5 s?
if(short(1,i0).gt.thresh0) then
fshort=0.001*(i0-16385)*df
noffset=0
if(nqd.eq.1) noffset=nint(1000.0*(fshort-fqso)-mousedf)
if(abs(noffset).le.ntol) then
! Keep only the best candidate within ftol.
!### NB: sync2 was not defined here!
! sync2=syncshort !### try this ???
if(fshort-fshort0.le.ftol .and. syncshort.gt.syncshort0 &
.and. nkm.eq.2) km=km-1
if(fshort-fshort0.gt.ftol .or. &
syncshort.gt.syncshort0) then
if(km.lt.MAXMSG) km=km+1
sig(km,1)=nfile
sig(km,2)=nutc
sig(km,3)=fshort + 0.5*(nfa+nfb)
sig(km,4)=syncshort
sig(km,5)=dt2
sig(km,6)=45*(ipol2-1)/57.2957795
sig(km,7)=0
sig(km,8)=snr2
sig(km,9)=0
sig(km,10)=0
! sig(km,11)=rms0
sig(km,12)=savg(ipol2,i)
sig(km,13)=0
sig(km,14)=0
sig(km,15)=0
sig(km,16)=0
! sig(km,17)=0
sig(km,18)=0
msg(km)=shmsg0(j)
fshort0=fshort
syncshort0=syncshort
nkm=2
endif
endif
endif
enddo
endif
! ########################### Search for Normal Messages ###########
! Is sync1 above threshold?
thresh1=1.0
! Use lower thresh1 at fQSO
if(nqd.eq.1 .and. ntol.le.100) thresh1=0.
noffset=0
if(nqd.eq.1) noffset=nint(1000.0*(freq-fqso)-mousedf)
if(sync1.gt.thresh1 .and. abs(noffset).le.ntol) then
! Keep only the best candidate within ftol.
! (Am I deleting any good decodes by doing this?)
if(freq-freq0.le.ftol .and. sync1.gt.sync10 .and. &
nkm.eq.1) km=km-1
if(freq-freq0.gt.ftol .or. sync1.gt.sync10) then
nflip=nint(flipk)
f00=(i-1)*df !Freq of detected sync tone (0-96000 Hz)
ntry=ntry+1
if((nqd.eq.1 .and. ntry.ge.40) .or. &
(nqd.eq.0 .and. ntry.ge.400)) then
! Too many calls to decode1a!
write(*,*) '! Signal too strong? Decoding aborted.'
write(13,*) 'Signal too strong? Decoding aborted.'
call flush(13)
go to 999
endif
call timer('decode1a',0)
ifreq=i
ikHz=nint(freq+0.5*(nfa+nfb)-foffset)-nfshift
idf=nint(1000.0*(freq+0.5*(nfa+nfb)-foffset-(ikHz+nfshift)))
call decode1a(dd,newdat,f00,nflip,mode65,nfsample,xpol, &
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi, &
nutc,ikHz,idf,ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded)
dt=dt+0.8 !### empirical tweak
call timer('decode1a',1)
if(km.lt.MAXMSG) km=km+1
sig(km,1)=nfile
sig(km,2)=nutc
sig(km,3)=freq + 0.5*(nfa+nfb)
sig(km,4)=sync1
sig(km,5)=dt
sig(km,6)=pol
sig(km,7)=flipk
sig(km,8)=sync2
sig(km,9)=nkv
sig(km,10)=qual
! sig(km,11)=idphi
sig(km,12)=savg(ipol,i)
sig(km,13)=a(1)
sig(km,14)=a(2)
sig(km,15)=a(3)
sig(km,16)=a(4)
! sig(km,17)=a(5)
sig(km,18)=nhist
msg(km)=decoded
freq0=freq
sync10=sync1
nkm=1
endif
endif
endif
!70 continue
enddo
if(nqd.eq.1) then
nwrite=0
do k=1,km
decoded=msg(k)
if(decoded.ne.' ') then
nutc=sig(k,2)
freq=sig(k,3)
sync1=sig(k,4)
dt=sig(k,5)
npol=nint(57.2957795*sig(k,6))
flip=sig(k,7)
sync2=sig(k,8)
nkv=sig(k,9)
nqual=sig(k,10)
! idphi=nint(sig(k,11))
if(flip.lt.0.0) then
do i=22,1,-1
if(decoded(i:i).ne.' ') go to 8
enddo
stop 'Error in message format'
8 if(i.le.18) decoded(i+2:i+4)='OOO'
endif
nkHz=nint(freq-foffset)-nfshift
mhz=fcenter ! ... +fadd ???
f0=mhz+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-(nkHz+nfshift)))
nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6
nwrite=nwrite+1
if(nxant.ne.0) then
npol=npol-45
if(npol.lt.0) npol=npol+180
endif
! If Tx station's grid is in decoded message, compute optimum TxPol
i1=index(decoded,' ')
i2=index(decoded(i1+1:),' ') + i1
grid=' '
if(i2.ge.8 .and. i2.le.18) grid=decoded(i2+1:i2+4)//'mm'
ntxpol=0
cp=' '
if(xpol) then
if(grid(1:1).ge.'A' .and. grid(1:1).le.'R' .and. &
grid(2:2).ge.'A' .and. grid(2:2).le.'R' .and. &
grid(3:3).ge.'0' .and. grid(3:3).le.'9' .and. &
grid(4:4).ge.'0' .and. grid(4:4).le.'9') then
ntxpol=mod(npol-nint(2.0*dpol(mygrid,grid))+720,180)
if(nxant.eq.0) then
cp='H'
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
else
cp='/'
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
endif
endif
endif
if(ndphi.eq.0) then
write(*,1010) nkHz,ndf,npol,nutc,dt,nsync2, &
decoded,nkv,nqual,ntxpol,cp
1010 format('!',i3,i5,i4,i5.4,f5.1,i4,2x,a22,i5,i4,i5,1x,a1)
else
if(iloop.ge.1) qphi(iloop)=sig(k,10)
write(*,1010) nkHz,ndf,npol,nutc,dt,nsync2, &
decoded,nkv,nqual,30*iloop
write(27,1011) 30*iloop,nkHz,ndf,npol,nutc, &
dt,sync2,nkv,nqual,decoded
1011 format(i3,i4,i5,i4,i5.4,f5.1,f7.1,i3,i5,2x,a22)
endif
endif
enddo
if(nwrite.eq.0) then
write(*,1012) mousefqso,nutc
1012 format('!',i3,9x,i5.4,' ')
endif
endif
if(ndphi.eq.1 .and.iloop.lt.12) then
iloop=iloop+1
go to 2
endif
if(ndphi.eq.1 .and.iloop.eq.12) call getdphi(qphi)
if(nagain.eq.1) go to 999
enddo
! Trim the list and produce a sorted index and sizes of groups.
! (Should trimlist remove all but best SNR for given UTC and message content?)
call trimlist(sig,km,ftol,indx,nsiz,nz)
do i=1,km
done(i)=.false.
enddo
j=0
ilatest=-1
do n=1,nz
ifile0=0
do m=1,nsiz(n)
i=indx(j+m)
ifile=sig(i,1)
if(ifile.gt.ifile0 .and.msg(i).ne.blank) then
ilatest=i
ifile0=ifile
endif
enddo
i=ilatest
if(i.ge.1) then
if(.not.done(i)) then
done(i)=.true.
nutc=sig(i,2)
freq=sig(i,3)
sync1=sig(i,4)
dt=sig(i,5)
npol=nint(57.2957795*sig(i,6))
flip=sig(i,7)
sync2=sig(i,8)
nkv=sig(i,9)
nqual=min(sig(i,10),10.0)
! rms0=sig(i,11)
do k=1,5
a(k)=sig(i,12+k)
enddo
nhist=sig(i,18)
decoded=msg(i)
if(flip.lt.0.0) then
do i=22,1,-1
if(decoded(i:i).ne.' ') go to 10
enddo
stop 'Error in message format'
10 if(i.le.18) decoded(i+2:i+4)='OOO'
endif
mhz=fcenter !... +fadd ???
nkHz=nint(freq-foffset)-nfshift
f0=mhz+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-(nkHz+nfshift)))
ndf0=nint(a(1))
ndf1=nint(a(2))
ndf2=nint(a(3))
nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6
if(nxant.ne.0) then
npol=npol-45
if(npol.lt.0) npol=npol+180
endif
! If Tx station's grid is in decoded message, compute optimum TxPol
i1=index(decoded,' ')
i2=index(decoded(i1+1:),' ') + i1
grid=' '
if(i2.ge.8 .and. i2.le.18) grid=decoded(i2+1:i2+4)//'mm'
ntxpol=0
cp=' '
if(xpol) then
if(grid(1:1).ge.'A' .and. grid(1:1).le.'R' .and. &
grid(2:2).ge.'A' .and. grid(2:2).le.'R' .and. &
grid(3:3).ge.'0' .and. grid(3:3).le.'9' .and. &
grid(4:4).ge.'0' .and. grid(4:4).le.'9') then
ntxpol=mod(npol-nint(2.0*dpol(mygrid,grid))+720,180)
if(nxant.eq.0) then
cp='H'
if(ntxpol.gt.45 .and. ntxpol.le.135) cp='V'
else
cp='/'
if(ntxpol.ge.90 .and. ntxpol.lt.180) cp='\\'
endif
endif
endif
write(26,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist,cp
write(21,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist
1014 format(f8.3,i5,3i3,f5.1,i4,i3,i4,i5.4,2x,a22,3i3,1x,a1)
endif
endif
j=j+nsiz(n)
enddo
write(26,1015) nutc
1015 format(39x,i4.4)
call flush(21)
call flush(26)
call display(nkeep,ftol)
ndecdone=2
999 close(23)
ndphi=0
nagain=0
mcall3b=mcall3a
return
end subroutine map65a
libm65/moon2.f
+167 -167
View File
@@ -1,167 +1,167 @@
subroutine moon2(y,m,Day,UT,lon,lat,RA,Dec,topRA,topDec,
+ LST,HA,Az,El,dist)
implicit none
integer y !Year
integer m !Month
integer Day !Day
real*8 UT !UTC in hours
real*8 RA,Dec !RA and Dec of moon
C NB: Double caps are single caps in the writeup.
real*8 NN !Longitude of ascending node
real*8 i !Inclination to the ecliptic
real*8 w !Argument of perigee
real*8 a !Semi-major axis
real*8 e !Eccentricity
real*8 MM !Mean anomaly
real*8 v !True anomaly
real*8 EE !Eccentric anomaly
real*8 ecl !Obliquity of the ecliptic
real*8 d !Ephemeris time argument in days
real*8 r !Distance to sun, AU
real*8 xv,yv !x and y coords in ecliptic
real*8 lonecl,latecl !Ecliptic long and lat of moon
real*8 xg,yg,zg !Ecliptic rectangular coords
real*8 Ms !Mean anomaly of sun
real*8 ws !Argument of perihelion of sun
real*8 Ls !Mean longitude of sun (Ns=0)
real*8 Lm !Mean longitude of moon
real*8 DD !Mean elongation of moon
real*8 FF !Argument of latitude for moon
real*8 xe,ye,ze !Equatorial geocentric coords of moon
real*8 mpar !Parallax of moon (r_E / d)
real*8 lat,lon !Station coordinates on earth
real*8 gclat !Geocentric latitude
real*8 rho !Earth radius factor
real*8 GMST0,LST,HA
real*8 g
real*8 topRA,topDec !Topocentric coordinates of Moon
real*8 Az,El
real*8 dist
real*8 rad,twopi,pi,pio2
data rad/57.2957795131d0/,twopi/6.283185307d0/
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + Day - 730530 + UT/24.d0
ecl = 23.4393d0 - 3.563d-7 * d
C Orbital elements for Moon:
NN = 125.1228d0 - 0.0529538083d0 * d
i = 5.1454d0
w = mod(318.0634d0 + 0.1643573223d0 * d + 360000.d0,360.d0)
a = 60.2666d0
e = 0.054900d0
MM = mod(115.3654d0 + 13.0649929509d0 * d + 360000.d0,360.d0)
EE = MM + e*rad*sin(MM/rad) * (1.d0 + e*cos(MM/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.d0 - e*cos(EE/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.d0 - e*cos(EE/rad))
xv = a * (cos(EE/rad) - e)
yv = a * (sqrt(1.d0-e*e) * sin(EE/rad))
v = mod(rad*atan2(yv,xv)+720.d0,360.d0)
r = sqrt(xv*xv + yv*yv)
C Get geocentric position in ecliptic rectangular coordinates:
xg = r * (cos(NN/rad)*cos((v+w)/rad) -
+ sin(NN/rad)*sin((v+w)/rad)*cos(i/rad))
yg = r * (sin(NN/rad)*cos((v+w)/rad) +
+ cos(NN/rad)*sin((v+w)/rad)*cos(i/rad))
zg = r * (sin((v+w)/rad)*sin(i/rad))
C Ecliptic longitude and latitude of moon:
lonecl = mod(rad*atan2(yg/rad,xg/rad)+720.d0,360.d0)
latecl = rad*atan2(zg/rad,sqrt(xg*xg + yg*yg)/rad)
C Now include orbital perturbations:
Ms = mod(356.0470d0 + 0.9856002585d0 * d + 3600000.d0,360.d0)
ws = 282.9404d0 + 4.70935d-5*d
Ls = mod(Ms + ws + 720.d0,360.d0)
Lm = mod(MM + w + NN+720.d0,360.d0)
DD = mod(Lm - Ls + 360.d0,360.d0)
FF = mod(Lm - NN + 360.d0,360.d0)
lonecl = lonecl
+ -1.274d0 * sin((MM-2.d0*DD)/rad)
+ +0.658d0 * sin(2.d0*DD/rad)
+ -0.186d0 * sin(Ms/rad)
+ -0.059d0 * sin((2.d0*MM-2.d0*DD)/rad)
+ -0.057d0 * sin((MM-2.d0*DD+Ms)/rad)
+ +0.053d0 * sin((MM+2.d0*DD)/rad)
+ +0.046d0 * sin((2.d0*DD-Ms)/rad)
+ +0.041d0 * sin((MM-Ms)/rad)
+ -0.035d0 * sin(DD/rad)
+ -0.031d0 * sin((MM+Ms)/rad)
+ -0.015d0 * sin((2.d0*FF-2.d0*DD)/rad)
+ +0.011d0 * sin((MM-4.d0*DD)/rad)
latecl = latecl
+ -0.173d0 * sin((FF-2.d0*DD)/rad)
+ -0.055d0 * sin((MM-FF-2.d0*DD)/rad)
+ -0.046d0 * sin((MM+FF-2.d0*DD)/rad)
+ +0.033d0 * sin((FF+2.d0*DD)/rad)
+ +0.017d0 * sin((2.d0*MM+FF)/rad)
r = 60.36298d0
+ - 3.27746d0*cos(MM/rad)
+ - 0.57994d0*cos((MM-2.d0*DD)/rad)
+ - 0.46357d0*cos(2.d0*DD/rad)
+ - 0.08904d0*cos(2.d0*MM/rad)
+ + 0.03865d0*cos((2.d0*MM-2.d0*DD)/rad)
+ - 0.03237d0*cos((2.d0*DD-Ms)/rad)
+ - 0.02688d0*cos((MM+2.d0*DD)/rad)
+ - 0.02358d0*cos((MM-2.d0*DD+Ms)/rad)
+ - 0.02030d0*cos((MM-Ms)/rad)
+ + 0.01719d0*cos(DD/rad)
+ + 0.01671d0*cos((MM+Ms)/rad)
dist=r*6378.140d0
C Geocentric coordinates:
C Rectangular ecliptic coordinates of the moon:
xg = r * cos(lonecl/rad)*cos(latecl/rad)
yg = r * sin(lonecl/rad)*cos(latecl/rad)
zg = r * sin(latecl/rad)
C Rectangular equatorial coordinates of the moon:
xe = xg
ye = yg*cos(ecl/rad) - zg*sin(ecl/rad)
ze = yg*sin(ecl/rad) + zg*cos(ecl/rad)
C Right Ascension, Declination:
RA = mod(rad*atan2(ye,xe)+360.d0,360.d0)
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
C Now convert to topocentric system:
mpar=rad*asin(1.d0/r)
C alt_topoc = alt_geoc - mpar*cos(alt_geoc)
gclat = lat - 0.1924d0*sin(2.d0*lat/rad)
rho = 0.99883d0 + 0.00167d0*cos(2.d0*lat/rad)
GMST0 = (Ls + 180.d0)/15.d0
LST = mod(GMST0+UT+lon/15.d0+48.d0,24.d0) !LST in hours
HA = 15.d0*LST - RA !HA in degrees
g = rad*atan(tan(gclat/rad)/cos(HA/rad))
topRA = RA - mpar*rho*cos(gclat/rad)*sin(HA/rad)/cos(Dec/rad)
topDec = Dec - mpar*rho*sin(gclat/rad)*sin((g-Dec)/rad)/sin(g/rad)
HA = 15.d0*LST - topRA !HA in degrees
if(HA.gt.180.d0) HA=HA-360.d0
if(HA.lt.-180.d0) HA=HA+360.d0
pi=0.5d0*twopi
pio2=0.5d0*pi
call dcoord(pi,pio2-lat/rad,0.d0,lat/rad,ha*twopi/360,
+ topDec/rad,az,el)
Az=az*rad
El=El*rad
return
end
subroutine moon2(y,m,Day,UT,lon,lat,RA,Dec,topRA,topDec,
+ LST,HA,Az,El,dist)
implicit none
integer y !Year
integer m !Month
integer Day !Day
real*8 UT !UTC in hours
real*8 RA,Dec !RA and Dec of moon
C NB: Double caps are single caps in the writeup.
real*8 NN !Longitude of ascending node
real*8 i !Inclination to the ecliptic
real*8 w !Argument of perigee
real*8 a !Semi-major axis
real*8 e !Eccentricity
real*8 MM !Mean anomaly
real*8 v !True anomaly
real*8 EE !Eccentric anomaly
real*8 ecl !Obliquity of the ecliptic
real*8 d !Ephemeris time argument in days
real*8 r !Distance to sun, AU
real*8 xv,yv !x and y coords in ecliptic
real*8 lonecl,latecl !Ecliptic long and lat of moon
real*8 xg,yg,zg !Ecliptic rectangular coords
real*8 Ms !Mean anomaly of sun
real*8 ws !Argument of perihelion of sun
real*8 Ls !Mean longitude of sun (Ns=0)
real*8 Lm !Mean longitude of moon
real*8 DD !Mean elongation of moon
real*8 FF !Argument of latitude for moon
real*8 xe,ye,ze !Equatorial geocentric coords of moon
real*8 mpar !Parallax of moon (r_E / d)
real*8 lat,lon !Station coordinates on earth
real*8 gclat !Geocentric latitude
real*8 rho !Earth radius factor
real*8 GMST0,LST,HA
real*8 g
real*8 topRA,topDec !Topocentric coordinates of Moon
real*8 Az,El
real*8 dist
real*8 rad,twopi,pi,pio2
data rad/57.2957795131d0/,twopi/6.283185307d0/
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + Day - 730530 + UT/24.d0
ecl = 23.4393d0 - 3.563d-7 * d
C Orbital elements for Moon:
NN = 125.1228d0 - 0.0529538083d0 * d
i = 5.1454d0
w = mod(318.0634d0 + 0.1643573223d0 * d + 360000.d0,360.d0)
a = 60.2666d0
e = 0.054900d0
MM = mod(115.3654d0 + 13.0649929509d0 * d + 360000.d0,360.d0)
EE = MM + e*rad*sin(MM/rad) * (1.d0 + e*cos(MM/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.d0 - e*cos(EE/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.d0 - e*cos(EE/rad))
xv = a * (cos(EE/rad) - e)
yv = a * (sqrt(1.d0-e*e) * sin(EE/rad))
v = mod(rad*atan2(yv,xv)+720.d0,360.d0)
r = sqrt(xv*xv + yv*yv)
C Get geocentric position in ecliptic rectangular coordinates:
xg = r * (cos(NN/rad)*cos((v+w)/rad) -
+ sin(NN/rad)*sin((v+w)/rad)*cos(i/rad))
yg = r * (sin(NN/rad)*cos((v+w)/rad) +
+ cos(NN/rad)*sin((v+w)/rad)*cos(i/rad))
zg = r * (sin((v+w)/rad)*sin(i/rad))
C Ecliptic longitude and latitude of moon:
lonecl = mod(rad*atan2(yg/rad,xg/rad)+720.d0,360.d0)
latecl = rad*atan2(zg/rad,sqrt(xg*xg + yg*yg)/rad)
C Now include orbital perturbations:
Ms = mod(356.0470d0 + 0.9856002585d0 * d + 3600000.d0,360.d0)
ws = 282.9404d0 + 4.70935d-5*d
Ls = mod(Ms + ws + 720.d0,360.d0)
Lm = mod(MM + w + NN+720.d0,360.d0)
DD = mod(Lm - Ls + 360.d0,360.d0)
FF = mod(Lm - NN + 360.d0,360.d0)
lonecl = lonecl
+ -1.274d0 * sin((MM-2.d0*DD)/rad)
+ +0.658d0 * sin(2.d0*DD/rad)
+ -0.186d0 * sin(Ms/rad)
+ -0.059d0 * sin((2.d0*MM-2.d0*DD)/rad)
+ -0.057d0 * sin((MM-2.d0*DD+Ms)/rad)
+ +0.053d0 * sin((MM+2.d0*DD)/rad)
+ +0.046d0 * sin((2.d0*DD-Ms)/rad)
+ +0.041d0 * sin((MM-Ms)/rad)
+ -0.035d0 * sin(DD/rad)
+ -0.031d0 * sin((MM+Ms)/rad)
+ -0.015d0 * sin((2.d0*FF-2.d0*DD)/rad)
+ +0.011d0 * sin((MM-4.d0*DD)/rad)
latecl = latecl
+ -0.173d0 * sin((FF-2.d0*DD)/rad)
+ -0.055d0 * sin((MM-FF-2.d0*DD)/rad)
+ -0.046d0 * sin((MM+FF-2.d0*DD)/rad)
+ +0.033d0 * sin((FF+2.d0*DD)/rad)
+ +0.017d0 * sin((2.d0*MM+FF)/rad)
r = 60.36298d0
+ - 3.27746d0*cos(MM/rad)
+ - 0.57994d0*cos((MM-2.d0*DD)/rad)
+ - 0.46357d0*cos(2.d0*DD/rad)
+ - 0.08904d0*cos(2.d0*MM/rad)
+ + 0.03865d0*cos((2.d0*MM-2.d0*DD)/rad)
+ - 0.03237d0*cos((2.d0*DD-Ms)/rad)
+ - 0.02688d0*cos((MM+2.d0*DD)/rad)
+ - 0.02358d0*cos((MM-2.d0*DD+Ms)/rad)
+ - 0.02030d0*cos((MM-Ms)/rad)
+ + 0.01719d0*cos(DD/rad)
+ + 0.01671d0*cos((MM+Ms)/rad)
dist=r*6378.140d0
C Geocentric coordinates:
C Rectangular ecliptic coordinates of the moon:
xg = r * cos(lonecl/rad)*cos(latecl/rad)
yg = r * sin(lonecl/rad)*cos(latecl/rad)
zg = r * sin(latecl/rad)
C Rectangular equatorial coordinates of the moon:
xe = xg
ye = yg*cos(ecl/rad) - zg*sin(ecl/rad)
ze = yg*sin(ecl/rad) + zg*cos(ecl/rad)
C Right Ascension, Declination:
RA = mod(rad*atan2(ye,xe)+360.d0,360.d0)
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
C Now convert to topocentric system:
mpar=rad*asin(1.d0/r)
C alt_topoc = alt_geoc - mpar*cos(alt_geoc)
gclat = lat - 0.1924d0*sin(2.d0*lat/rad)
rho = 0.99883d0 + 0.00167d0*cos(2.d0*lat/rad)
GMST0 = (Ls + 180.d0)/15.d0
LST = mod(GMST0+UT+lon/15.d0+48.d0,24.d0) !LST in hours
HA = 15.d0*LST - RA !HA in degrees
g = rad*atan(tan(gclat/rad)/cos(HA/rad))
topRA = RA - mpar*rho*cos(gclat/rad)*sin(HA/rad)/cos(Dec/rad)
topDec = Dec - mpar*rho*sin(gclat/rad)*sin((g-Dec)/rad)/sin(g/rad)
HA = 15.d0*LST - topRA !HA in degrees
if(HA.gt.180.d0) HA=HA-360.d0
if(HA.lt.-180.d0) HA=HA+360.d0
pi=0.5d0*twopi
pio2=0.5d0*pi
call dcoord(pi,pio2-lat/rad,0.d0,lat/rad,ha*twopi/360,
+ topDec/rad,az,el)
Az=az*rad
El=El*rad
return
end
libm65/moondop.f
+73 -73
View File
@@ -1,73 +1,73 @@
subroutine MoonDop(nyear,month,nday,uth4,lon4,lat4,RAMoon4,
+ DecMoon4,LST4,HA4,AzMoon4,ElMoon4,vr4,dist4)
implicit real*8 (a-h,o-z)
real*4 uth4 !UT in hours
real*4 lon4 !West longitude, degrees
real*4 lat4 !Latitude, degrees
real*4 RAMoon4 !Topocentric RA of moon, hours
real*4 DecMoon4 !Topocentric Dec of Moon, degrees
real*4 LST4 !Locat sidereal time, hours
real*4 HA4 !Local Hour angle, degrees
real*4 AzMoon4 !Topocentric Azimuth of moon, degrees
real*4 ElMoon4 !Topocentric Elevation of moon, degrees
real*4 vr4 !Radial velocity of moon wrt obs, km/s
real*4 dist4 !Echo time, seconds
real*8 LST
real*8 RME(6) !Vector from Earth center to Moon
real*8 RAE(6) !Vector from Earth center to Obs
real*8 RMA(6) !Vector from Obs to Moon
real*8 pvsun(6)
real*8 rme0(6)
logical km,bary
data rad/57.2957795130823d0/,twopi/6.28310530717959d0/
km=.true.
dlat=lat4/rad
dlong1=lon4/rad
elev1=200.d0
call geocentric(dlat,elev1,dlat1,erad1)
dt=100.d0 !For numerical derivative, in seconds
UT=uth4
C NB: geodetic latitude used here, but geocentric latitude used when
C determining Earth-rotation contribution to Doppler.
call moon2(nyear,month,nDay,UT-dt/3600.d0,dlong1*rad,dlat*rad,
+ RA,Dec,topRA,topDec,LST,HA,Az0,El0,dist)
call toxyz(RA/rad,Dec/rad,dist,rme0) !Convert to rectangular coords
call moon2(nyear,month,nDay,UT,dlong1*rad,dlat*rad,
+ RA,Dec,topRA,topDec,LST,HA,Az,El,dist)
call toxyz(RA/rad,Dec/rad,dist,rme) !Convert to rectangular coords
phi=LST*twopi/24.d0
call toxyz(phi,dlat1,erad1,rae) !Gencentric numbers used here!
radps=twopi/(86400.d0/1.002737909d0)
rae(4)=-rae(2)*radps !Vel of Obs wrt Earth center
rae(5)=rae(1)*radps
rae(6)=0.d0
do i=1,3
rme(i+3)=(rme(i)-rme0(i))/dt
rma(i)=rme(i)-rae(i)
rma(i+3)=rme(i+3)-rae(i+3)
enddo
call fromxyz(rma,alpha1,delta1,dtopo0) !Get topocentric coords
vr=dot(rma(4),rma)/dtopo0
RAMoon4=topRA
DecMoon4=topDec
LST4=LST
HA4=HA
AzMoon4=Az
ElMoon4=El
vr4=vr
dist4=dist
return
end
subroutine MoonDop(nyear,month,nday,uth4,lon4,lat4,RAMoon4,
+ DecMoon4,LST4,HA4,AzMoon4,ElMoon4,vr4,dist4)
implicit real*8 (a-h,o-z)
real*4 uth4 !UT in hours
real*4 lon4 !West longitude, degrees
real*4 lat4 !Latitude, degrees
real*4 RAMoon4 !Topocentric RA of moon, hours
real*4 DecMoon4 !Topocentric Dec of Moon, degrees
real*4 LST4 !Locat sidereal time, hours
real*4 HA4 !Local Hour angle, degrees
real*4 AzMoon4 !Topocentric Azimuth of moon, degrees
real*4 ElMoon4 !Topocentric Elevation of moon, degrees
real*4 vr4 !Radial velocity of moon wrt obs, km/s
real*4 dist4 !Echo time, seconds
real*8 LST
real*8 RME(6) !Vector from Earth center to Moon
real*8 RAE(6) !Vector from Earth center to Obs
real*8 RMA(6) !Vector from Obs to Moon
real*8 pvsun(6)
real*8 rme0(6)
logical km,bary
data rad/57.2957795130823d0/,twopi/6.28310530717959d0/
km=.true.
dlat=lat4/rad
dlong1=lon4/rad
elev1=200.d0
call geocentric(dlat,elev1,dlat1,erad1)
dt=100.d0 !For numerical derivative, in seconds
UT=uth4
C NB: geodetic latitude used here, but geocentric latitude used when
C determining Earth-rotation contribution to Doppler.
call moon2(nyear,month,nDay,UT-dt/3600.d0,dlong1*rad,dlat*rad,
+ RA,Dec,topRA,topDec,LST,HA,Az0,El0,dist)
call toxyz(RA/rad,Dec/rad,dist,rme0) !Convert to rectangular coords
call moon2(nyear,month,nDay,UT,dlong1*rad,dlat*rad,
+ RA,Dec,topRA,topDec,LST,HA,Az,El,dist)
call toxyz(RA/rad,Dec/rad,dist,rme) !Convert to rectangular coords
phi=LST*twopi/24.d0
call toxyz(phi,dlat1,erad1,rae) !Gencentric numbers used here!
radps=twopi/(86400.d0/1.002737909d0)
rae(4)=-rae(2)*radps !Vel of Obs wrt Earth center
rae(5)=rae(1)*radps
rae(6)=0.d0
do i=1,3
rme(i+3)=(rme(i)-rme0(i))/dt
rma(i)=rme(i)-rae(i)
rma(i+3)=rme(i+3)-rae(i+3)
enddo
call fromxyz(rma,alpha1,delta1,dtopo0) !Get topocentric coords
vr=dot(rma(4),rma)/dtopo0
RAMoon4=topRA
DecMoon4=topDec
LST4=LST
HA4=HA
AzMoon4=Az
ElMoon4=El
vr4=vr
dist4=dist
return
end
libm65/nchar.f
+23 -23
View File
@@ -1,23 +1,23 @@
function nchar(c)
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(c)
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
libm65/packcall.f
+79 -79
View File
@@ -1,79 +1,79 @@
subroutine packcall(callsign,ncall,text)
C 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.
C 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(callsign,ncall,text)
C 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.
C 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
libm65/packdxcc.f
+64 -64
View File
@@ -1,64 +1,64 @@
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(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
libm65/packgrid.f
+47 -47
View File
@@ -1,47 +1,47 @@
subroutine packgrid(grid,ng,text)
parameter (NGBASE=180*180)
character*4 grid
logical text
text=.false.
if(grid.eq.' ') go to 90 !Blank grid is OK
C Test for numerical signal report, etc.
if(grid(1:1).eq.'-') then
read(grid(2:3),*,err=1,end=1) n
1 ng=NGBASE+1+n
go to 100
else if(grid(1:2).eq.'R-') then
read(grid(3:4),*,err=2,end=2) n
2 if(n.eq.0) go to 90
ng=NGBASE+31+n
go to 100
else if(grid(1:2).eq.'RO') then
ng=NGBASE+62
go to 100
else if(grid(1:3).eq.'RRR') then
ng=NGBASE+63
go to 100
else if(grid(1:2).eq.'73') then
ng=NGBASE+64
go to 100
endif
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
if(text) go to 100
call grid2deg(grid//'mm',dlong,dlat)
long=dlong
lat=dlat+ 90.0
ng=((long+180)/2)*180 + lat
go to 100
90 ng=NGBASE + 1
100 return
end
subroutine packgrid(grid,ng,text)
parameter (NGBASE=180*180)
character*4 grid
logical text
text=.false.
if(grid.eq.' ') go to 90 !Blank grid is OK
C Test for numerical signal report, etc.
if(grid(1:1).eq.'-') then
read(grid(2:3),*,err=1,end=1) n
1 ng=NGBASE+1+n
go to 100
else if(grid(1:2).eq.'R-') then
read(grid(3:4),*,err=2,end=2) n
2 if(n.eq.0) go to 90
ng=NGBASE+31+n
go to 100
else if(grid(1:2).eq.'RO') then
ng=NGBASE+62
go to 100
else if(grid(1:3).eq.'RRR') then
ng=NGBASE+63
go to 100
else if(grid(1:2).eq.'73') then
ng=NGBASE+64
go to 100
endif
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
if(text) go to 100
call grid2deg(grid//'mm',dlong,dlat)
long=dlong
lat=dlat+ 90.0
ng=((long+180)/2)*180 + lat
go to 100
90 ng=NGBASE + 1
100 return
end
libm65/packmsg.f
+103 -103
View File
@@ -1,103 +1,103 @@
subroutine packmsg(msg,dat)
parameter (NBASE=37*36*10*27*27*27)
parameter (NBASE2=262178562)
character*22 msg
integer dat(12)
character*12 c1,c2,c2z
character*4 c3
character*6 grid6
c character*3 dxcc !Where is DXCC implemented?
logical text1,text2,text3
C Convert all letters to upper case
do i=1,22
if(msg(i:i).ge.'a' .and. msg(i:i).le.'z')
+ msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a'))
enddo
C See if it's a CQ message
if(msg(1:3).eq.'CQ ') then
i=3
C ... 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,junk)
call packcall(c1,nc1,text1)
c2z=c2
call getpfx1(c2,k2,nv2)
call packcall(c2,nc2,text2)
if(nv2.eq.0) 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(nv2.eq.0 .and. (.not.text1) .and. (.not.text2) .and.
+ (.not.text3)) go to 20
if(nv2.gt.0) then
if(nv2.eq.1) 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
endif
if(nv2.eq.2) 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
go to 20
endif
C The message will be treated as plain text.
10 call packtext(msg,nc1,nc2,ng)
ng=ng+32768
C Encode data into 6-bit words
20 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(msg,dat)
parameter (NBASE=37*36*10*27*27*27)
parameter (NBASE2=262178562)
character*22 msg
integer dat(12)
character*12 c1,c2,c2z
character*4 c3
character*6 grid6
c character*3 dxcc !Where is DXCC implemented?
logical text1,text2,text3
C Convert all letters to upper case
do i=1,22
if(msg(i:i).ge.'a' .and. msg(i:i).le.'z')
+ msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a'))
enddo
C See if it's a CQ message
if(msg(1:3).eq.'CQ ') then
i=3
C ... 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,junk)
call packcall(c1,nc1,text1)
c2z=c2
call getpfx1(c2,k2,nv2)
call packcall(c2,nc2,text2)
if(nv2.eq.0) 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(nv2.eq.0 .and. (.not.text1) .and. (.not.text2) .and.
+ (.not.text3)) go to 20
if(nv2.gt.0) then
if(nv2.eq.1) 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
endif
if(nv2.eq.2) 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
go to 20
endif
C The message will be treated as plain text.
10 call packtext(msg,nc1,nc2,ng)
ng=ng+32768
C Encode data into 6-bit words
20 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
libm65/packtext.f
+47 -47
View File
@@ -1,47 +1,47 @@
subroutine packtext(msg,nc1,nc2,nc3)
parameter (MASK28=2**28 - 1)
character*13 msg
character*44 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
nc1=0
nc2=0
nc3=0
do i=1,5 !First 5 characters in nc1
do j=1,44 !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,44 !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,44 !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
C 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(msg,nc1,nc2,nc3)
parameter (MASK28=2**28 - 1)
character*13 msg
character*44 c
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
nc1=0
nc2=0
nc3=0
do i=1,5 !First 5 characters in nc1
do j=1,44 !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,44 !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,44 !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
C 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
libm65/pctile.f
+13 -13
View File
@@ -1,13 +1,13 @@
subroutine pctile(x,tmp,nmax,npct,xpct)
real x(nmax),tmp(nmax)
do i=1,nmax
tmp(i)=x(i)
enddo
call sort(nmax,tmp)
j=nint(nmax*0.01*npct)
if(j.lt.1) j=1
xpct=tmp(j)
return
end
subroutine pctile(x,tmp,nmax,npct,xpct)
real x(nmax),tmp(nmax)
do i=1,nmax
tmp(i)=x(i)
enddo
call sort(nmax,tmp)
j=nint(nmax*0.01*npct)
if(j.lt.1) j=1
xpct=tmp(j)
return
end
libm65/pfx.f
+50 -50
View File
@@ -1,50 +1,50 @@
parameter (NZ=339) !Total number of prefixes
parameter (NZ2=12) !Total number of suffixes
character*1 sfx(NZ2)
character*5 pfx(NZ)
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
data pfx/
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
+ '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ',
+ '3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ',
+ '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ',
+ '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ',
+ '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ',
+ '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ',
+ '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ',
+ 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ',
+ 'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ',
+ 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ',
+ 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ',
+ 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ',
+ 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ',
+ 'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ',
+ 'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ',
+ 'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ',
+ 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ',
+ 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0A ',
+ 'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ',
+ 'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ',
+ 'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ',
+ 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ',
+ 'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ',
+ 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ',
+ 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ',
+ 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ',
+ 'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ',
+ 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ',
+ 'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ',
+ 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ',
+ 'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ',
+ 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ',
+ 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ',
+ 'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ',
+ 'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ',
+ 'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ',
+ 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ',
+ 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ',
+ 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ',
+ 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ',
+ 'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ',
+ 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/
parameter (NZ=339) !Total number of prefixes
parameter (NZ2=12) !Total number of suffixes
character*1 sfx(NZ2)
character*5 pfx(NZ)
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
data pfx/
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
+ '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ',
+ '3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ',
+ '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ',
+ '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ',
+ '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ',
+ '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ',
+ '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ',
+ 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ',
+ 'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ',
+ 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ',
+ 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ',
+ 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ',
+ 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ',
+ 'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ',
+ 'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ',
+ 'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ',
+ 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ',
+ 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0A ',
+ 'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ',
+ 'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ',
+ 'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ',
+ 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ',
+ 'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ',
+ 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ',
+ 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ',
+ 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ',
+ 'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ',
+ 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ',
+ 'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ',
+ 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ',
+ 'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ',
+ 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ',
+ 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ',
+ 'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ',
+ 'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ',
+ 'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ',
+ 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ',
+ 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ',
+ 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ',
+ 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ',
+ 'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ',
+ 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/
libm65/pfxdump.f
+13 -13
View File
@@ -1,13 +1,13 @@
subroutine pfxdump(fname)
character*(*) fname
include 'pfx.f'
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(fname)
character*(*) fname
include 'pfx.f'
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
libm65/ptt_unix.c
+391 -391
View File
@@ -1,391 +1,391 @@
/*
* WSJT is Copyright (c) 2001-2006 by Joseph H. Taylor, Jr., K1JT,
* and is licensed under the GNU General Public License (GPL).
*
* Code used from cwdaemon for parallel port ptt only.
*
* cwdaemon - morse sounding daemon for the parallel or serial port
* Copyright (C) 2002 -2005 Joop Stakenborg <pg4i@amsat.org>
* and many authors, see the AUTHORS file.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Library General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
# if HAVE_STDIO_H
# include <stdio.h>
#endif
#if STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
# if HAVE_STDLIB_H
# include <stdlib.h>
# endif
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_SYS_IOCTL_H
# include <sys/ioctl.h>
#endif
#if HAVE_FCNTL_H
# include <fcntl.h>
#endif
#ifdef HAVE_LINUX_PPDEV_H
# include <linux/ppdev.h>
# include <linux/parport.h>
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
# include <dev/ppbus/ppi.h>
# include <dev/ppbus/ppbconf.h>
#endif
int lp_reset (int fd);
int lp_ptt (int fd, int onoff);
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
#if (defined(__unix__) || defined(unix)) && !defined(USG)
# include <sys/param.h>
#endif
#include <string.h>
/* parport functions */
int dev_is_parport(int fd);
int ptt_parallel(int fd, int *ntx, int *iptt);
int ptt_serial(int fd, int *ntx, int *iptt);
int fd=-1; /* Used for both serial and parallel */
/*
* ptt_
*
* generic unix PTT routine called from Fortran
*
* Inputs
* unused Unused, to satisfy old windows calling convention
* ptt_port device name serial or parallel
* ntx pointer to fortran command on or off
* iptt pointer to fortran command status on or off
* Returns - non 0 if error
*/
/* Tiny state machine */
#define STATE_PORT_CLOSED 0
#define STATE_PORT_OPEN_PARALLEL 1
#define STATE_PORT_OPEN_SERIAL 2
//int ptt_(int *unused, char *ptt_port, int *ntx, int *iptt)
int ptt_(int *unused, int *ntx, int *iptt)
{
static int state=0;
char *p;
// ### Temporary:
char* ptt_port;
if(*unused != -99) {
*iptt=*ntx;
return 0;
}
// ###
/* In the very unlikely event of a NULL pointer, just return.
* Yes, I realise this should not be possible in WSJT.
*/
if (ptt_port == NULL) {
*iptt = *ntx;
return (0);
}
switch (state) {
case STATE_PORT_CLOSED:
/* Remove trailing ' ' */
if ((p = strchr(ptt_port, ' ')) != NULL)
*p = '\0';
/* If all that is left is a '\0' then also just return */
if (*ptt_port == '\0') {
*iptt = *ntx;
return(0);
}
if ((fd = open(ptt_port, O_RDWR|O_NONBLOCK)) < 0) {
fprintf(stderr, "Can't open %s.\n", ptt_port);
return (1);
}
if (dev_is_parport(fd)) {
state = STATE_PORT_OPEN_PARALLEL;
lp_reset(fd);
ptt_parallel(fd, ntx, iptt);
} else {
state = STATE_PORT_OPEN_SERIAL;
ptt_serial(fd, ntx, iptt);
}
break;
case STATE_PORT_OPEN_PARALLEL:
ptt_parallel(fd, ntx, iptt);
break;
case STATE_PORT_OPEN_SERIAL:
ptt_serial(fd, ntx, iptt);
break;
default:
close(fd);
fd = -1;
state = STATE_PORT_CLOSED;
break;
}
return(0);
}
/*
* ptt_serial
*
* generic serial unix PTT routine called indirectly from Fortran
*
* fd - already opened file descriptor
* ntx - pointer to fortran command on or off
* iptt - pointer to fortran command status on or off
*/
int
ptt_serial(int fd, int *ntx, int *iptt)
{
int control = TIOCM_RTS | TIOCM_DTR;
if(*ntx) {
ioctl(fd, TIOCMBIS, &control); /* Set DTR and RTS */
*iptt = 1;
} else {
ioctl(fd, TIOCMBIC, &control);
*iptt = 0;
}
return(0);
}
/* parport functions */
/*
* dev_is_parport(fd):
*
* inputs - Already open fd
* output - 1 if parallel port, 0 if not
* side effects - Unfortunately, this is platform specific.
*/
#if defined(HAVE_LINUX_PPDEV_H) /* Linux (ppdev) */
int
dev_is_parport(int fd)
{
struct stat st;
int m;
if ((fstat(fd, &st) == -1) ||
((st.st_mode & S_IFMT) != S_IFCHR) ||
(ioctl(fd, PPGETMODE, &m) == -1))
return(0);
return(1);
}
#elif defined(HAVE_DEV_PPBUS_PPI_H) /* FreeBSD (ppbus/ppi) */
int
dev_is_parport(int fd)
{
struct stat st;
unsigned char c;
if ((fstat(fd, &st) == -1) ||
((st.st_mode & S_IFMT) != S_IFCHR) ||
(ioctl(fd, PPISSTATUS, &c) == -1))
return(0);
return(1);
}
#else /* Fallback (nothing) */
int
dev_is_parport(int fd)
{
return(0);
}
#endif
/* Linux wrapper around PPFCONTROL */
#ifdef HAVE_LINUX_PPDEV_H
static void
parport_control (int fd, unsigned char controlbits, int values)
{
struct ppdev_frob_struct frob;
frob.mask = controlbits;
frob.val = values;
if (ioctl (fd, PPFCONTROL, &frob) == -1)
{
fprintf(stderr, "Parallel port PPFCONTROL");
exit (1);
}
}
#endif
/* FreeBSD wrapper around PPISCTRL */
#ifdef HAVE_DEV_PPBUS_PPI_H
static void
parport_control (int fd, unsigned char controlbits, int values)
{
unsigned char val;
if (ioctl (fd, PPIGCTRL, &val) == -1)
{
fprintf(stderr, "Parallel port PPIGCTRL");
exit (1);
}
val &= ~controlbits;
val |= values;
if (ioctl (fd, PPISCTRL, &val) == -1)
{
fprintf(stderr, "Parallel port PPISCTRL");
exit (1);
}
}
#endif
/* Initialise a parallel port, given open fd */
int
lp_init (int fd)
{
#ifdef HAVE_LINUX_PPDEV_H
int mode;
#endif
#ifdef HAVE_LINUX_PPDEV_H
mode = PARPORT_MODE_PCSPP;
if (ioctl (fd, PPSETMODE, &mode) == -1)
{
fprintf(stderr, "Setting parallel port mode");
close (fd);
return(-1);
}
if (ioctl (fd, PPEXCL, NULL) == -1)
{
fprintf(stderr, "Parallel port is already in use.\n");
close (fd);
return(-1);
}
if (ioctl (fd, PPCLAIM, NULL) == -1)
{
fprintf(stderr, "Claiming parallel port.\n");
fprintf(stderr, "HINT: did you unload the lp kernel module?");
close (fd);
return(-1);
}
/* Enable CW & PTT - /STROBE bit (pin 1) */
parport_control (fd, PARPORT_CONTROL_STROBE, PARPORT_CONTROL_STROBE);
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
parport_control (fd, STROBE, STROBE);
#endif
lp_reset (fd);
return(0);
}
/* release ppdev and close port */
int
lp_free (int fd)
{
#ifdef HAVE_LINUX_PPDEV_H
lp_reset (fd);
/* Disable CW & PTT - /STROBE bit (pin 1) */
parport_control (fd, PARPORT_CONTROL_STROBE, 0);
ioctl (fd, PPRELEASE);
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
/* Disable CW & PTT - /STROBE bit (pin 1) */
parport_control (fd, STROBE, 0);
#endif
close (fd);
return(0);
}
/* set to a known state */
int
lp_reset (int fd)
{
#if defined (HAVE_LINUX_PPDEV_H) || defined (HAVE_DEV_PPBUS_PPI_H)
lp_ptt (fd, 0);
#endif
return(0);
}
/* SSB PTT keying - /INIT bit (pin 16) (inverted) */
int
lp_ptt (int fd, int onoff)
{
#ifdef HAVE_LINUX_PPDEV_H
if (onoff == 1)
parport_control (fd, PARPORT_CONTROL_INIT,
PARPORT_CONTROL_INIT);
else
parport_control (fd, PARPORT_CONTROL_INIT, 0);
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
if (onoff == 1)
parport_control (fd, nINIT,
nINIT);
else
parport_control (fd, nINIT, 0);
#endif
return(0);
}
/*
* ptt_parallel
*
* generic parallel unix PTT routine called indirectly from Fortran
*
* fd - already opened file descriptor
* ntx - pointer to fortran command on or off
* iptt - pointer to fortran command status on or off
*/
int
ptt_parallel(int fd, int *ntx, int *iptt)
{
if(*ntx) {
lp_ptt(fd, 1);
*iptt=1;
} else {
lp_ptt(fd, 0);
*iptt=0;
}
return(0);
}
/*
* WSJT is Copyright (c) 2001-2006 by Joseph H. Taylor, Jr., K1JT,
* and is licensed under the GNU General Public License (GPL).
*
* Code used from cwdaemon for parallel port ptt only.
*
* cwdaemon - morse sounding daemon for the parallel or serial port
* Copyright (C) 2002 -2005 Joop Stakenborg <pg4i@amsat.org>
* and many authors, see the AUTHORS file.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Library General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
# if HAVE_STDIO_H
# include <stdio.h>
#endif
#if STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
# if HAVE_STDLIB_H
# include <stdlib.h>
# endif
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#if HAVE_SYS_IOCTL_H
# include <sys/ioctl.h>
#endif
#if HAVE_FCNTL_H
# include <fcntl.h>
#endif
#ifdef HAVE_LINUX_PPDEV_H
# include <linux/ppdev.h>
# include <linux/parport.h>
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
# include <dev/ppbus/ppi.h>
# include <dev/ppbus/ppbconf.h>
#endif
int lp_reset (int fd);
int lp_ptt (int fd, int onoff);
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
#if (defined(__unix__) || defined(unix)) && !defined(USG)
# include <sys/param.h>
#endif
#include <string.h>
/* parport functions */
int dev_is_parport(int fd);
int ptt_parallel(int fd, int *ntx, int *iptt);
int ptt_serial(int fd, int *ntx, int *iptt);
int fd=-1; /* Used for both serial and parallel */
/*
* ptt_
*
* generic unix PTT routine called from Fortran
*
* Inputs
* unused Unused, to satisfy old windows calling convention
* ptt_port device name serial or parallel
* ntx pointer to fortran command on or off
* iptt pointer to fortran command status on or off
* Returns - non 0 if error
*/
/* Tiny state machine */
#define STATE_PORT_CLOSED 0
#define STATE_PORT_OPEN_PARALLEL 1
#define STATE_PORT_OPEN_SERIAL 2
//int ptt_(int *unused, char *ptt_port, int *ntx, int *iptt)
int ptt_(int *unused, int *ntx, int *iptt)
{
static int state=0;
char *p;
// ### Temporary:
char* ptt_port;
if(*unused != -99) {
*iptt=*ntx;
return 0;
}
// ###
/* In the very unlikely event of a NULL pointer, just return.
* Yes, I realise this should not be possible in WSJT.
*/
if (ptt_port == NULL) {
*iptt = *ntx;
return (0);
}
switch (state) {
case STATE_PORT_CLOSED:
/* Remove trailing ' ' */
if ((p = strchr(ptt_port, ' ')) != NULL)
*p = '\0';
/* If all that is left is a '\0' then also just return */
if (*ptt_port == '\0') {
*iptt = *ntx;
return(0);
}
if ((fd = open(ptt_port, O_RDWR|O_NONBLOCK)) < 0) {
fprintf(stderr, "Can't open %s.\n", ptt_port);
return (1);
}
if (dev_is_parport(fd)) {
state = STATE_PORT_OPEN_PARALLEL;
lp_reset(fd);
ptt_parallel(fd, ntx, iptt);
} else {
state = STATE_PORT_OPEN_SERIAL;
ptt_serial(fd, ntx, iptt);
}
break;
case STATE_PORT_OPEN_PARALLEL:
ptt_parallel(fd, ntx, iptt);
break;
case STATE_PORT_OPEN_SERIAL:
ptt_serial(fd, ntx, iptt);
break;
default:
close(fd);
fd = -1;
state = STATE_PORT_CLOSED;
break;
}
return(0);
}
/*
* ptt_serial
*
* generic serial unix PTT routine called indirectly from Fortran
*
* fd - already opened file descriptor
* ntx - pointer to fortran command on or off
* iptt - pointer to fortran command status on or off
*/
int
ptt_serial(int fd, int *ntx, int *iptt)
{
int control = TIOCM_RTS | TIOCM_DTR;
if(*ntx) {
ioctl(fd, TIOCMBIS, &control); /* Set DTR and RTS */
*iptt = 1;
} else {
ioctl(fd, TIOCMBIC, &control);
*iptt = 0;
}
return(0);
}
/* parport functions */
/*
* dev_is_parport(fd):
*
* inputs - Already open fd
* output - 1 if parallel port, 0 if not
* side effects - Unfortunately, this is platform specific.
*/
#if defined(HAVE_LINUX_PPDEV_H) /* Linux (ppdev) */
int
dev_is_parport(int fd)
{
struct stat st;
int m;
if ((fstat(fd, &st) == -1) ||
((st.st_mode & S_IFMT) != S_IFCHR) ||
(ioctl(fd, PPGETMODE, &m) == -1))
return(0);
return(1);
}
#elif defined(HAVE_DEV_PPBUS_PPI_H) /* FreeBSD (ppbus/ppi) */
int
dev_is_parport(int fd)
{
struct stat st;
unsigned char c;
if ((fstat(fd, &st) == -1) ||
((st.st_mode & S_IFMT) != S_IFCHR) ||
(ioctl(fd, PPISSTATUS, &c) == -1))
return(0);
return(1);
}
#else /* Fallback (nothing) */
int
dev_is_parport(int fd)
{
return(0);
}
#endif
/* Linux wrapper around PPFCONTROL */
#ifdef HAVE_LINUX_PPDEV_H
static void
parport_control (int fd, unsigned char controlbits, int values)
{
struct ppdev_frob_struct frob;
frob.mask = controlbits;
frob.val = values;
if (ioctl (fd, PPFCONTROL, &frob) == -1)
{
fprintf(stderr, "Parallel port PPFCONTROL");
exit (1);
}
}
#endif
/* FreeBSD wrapper around PPISCTRL */
#ifdef HAVE_DEV_PPBUS_PPI_H
static void
parport_control (int fd, unsigned char controlbits, int values)
{
unsigned char val;
if (ioctl (fd, PPIGCTRL, &val) == -1)
{
fprintf(stderr, "Parallel port PPIGCTRL");
exit (1);
}
val &= ~controlbits;
val |= values;
if (ioctl (fd, PPISCTRL, &val) == -1)
{
fprintf(stderr, "Parallel port PPISCTRL");
exit (1);
}
}
#endif
/* Initialise a parallel port, given open fd */
int
lp_init (int fd)
{
#ifdef HAVE_LINUX_PPDEV_H
int mode;
#endif
#ifdef HAVE_LINUX_PPDEV_H
mode = PARPORT_MODE_PCSPP;
if (ioctl (fd, PPSETMODE, &mode) == -1)
{
fprintf(stderr, "Setting parallel port mode");
close (fd);
return(-1);
}
if (ioctl (fd, PPEXCL, NULL) == -1)
{
fprintf(stderr, "Parallel port is already in use.\n");
close (fd);
return(-1);
}
if (ioctl (fd, PPCLAIM, NULL) == -1)
{
fprintf(stderr, "Claiming parallel port.\n");
fprintf(stderr, "HINT: did you unload the lp kernel module?");
close (fd);
return(-1);
}
/* Enable CW & PTT - /STROBE bit (pin 1) */
parport_control (fd, PARPORT_CONTROL_STROBE, PARPORT_CONTROL_STROBE);
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
parport_control (fd, STROBE, STROBE);
#endif
lp_reset (fd);
return(0);
}
/* release ppdev and close port */
int
lp_free (int fd)
{
#ifdef HAVE_LINUX_PPDEV_H
lp_reset (fd);
/* Disable CW & PTT - /STROBE bit (pin 1) */
parport_control (fd, PARPORT_CONTROL_STROBE, 0);
ioctl (fd, PPRELEASE);
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
/* Disable CW & PTT - /STROBE bit (pin 1) */
parport_control (fd, STROBE, 0);
#endif
close (fd);
return(0);
}
/* set to a known state */
int
lp_reset (int fd)
{
#if defined (HAVE_LINUX_PPDEV_H) || defined (HAVE_DEV_PPBUS_PPI_H)
lp_ptt (fd, 0);
#endif
return(0);
}
/* SSB PTT keying - /INIT bit (pin 16) (inverted) */
int
lp_ptt (int fd, int onoff)
{
#ifdef HAVE_LINUX_PPDEV_H
if (onoff == 1)
parport_control (fd, PARPORT_CONTROL_INIT,
PARPORT_CONTROL_INIT);
else
parport_control (fd, PARPORT_CONTROL_INIT, 0);
#endif
#ifdef HAVE_DEV_PPBUS_PPI_H
if (onoff == 1)
parport_control (fd, nINIT,
nINIT);
else
parport_control (fd, nINIT, 0);
#endif
return(0);
}
/*
* ptt_parallel
*
* generic parallel unix PTT routine called indirectly from Fortran
*
* fd - already opened file descriptor
* ntx - pointer to fortran command on or off
* iptt - pointer to fortran command status on or off
*/
int
ptt_parallel(int fd, int *ntx, int *iptt)
{
if(*ntx) {
lp_ptt(fd, 1);
*iptt=1;
} else {
lp_ptt(fd, 0);
*iptt=0;
}
return(0);
}
libm65/recvpkt.f90
+70 -70
View File
@@ -1,70 +1,70 @@
subroutine recvpkt(nsam,nblock2,userx_no,k,buf4,buf8,buf16)
! Reformat timf2 data from Linrad and stuff data into r*4 array dd().
parameter (NSMAX=60*96000) !Total sample intervals per minute
parameter (NFFT=32768)
integer*1 userx_no
real*4 d4,buf4(*) !(348)
real*8 d8,buf8(*) !(174)
complex*16 c16,buf16(*) !(87)
integer*2 jd(4),kd(2),nblock2
real*4 xd(4),yd(2)
real*8 fcenter
common/datcom/dd(4,5760000),ss(4,322,NFFT),savg(4,NFFT),fcenter,nutc,junk(34)
equivalence (kd,d4)
equivalence (jd,d8,yd)
equivalence (xd,c16)
if(nsam.eq.-1) then
! Move data from the UDP packet buffer into array dd().
if(userx_no.eq.-1) then
do i=1,174 !One RF channel, r*4 data
k=k+1
d8=buf8(i)
dd(1,k)=yd(1)
dd(2,k)=yd(2)
enddo
else if(userx_no.eq.1) then
do i=1,348 !One RF channel, i*2 data
k=k+1
d4=buf4(i)
dd(1,k)=kd(1)
dd(2,k)=kd(2)
enddo
else if(userx_no.eq.-2) then
do i=1,87 !Two RF channels, r*4 data
k=k+1
c16=buf16(i)
dd(1,k)=xd(1)
dd(2,k)=xd(2)
dd(3,k)=xd(3)
dd(4,k)=xd(4)
enddo
else if(userx_no.eq.2) then
do i=1,174 !Two RF channels, i*2 data
k=k+1
d8=buf8(i)
dd(1,k)=jd(1)
dd(2,k)=jd(2)
dd(3,k)=jd(3)
dd(4,k)=jd(4)
enddo
endif
else
if(userx_no.eq.1) then
do i=1,nsam !One RF channel, r*4 data
k=k+1
d4=buf4(i)
dd(1,k)=kd(1)
dd(2,k)=kd(2)
k=k+1
dd(1,k)=kd(1)
dd(2,k)=kd(2)
enddo
endif
endif
return
end subroutine recvpkt
subroutine recvpkt(nsam,nblock2,userx_no,k,buf4,buf8,buf16)
! Reformat timf2 data from Linrad and stuff data into r*4 array dd().
parameter (NSMAX=60*96000) !Total sample intervals per minute
parameter (NFFT=32768)
integer*1 userx_no
real*4 d4,buf4(*) !(348)
real*8 d8,buf8(*) !(174)
complex*16 c16,buf16(*) !(87)
integer*2 jd(4),kd(2),nblock2
real*4 xd(4),yd(2)
real*8 fcenter
common/datcom/dd(4,5760000),ss(4,322,NFFT),savg(4,NFFT),fcenter,nutc,junk(34)
equivalence (kd,d4)
equivalence (jd,d8,yd)
equivalence (xd,c16)
if(nsam.eq.-1) then
! Move data from the UDP packet buffer into array dd().
if(userx_no.eq.-1) then
do i=1,174 !One RF channel, r*4 data
k=k+1
d8=buf8(i)
dd(1,k)=yd(1)
dd(2,k)=yd(2)
enddo
else if(userx_no.eq.1) then
do i=1,348 !One RF channel, i*2 data
k=k+1
d4=buf4(i)
dd(1,k)=kd(1)
dd(2,k)=kd(2)
enddo
else if(userx_no.eq.-2) then
do i=1,87 !Two RF channels, r*4 data
k=k+1
c16=buf16(i)
dd(1,k)=xd(1)
dd(2,k)=xd(2)
dd(3,k)=xd(3)
dd(4,k)=xd(4)
enddo
else if(userx_no.eq.2) then
do i=1,174 !Two RF channels, i*2 data
k=k+1
d8=buf8(i)
dd(1,k)=jd(1)
dd(2,k)=jd(2)
dd(3,k)=jd(3)
dd(4,k)=jd(4)
enddo
endif
else
if(userx_no.eq.1) then
do i=1,nsam !One RF channel, r*4 data
k=k+1
d4=buf4(i)
dd(1,k)=kd(1)
dd(2,k)=kd(2)
k=k+1
dd(1,k)=kd(1)
dd(2,k)=kd(2)
enddo
endif
endif
return
end subroutine recvpkt
libm65/rfile3a.f90
+14 -14
View File
@@ -1,14 +1,14 @@
subroutine rfile3a(infile,ibuf,n,fcenter,ierr)
character*(*) infile
integer*8 ibuf(n)
real*8 fcenter
open(10,file=infile,access='stream',status='old',err=998)
read(10,end=998) (ibuf(i),i=1,n/8),fcenter
ierr=0
go to 999
998 ierr=1002
999 close(10)
return
end subroutine rfile3a
subroutine rfile3a(infile,ibuf,n,fcenter,ierr)
character*(*) infile
integer*8 ibuf(n)
real*8 fcenter
open(10,file=infile,access='stream',status='old',err=998)
read(10,end=998) (ibuf(i),i=1,n/8),fcenter
ierr=0
go to 999
998 ierr=1002
999 close(10)
return
end subroutine rfile3a
libm65/rs.h
+35 -35
View File
@@ -1,35 +1,35 @@
/* User include file for the Reed-Solomon codec
* Copyright 2002, Phil Karn KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
/* General purpose RS codec, 8-bit symbols */
void encode_rs_char(void *rs,unsigned char *data,unsigned char *parity);
int decode_rs_char(void *rs,unsigned char *data,int *eras_pos,
int no_eras);
void *init_rs_char(int symsize,int gfpoly,
int fcr,int prim,int nroots,
int pad);
void free_rs_char(void *rs);
/* General purpose RS codec, integer symbols */
void encode_rs_int(void *rs,int *data,int *parity);
int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras);
void *init_rs_int(int symsize,int gfpoly,int fcr,
int prim,int nroots,int pad);
void free_rs_int(void *rs);
/* CCSDS standard (255,223) RS codec with conventional (*not* dual-basis)
* symbol representation
*/
void encode_rs_8(unsigned char *data,unsigned char *parity,int pad);
int decode_rs_8(unsigned char *data,int *eras_pos,int no_eras,int pad);
/* CCSDS standard (255,223) RS codec with dual-basis symbol representation */
void encode_rs_ccsds(unsigned char *data,unsigned char *parity,int pad);
int decode_rs_ccsds(unsigned char *data,int *eras_pos,int no_eras,int pad);
/* Tables to map from conventional->dual (Taltab) and
* dual->conventional (Tal1tab) bases
*/
extern unsigned char Taltab[],Tal1tab[];
/* User include file for the Reed-Solomon codec
* Copyright 2002, Phil Karn KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
/* General purpose RS codec, 8-bit symbols */
void encode_rs_char(void *rs,unsigned char *data,unsigned char *parity);
int decode_rs_char(void *rs,unsigned char *data,int *eras_pos,
int no_eras);
void *init_rs_char(int symsize,int gfpoly,
int fcr,int prim,int nroots,
int pad);
void free_rs_char(void *rs);
/* General purpose RS codec, integer symbols */
void encode_rs_int(void *rs,int *data,int *parity);
int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras);
void *init_rs_int(int symsize,int gfpoly,int fcr,
int prim,int nroots,int pad);
void free_rs_int(void *rs);
/* CCSDS standard (255,223) RS codec with conventional (*not* dual-basis)
* symbol representation
*/
void encode_rs_8(unsigned char *data,unsigned char *parity,int pad);
int decode_rs_8(unsigned char *data,int *eras_pos,int no_eras,int pad);
/* CCSDS standard (255,223) RS codec with dual-basis symbol representation */
void encode_rs_ccsds(unsigned char *data,unsigned char *parity,int pad);
int decode_rs_ccsds(unsigned char *data,int *eras_pos,int no_eras,int pad);
/* Tables to map from conventional->dual (Taltab) and
* dual->conventional (Tal1tab) bases
*/
extern unsigned char Taltab[],Tal1tab[];
libm65/s3avg.f90
+42 -42
View File
@@ -1,42 +1,42 @@
subroutine s3avg(nsave,mode65,nutc,ndf,xdt,npol,s3,nkv,decoded)
real s3(64,63),s3b(64,63)
real s3a(64,63,32)
integer iutc(32),idf(32),ipol(32)
real dt(32)
character*22 decoded
logical ltext
save
n=nsave
iutc(n)=nutc
idf(n)=ndf
ipol(n)=npol
dt(n)=xdt
s3a(1:64,1:63,n)=s3
s3b=0.
nsum=0
idfdiff=100
dtdiff=0.2
do i=1,n
if(mod(iutc(i),2).ne.mod(nutc,2)) cycle
if(abs(ndf-idf(i)).gt.idfdiff) cycle
if(abs(xdt-dt(i)).gt.dtdiff) cycle
s3b=s3b + s3a(1:64,1:63,i)
nsum=nsum+1
enddo
decoded=' '
if(nsum.ge.2) then
nadd=mode65*nsum
call extract(s3b,nadd,ncount,nhist,decoded,ltext) !Extract the message
nkv=nsum
if(ncount.lt.0) then
nkv=0
decoded=' '
endif
endif
return
end subroutine s3avg
subroutine s3avg(nsave,mode65,nutc,ndf,xdt,npol,s3,nkv,decoded)
real s3(64,63),s3b(64,63)
real s3a(64,63,32)
integer iutc(32),idf(32),ipol(32)
real dt(32)
character*22 decoded
logical ltext
save
n=nsave
iutc(n)=nutc
idf(n)=ndf
ipol(n)=npol
dt(n)=xdt
s3a(1:64,1:63,n)=s3
s3b=0.
nsum=0
idfdiff=100
dtdiff=0.2
do i=1,n
if(mod(iutc(i),2).ne.mod(nutc,2)) cycle
if(abs(ndf-idf(i)).gt.idfdiff) cycle
if(abs(xdt-dt(i)).gt.dtdiff) cycle
s3b=s3b + s3a(1:64,1:63,i)
nsum=nsum+1
enddo
decoded=' '
if(nsum.ge.2) then
nadd=mode65*nsum
call extract(s3b,nadd,ncount,nhist,decoded,ltext) !Extract the message
nkv=nsum
if(ncount.lt.0) then
nkv=0
decoded=' '
endif
endif
return
end subroutine s3avg
libm65/set.f
+31 -31
View File
@@ -1,31 +1,31 @@
subroutine set(a,y,n)
real y(n)
do i=1,n
y(i)=a
enddo
return
end
subroutine move(x,y,n)
real x(n),y(n)
do i=1,n
y(i)=x(i)
enddo
return
end
subroutine zero(x,n)
real x(n)
do i=1,n
x(i)=0.0
enddo
return
end
subroutine add(a,b,c,n)
real a(n),b(n),c(n)
do i=1,n
c(i)=a(i)+b(i)
enddo
return
end
subroutine set(a,y,n)
real y(n)
do i=1,n
y(i)=a
enddo
return
end
subroutine move(x,y,n)
real x(n),y(n)
do i=1,n
y(i)=x(i)
enddo
return
end
subroutine zero(x,n)
real x(n)
do i=1,n
x(i)=0.0
enddo
return
end
subroutine add(a,b,c,n)
real a(n),b(n),c(n)
do i=1,n
c(i)=a(i)+b(i)
enddo
return
end
libm65/setup65.f
+96 -96
View File
@@ -1,96 +1,96 @@
subroutine setup65
C Defines arrays related to the JT65 pseudo-random synchronizing pattern.
C Executed at program start.
integer nprc(126)
common/prcom/pr(126),mdat(126),mref(126,2),mdat2(126),mref2(126,2)
C JT65
data nprc/
+ 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0,
+ 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1,
+ 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1,
+ 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1,
+ 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1,
+ 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1,
+ 1,1,1,1,1,1/
data mr2/0/ !Silence compiler warning
C Put the appropriate pseudo-random sequence into pr
nsym=126
do i=1,nsym
pr(i)=2*nprc(i)-1
enddo
C Determine locations of data and reference symbols
k=0
mr1=0
do i=1,nsym
if(pr(i).lt.0.0) then
k=k+1
mdat(k)=i
else
mr2=i
if(mr1.eq.0) mr1=i
endif
enddo
nsig=k
C Determine the reference symbols for each data symbol.
do k=1,nsig
m=mdat(k)
mref(k,1)=mr1
do n=1,10 !Get ref symbol before data
if((m-n).gt.0) then
if (pr(m-n).gt.0.0) go to 10
endif
enddo
go to 12
10 mref(k,1)=m-n
12 mref(k,2)=mr2
do n=1,10 !Get ref symbol after data
if((m+n).le.nsym) then
if (pr(m+n).gt.0.0) go to 20
endif
enddo
go to 22
20 mref(k,2)=m+n
22 enddo
C Now do it all again, using opposite logic on pr(i)
k=0
mr1=0
do i=1,nsym
if(pr(i).gt.0.0) then
k=k+1
mdat2(k)=i
else
mr2=i
if(mr1.eq.0) mr1=i
endif
enddo
nsig=k
do k=1,nsig
m=mdat2(k)
mref2(k,1)=mr1
do n=1,10
if((m-n).gt.0) then
if (pr(m-n).lt.0.0) go to 110
endif
enddo
go to 112
110 mref2(k,1)=m-n
112 mref2(k,2)=mr2
do n=1,10
if((m+n).le.nsym) then
if (pr(m+n).lt.0.0) go to 120
endif
enddo
go to 122
120 mref2(k,2)=m+n
122 enddo
return
end
subroutine setup65
C Defines arrays related to the JT65 pseudo-random synchronizing pattern.
C Executed at program start.
integer nprc(126)
common/prcom/pr(126),mdat(126),mref(126,2),mdat2(126),mref2(126,2)
C JT65
data nprc/
+ 1,0,0,1,1,0,0,0,1,1,1,1,1,1,0,1,0,1,0,0,
+ 0,1,0,1,1,0,0,1,0,0,0,1,1,1,0,0,1,1,1,1,
+ 0,1,1,0,1,1,1,1,0,0,0,1,1,0,1,0,1,0,1,1,
+ 0,0,1,1,0,1,0,1,0,1,0,0,1,0,0,0,0,0,0,1,
+ 1,0,0,0,0,0,0,0,1,1,0,1,0,0,1,0,1,1,0,1,
+ 0,1,0,1,0,0,1,1,0,0,1,0,0,1,0,0,0,0,1,1,
+ 1,1,1,1,1,1/
data mr2/0/ !Silence compiler warning
C Put the appropriate pseudo-random sequence into pr
nsym=126
do i=1,nsym
pr(i)=2*nprc(i)-1
enddo
C Determine locations of data and reference symbols
k=0
mr1=0
do i=1,nsym
if(pr(i).lt.0.0) then
k=k+1
mdat(k)=i
else
mr2=i
if(mr1.eq.0) mr1=i
endif
enddo
nsig=k
C Determine the reference symbols for each data symbol.
do k=1,nsig
m=mdat(k)
mref(k,1)=mr1
do n=1,10 !Get ref symbol before data
if((m-n).gt.0) then
if (pr(m-n).gt.0.0) go to 10
endif
enddo
go to 12
10 mref(k,1)=m-n
12 mref(k,2)=mr2
do n=1,10 !Get ref symbol after data
if((m+n).le.nsym) then
if (pr(m+n).gt.0.0) go to 20
endif
enddo
go to 22
20 mref(k,2)=m+n
22 enddo
C Now do it all again, using opposite logic on pr(i)
k=0
mr1=0
do i=1,nsym
if(pr(i).gt.0.0) then
k=k+1
mdat2(k)=i
else
mr2=i
if(mr1.eq.0) mr1=i
endif
enddo
nsig=k
do k=1,nsig
m=mdat2(k)
mref2(k,1)=mr1
do n=1,10
if((m-n).gt.0) then
if (pr(m-n).lt.0.0) go to 110
endif
enddo
go to 112
110 mref2(k,1)=m-n
112 mref2(k,2)=mr2
do n=1,10
if((m+n).le.nsym) then
if (pr(m+n).lt.0.0) go to 120
endif
enddo
go to 122
120 mref2(k,2)=m+n
122 enddo
return
end
libm65/sleep_msec.f90
+3 -3
View File
@@ -1,3 +1,3 @@
subroutine sleep_msec(n)
return
end subroutine sleep_msec
subroutine sleep_msec(n)
return
end subroutine sleep_msec
libm65/sort.f
+4 -4
View File
@@ -1,4 +1,4 @@
subroutine sort(n,arr)
call ssort(arr,tmp,n,1)
return
end
subroutine sort(n,arr)
call ssort(arr,tmp,n,1)
return
end
libm65/ssort.f
+287 -287
View File
@@ -1,287 +1,287 @@
subroutine ssort (x,y,n,kflag)
c***purpose sort an array and optionally make the same interchanges in
c an auxiliary array. the array may be sorted in increasing
c or decreasing order. a slightly modified quicksort
c algorithm is used.
c
c ssort sorts array x and optionally makes the same interchanges in
c array y. the array x may be sorted in increasing order or
c decreasing order. a slightly modified quicksort algorithm is used.
c
c description of parameters
c x - array of values to be sorted
c y - array to be (optionally) carried along
c n - number of values in array x to be sorted
c kflag - control parameter
c = 2 means sort x in increasing order and carry y along.
c = 1 means sort x in increasing order (ignoring y)
c = -1 means sort x in decreasing order (ignoring y)
c = -2 means sort x in decreasing order and carry y along.
integer kflag, n
! real x(n), y(n)
! real r, t, tt, tty, ty
integer x(n), y(n)
integer r, t, tt, tty, ty
integer i, ij, j, k, kk, l, m, nn
integer il(21), iu(21)
nn = n
if (nn .lt. 1) then
! print*,'ssort: The number of sort elements is not positive.'
! print*,'ssort: n = ',nn,' kflag = ',kflag
return
endif
c
kk = abs(kflag)
if (kk.ne.1 .and. kk.ne.2) then
print *,
+ 'the sort control parameter, k, is not 2, 1, -1, or -2.'
return
endif
c
c alter array x to get decreasing order if needed
c
if (kflag .le. -1) then
do 10 i=1,nn
x(i) = -x(i)
10 continue
endif
c
if (kk .eq. 2) go to 100
c
c sort x only
c
m = 1
i = 1
j = nn
r = 0.375e0
c
20 if (i .eq. j) go to 60
if (r .le. 0.5898437e0) then
r = r+3.90625e-2
else
r = r-0.21875e0
endif
c
30 k = i
c
c select a central element of the array and save it in location t
c
ij = i + int((j-i)*r)
t = x(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
endif
l = j
c
c if last element of array is less than than t, interchange with t
c
if (x(j) .lt. t) then
x(ij) = x(j)
x(j) = t
t = x(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
endif
endif
c
c find an element in the second half of the array which is smaller
c than t
c
40 l = l-1
if (x(l) .gt. t) go to 40
c
c find an element in the first half of the array which is greater
c than t
c
50 k = k+1
if (x(k) .lt. t) go to 50
c
c interchange these elements
c
if (k .le. l) then
tt = x(l)
x(l) = x(k)
x(k) = tt
go to 40
endif
c
c save upper and lower subscripts of the array yet to be sorted
c
if (l-i .gt. j-k) then
il(m) = i
iu(m) = l
i = k
m = m+1
else
il(m) = k
iu(m) = j
j = l
m = m+1
endif
go to 70
c
c begin again on another portion of the unsorted array
c
60 m = m-1
if (m .eq. 0) go to 190
i = il(m)
j = iu(m)
c
70 if (j-i .ge. 1) go to 30
if (i .eq. 1) go to 20
i = i-1
c
80 i = i+1
if (i .eq. j) go to 60
t = x(i+1)
if (x(i) .le. t) go to 80
k = i
c
90 x(k+1) = x(k)
k = k-1
if (t .lt. x(k)) go to 90
x(k+1) = t
go to 80
c
c sort x and carry y along
c
100 m = 1
i = 1
j = nn
r = 0.375e0
c
110 if (i .eq. j) go to 150
if (r .le. 0.5898437e0) then
r = r+3.90625e-2
else
r = r-0.21875e0
endif
c
120 k = i
c
c select a central element of the array and save it in location t
c
ij = i + int((j-i)*r)
t = x(ij)
ty = y(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
y(ij) = y(i)
y(i) = ty
ty = y(ij)
endif
l = j
c
c if last element of array is less than t, interchange with t
c
if (x(j) .lt. t) then
x(ij) = x(j)
x(j) = t
t = x(ij)
y(ij) = y(j)
y(j) = ty
ty = y(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
y(ij) = y(i)
y(i) = ty
ty = y(ij)
endif
endif
c
c find an element in the second half of the array which is smaller
c than t
c
130 l = l-1
if (x(l) .gt. t) go to 130
c
c find an element in the first half of the array which is greater
c than t
c
140 k = k+1
if (x(k) .lt. t) go to 140
c
c interchange these elements
c
if (k .le. l) then
tt = x(l)
x(l) = x(k)
x(k) = tt
tty = y(l)
y(l) = y(k)
y(k) = tty
go to 130
endif
c
c save upper and lower subscripts of the array yet to be sorted
c
if (l-i .gt. j-k) then
il(m) = i
iu(m) = l
i = k
m = m+1
else
il(m) = k
iu(m) = j
j = l
m = m+1
endif
go to 160
c
c begin again on another portion of the unsorted array
c
150 m = m-1
if (m .eq. 0) go to 190
i = il(m)
j = iu(m)
c
160 if (j-i .ge. 1) go to 120
if (i .eq. 1) go to 110
i = i-1
c
170 i = i+1
if (i .eq. j) go to 150
t = x(i+1)
ty = y(i+1)
if (x(i) .le. t) go to 170
k = i
c
180 x(k+1) = x(k)
y(k+1) = y(k)
k = k-1
if (t .lt. x(k)) go to 180
x(k+1) = t
y(k+1) = ty
go to 170
c
c clean up
c
190 if (kflag .le. -1) then
do 200 i=1,nn
x(i) = -x(i)
200 continue
endif
return
end
subroutine ssort (x,y,n,kflag)
c***purpose sort an array and optionally make the same interchanges in
c an auxiliary array. the array may be sorted in increasing
c or decreasing order. a slightly modified quicksort
c algorithm is used.
c
c ssort sorts array x and optionally makes the same interchanges in
c array y. the array x may be sorted in increasing order or
c decreasing order. a slightly modified quicksort algorithm is used.
c
c description of parameters
c x - array of values to be sorted
c y - array to be (optionally) carried along
c n - number of values in array x to be sorted
c kflag - control parameter
c = 2 means sort x in increasing order and carry y along.
c = 1 means sort x in increasing order (ignoring y)
c = -1 means sort x in decreasing order (ignoring y)
c = -2 means sort x in decreasing order and carry y along.
integer kflag, n
! real x(n), y(n)
! real r, t, tt, tty, ty
integer x(n), y(n)
integer r, t, tt, tty, ty
integer i, ij, j, k, kk, l, m, nn
integer il(21), iu(21)
nn = n
if (nn .lt. 1) then
! print*,'ssort: The number of sort elements is not positive.'
! print*,'ssort: n = ',nn,' kflag = ',kflag
return
endif
c
kk = abs(kflag)
if (kk.ne.1 .and. kk.ne.2) then
print *,
+ 'the sort control parameter, k, is not 2, 1, -1, or -2.'
return
endif
c
c alter array x to get decreasing order if needed
c
if (kflag .le. -1) then
do 10 i=1,nn
x(i) = -x(i)
10 continue
endif
c
if (kk .eq. 2) go to 100
c
c sort x only
c
m = 1
i = 1
j = nn
r = 0.375e0
c
20 if (i .eq. j) go to 60
if (r .le. 0.5898437e0) then
r = r+3.90625e-2
else
r = r-0.21875e0
endif
c
30 k = i
c
c select a central element of the array and save it in location t
c
ij = i + int((j-i)*r)
t = x(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
endif
l = j
c
c if last element of array is less than than t, interchange with t
c
if (x(j) .lt. t) then
x(ij) = x(j)
x(j) = t
t = x(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
endif
endif
c
c find an element in the second half of the array which is smaller
c than t
c
40 l = l-1
if (x(l) .gt. t) go to 40
c
c find an element in the first half of the array which is greater
c than t
c
50 k = k+1
if (x(k) .lt. t) go to 50
c
c interchange these elements
c
if (k .le. l) then
tt = x(l)
x(l) = x(k)
x(k) = tt
go to 40
endif
c
c save upper and lower subscripts of the array yet to be sorted
c
if (l-i .gt. j-k) then
il(m) = i
iu(m) = l
i = k
m = m+1
else
il(m) = k
iu(m) = j
j = l
m = m+1
endif
go to 70
c
c begin again on another portion of the unsorted array
c
60 m = m-1
if (m .eq. 0) go to 190
i = il(m)
j = iu(m)
c
70 if (j-i .ge. 1) go to 30
if (i .eq. 1) go to 20
i = i-1
c
80 i = i+1
if (i .eq. j) go to 60
t = x(i+1)
if (x(i) .le. t) go to 80
k = i
c
90 x(k+1) = x(k)
k = k-1
if (t .lt. x(k)) go to 90
x(k+1) = t
go to 80
c
c sort x and carry y along
c
100 m = 1
i = 1
j = nn
r = 0.375e0
c
110 if (i .eq. j) go to 150
if (r .le. 0.5898437e0) then
r = r+3.90625e-2
else
r = r-0.21875e0
endif
c
120 k = i
c
c select a central element of the array and save it in location t
c
ij = i + int((j-i)*r)
t = x(ij)
ty = y(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
y(ij) = y(i)
y(i) = ty
ty = y(ij)
endif
l = j
c
c if last element of array is less than t, interchange with t
c
if (x(j) .lt. t) then
x(ij) = x(j)
x(j) = t
t = x(ij)
y(ij) = y(j)
y(j) = ty
ty = y(ij)
c
c if first element of array is greater than t, interchange with t
c
if (x(i) .gt. t) then
x(ij) = x(i)
x(i) = t
t = x(ij)
y(ij) = y(i)
y(i) = ty
ty = y(ij)
endif
endif
c
c find an element in the second half of the array which is smaller
c than t
c
130 l = l-1
if (x(l) .gt. t) go to 130
c
c find an element in the first half of the array which is greater
c than t
c
140 k = k+1
if (x(k) .lt. t) go to 140
c
c interchange these elements
c
if (k .le. l) then
tt = x(l)
x(l) = x(k)
x(k) = tt
tty = y(l)
y(l) = y(k)
y(k) = tty
go to 130
endif
c
c save upper and lower subscripts of the array yet to be sorted
c
if (l-i .gt. j-k) then
il(m) = i
iu(m) = l
i = k
m = m+1
else
il(m) = k
iu(m) = j
j = l
m = m+1
endif
go to 160
c
c begin again on another portion of the unsorted array
c
150 m = m-1
if (m .eq. 0) go to 190
i = il(m)
j = iu(m)
c
160 if (j-i .ge. 1) go to 120
if (i .eq. 1) go to 110
i = i-1
c
170 i = i+1
if (i .eq. j) go to 150
t = x(i+1)
ty = y(i+1)
if (x(i) .le. t) go to 170
k = i
c
180 x(k+1) = x(k)
y(k+1) = y(k)
k = k-1
if (t .lt. x(k)) go to 180
x(k+1) = t
y(k+1) = ty
go to 170
c
c clean up
c
190 if (kflag .le. -1) then
do 200 i=1,nn
x(i) = -x(i)
200 continue
endif
return
end
libm65/sun.f
+88 -88
View File
@@ -1,88 +1,88 @@
subroutine sun(y,m,DD,UT,lon,lat,RA,Dec,LST,Az,El,mjd,day)
implicit none
integer y !Year
integer m !Month
integer DD !Day
integer mjd !Modified Julian Date
real UT !UTC in hours
real RA,Dec !RA and Dec of sun
C NB: Double caps here are single caps in the writeup.
C Orbital elements of the Sun (also N=0, i=0, a=1):
real w !Argument of perihelion
real e !Eccentricity
real MM !Mean anomaly
real Ls !Mean longitude
C Other standard variables:
real v !True anomaly
real EE !Eccentric anomaly
real ecl !Obliquity of the ecliptic
real d !Ephemeris time argument in days
real r !Distance to sun, AU
real xv,yv !x and y coords in ecliptic
real lonsun !Ecliptic long and lat of sun
C Ecliptic coords of sun (geocentric)
real xs,ys
C Equatorial coords of sun (geocentric)
real xe,ye,ze
real lon,lat
real GMST0,LST,HA
real xx,yy,zz
real xhor,yhor,zhor
real Az,El
real day
real rad
data rad/57.2957795/
C Time in days, with Jan 0, 2000 equal to 0.0:
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + DD - 730530 + UT/24.0
mjd=d + 51543
ecl = 23.4393 - 3.563e-7 * d
C Compute updated orbital elements for Sun:
w = 282.9404 + 4.70935e-5 * d
e = 0.016709 - 1.151e-9 * d
MM = mod(356.0470d0 + 0.9856002585d0 * d + 360000.d0,360.d0)
Ls = mod(w+MM+720.0,360.0)
EE = MM + e*rad*sin(MM/rad) * (1.0 + e*cos(M/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.0 - e*cos(EE/rad))
xv = cos(EE/rad) - e
yv = sqrt(1.0-e*e) * sin(EE/rad)
v = rad*atan2(yv,xv)
r = sqrt(xv*xv + yv*yv)
lonsun = mod(v + w + 720.0,360.0)
C Ecliptic coordinates of sun (rectangular):
xs = r * cos(lonsun/rad)
ys = r * sin(lonsun/rad)
C Equatorial coordinates of sun (rectangular):
xe = xs
ye = ys * cos(ecl/rad)
ze = ys * sin(ecl/rad)
C RA and Dec in degrees:
RA = rad*atan2(ye,xe)
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
GMST0 = (Ls + 180.0)/15.0
LST = mod(GMST0+UT+lon/15.0+48.0,24.0) !LST in hours
HA = 15.0*LST - RA !HA in degrees
xx = cos(HA/rad)*cos(Dec/rad)
yy = sin(HA/rad)*cos(Dec/rad)
zz = sin(Dec/rad)
xhor = xx*sin(lat/rad) - zz*cos(lat/rad)
yhor = yy
zhor = xx*cos(lat/rad) + zz*sin(lat/rad)
Az = mod(rad*atan2(yhor,xhor) + 180.0 + 360.0,360.0)
El = rad*asin(zhor)
day=d-1.5
return
end
subroutine sun(y,m,DD,UT,lon,lat,RA,Dec,LST,Az,El,mjd,day)
implicit none
integer y !Year
integer m !Month
integer DD !Day
integer mjd !Modified Julian Date
real UT !UTC in hours
real RA,Dec !RA and Dec of sun
C NB: Double caps here are single caps in the writeup.
C Orbital elements of the Sun (also N=0, i=0, a=1):
real w !Argument of perihelion
real e !Eccentricity
real MM !Mean anomaly
real Ls !Mean longitude
C Other standard variables:
real v !True anomaly
real EE !Eccentric anomaly
real ecl !Obliquity of the ecliptic
real d !Ephemeris time argument in days
real r !Distance to sun, AU
real xv,yv !x and y coords in ecliptic
real lonsun !Ecliptic long and lat of sun
C Ecliptic coords of sun (geocentric)
real xs,ys
C Equatorial coords of sun (geocentric)
real xe,ye,ze
real lon,lat
real GMST0,LST,HA
real xx,yy,zz
real xhor,yhor,zhor
real Az,El
real day
real rad
data rad/57.2957795/
C Time in days, with Jan 0, 2000 equal to 0.0:
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + DD - 730530 + UT/24.0
mjd=d + 51543
ecl = 23.4393 - 3.563e-7 * d
C Compute updated orbital elements for Sun:
w = 282.9404 + 4.70935e-5 * d
e = 0.016709 - 1.151e-9 * d
MM = mod(356.0470d0 + 0.9856002585d0 * d + 360000.d0,360.d0)
Ls = mod(w+MM+720.0,360.0)
EE = MM + e*rad*sin(MM/rad) * (1.0 + e*cos(M/rad))
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.0 - e*cos(EE/rad))
xv = cos(EE/rad) - e
yv = sqrt(1.0-e*e) * sin(EE/rad)
v = rad*atan2(yv,xv)
r = sqrt(xv*xv + yv*yv)
lonsun = mod(v + w + 720.0,360.0)
C Ecliptic coordinates of sun (rectangular):
xs = r * cos(lonsun/rad)
ys = r * sin(lonsun/rad)
C Equatorial coordinates of sun (rectangular):
xe = xs
ye = ys * cos(ecl/rad)
ze = ys * sin(ecl/rad)
C RA and Dec in degrees:
RA = rad*atan2(ye,xe)
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
GMST0 = (Ls + 180.0)/15.0
LST = mod(GMST0+UT+lon/15.0+48.0,24.0) !LST in hours
HA = 15.0*LST - RA !HA in degrees
xx = cos(HA/rad)*cos(Dec/rad)
yy = sin(HA/rad)*cos(Dec/rad)
zz = sin(Dec/rad)
xhor = xx*sin(lat/rad) - zz*cos(lat/rad)
yhor = yy
zhor = xx*cos(lat/rad) + zz*sin(lat/rad)
Az = mod(rad*atan2(yhor,xhor) + 180.0 + 360.0,360.0)
El = rad*asin(zhor)
day=d-1.5
return
end
libm65/symspec.f90
+193 -193
View File
@@ -1,193 +1,193 @@
subroutine symspec(k,nxpol,ndiskdat,nb,nbslider,idphi,nfsample,fgreen, &
iqadjust,iqapply,gainx,gainy,phasex,phasey,rejectx,rejecty, &
pxdb,pydb,ssz5a,nkhz,ihsym,nzap,slimit,lstrong)
! k pointer to the most recent new data
! nxpol 0/1 to indicate single- or dual-polarization
! ndiskdat 0/1 to indicate if data from disk
! nb 0/1 status of noise blanker
! idphi Phase correction for Y channel, degrees
! nfsample sample rate (Hz)
! fgreen Frequency of green marker in I/Q calibrate mode (-48.0 to +48.0 kHz)
! iqadjust 0/1 to indicate whether IQ adjustment is active
! iqapply 0/1 to indicate whether to apply I/Q calibration
! pxdb power in x channel (0-60 dB)
! pydb power in y channel (0-60 dB)
! ssz5a polarized spectrum, for waterfall display
! nkhz integer kHz portion of center frequency, e.g., 125 for 144.125
! ihsym index number of this half-symbol (1-322)
! nzap number of samples zero'ed by noise blanker
parameter (NSMAX=60*96000) !Total sample intervals per minute
parameter (NFFT=32768) !Length of FFTs
real*8 ts,hsym
real*8 fcenter
common/datcom/dd(4,5760000),ss(4,322,NFFT),savg(4,NFFT),fcenter,nutc,junk(34)
real*4 ssz5a(NFFT),w(NFFT)
complex z,zfac
complex zsumx,zsumy
complex cx(NFFT),cy(NFFT)
complex cx0(0:1023),cx1(0:1023)
complex cy0(0:1023),cy1(0:1023)
logical*1 lstrong(0:1023)
data rms/999.0/,k0/99999999/,nadjx/0/,nadjy/0/
save
if(k.gt.5751000) go to 999
if(k.lt.NFFT) then
ihsym=0
go to 999 !Wait for enough samples to start
endif
if(k.lt.k0) k1=0
if(k0.eq.99999999) then
pi=4.0*atan(1.0)
do i=1,NFFT
w(i)=(sin(i*pi/NFFT))**2
enddo
endif
nzap=0
sigmas=1.5*(10.0**(0.01*nbslider)) + 0.7
peaklimit=sigmas*max(10.0,rms)
faclim=3.0
px=0.
py=0.
iqapply0=0
iqadjust0=0
if(iqadjust.ne.0) iqapply0=0
nwindow=2
nfft2=1024
kstep=nfft2
if(nwindow.ne.0) kstep=nfft2/2
nblks=(k-k1)/kstep
do nblk=1,nblks
j=k1+1
do i=0,nfft2-1
cx0(i)=cmplx(dd(1,j+i),dd(2,j+i))
if(nxpol.ne.0) cy0(i)=cmplx(dd(3,j+i),dd(4,j+i))
enddo
call timf2(nxpol,nfft2,nwindow,nb,peaklimit,iqadjust0,iqapply0,faclim, &
cx0,cy0,gainx,gainy,phasex,phasey,cx1,cy1,slimit,lstrong, &
px,py,nzap)
do i=0,kstep-1
dd(1,j+i)=real(cx1(i))
dd(2,j+i)=aimag(cx1(i))
if(nxpol.ne.0) then
dd(3,j+i)=real(cy1(i))
dd(4,j+i)=aimag(cy1(i))
endif
enddo
k1=k1+kstep
enddo
hsym=2048.d0*96000.d0/11025.d0 !Samples per JT65 half-symbol
if(nfsample.eq.95238) hsym=2048.d0*95238.1d0/11025.d0
npts=NFFT !Samples used in each half-symbol FFT
if(k.lt.k0) then
ts=1.d0 - hsym
savg=0.
ihsym=0
endif
k0=k
ihsym=ihsym+1
ja=ts+hsym !Index of first sample
jb=ja+npts-1 !Last sample
ts=ts+hsym
i=0
fac=0.0002
dphi=idphi/57.2957795
zfac=fac*cmplx(cos(dphi),sin(dphi))
do j=ja,jb !Copy data into cx, cy
x1=dd(1,j)
x2=dd(2,j)
if(nxpol.ne.0) then
x3=dd(3,j)
x4=dd(4,j)
else
x3=0.
x4=0.
endif
i=i+1
cx(i)=fac*cmplx(x1,x2)
cy(i)=zfac*cmplx(x3,x4) !NB: cy includes dphi correction
enddo
if(nzap/178.lt.50 .and. (ndiskdat.eq.0 .or. ihsym.lt.280)) then
nsum=nblks*kstep - nzap
if(nsum.le.0) nsum=1
rmsx=sqrt(0.5*px/nsum)
rmsy=sqrt(0.5*py/nsum)
rms=rmsx
if(nxpol.ne.0) rms=sqrt((px+py)/(4.0*nsum))
endif
pxdb=0.
pydb=0.
if(rmsx.gt.1.0) pxdb=20.0*log10(rmsx)
if(rmsy.gt.1.0) pydb=20.0*log10(rmsy)
if(pxdb.gt.60.0) pxdb=60.0
if(pydb.gt.60.0) pydb=60.0
cx=w*cx !Apply window for 2nd forward FFT
if(nxpol.ne.0) cy=w*cy
call four2a(cx,NFFT,1,1,1) !Second forward FFT
if(iqadjust.eq.0) nadjx=0
if(iqadjust.ne.0 .and. nadjx.lt.50) call iqcal(nadjx,cx,NFFT,gainx,phasex, &
zsumx,ipkx,rejectx0)
if(iqapply.ne.0) call iqfix(cx,NFFT,gainx,phasex)
if(nxpol.ne.0) then
call four2a(cy,NFFT,1,1,1)
if(iqadjust.eq.0) nadjy=0
if(iqadjust.ne.0 .and. nadjy.lt.50) call iqcal(nadjy,cy,NFFT,gainy,phasey,&
zsumy,ipky,rejecty)
if(iqapply.ne.0) call iqfix(cy,NFFT,gainy,phasey)
endif
n=ihsym
do i=1,NFFT
sx=real(cx(i))**2 + aimag(cx(i))**2
ss(1,n,i)=sx ! Pol = 0
savg(1,i)=savg(1,i) + sx
if(nxpol.ne.0) then
z=cx(i) + cy(i)
s45=0.5*(real(z)**2 + aimag(z)**2)
ss(2,n,i)=s45 ! Pol = 45
savg(2,i)=savg(2,i) + s45
sy=real(cy(i))**2 + aimag(cy(i))**2
ss(3,n,i)=sy ! Pol = 90
savg(3,i)=savg(3,i) + sy
z=cx(i) - cy(i)
s135=0.5*(real(z)**2 + aimag(z)**2)
ss(4,n,i)=s135 ! Pol = 135
savg(4,i)=savg(4,i) + s135
z=cx(i)*conjg(cy(i))
q=sx - sy
u=2.0*real(z)
ssz5a(i)=0.707*sqrt(q*q + u*u) !Spectrum of linear polarization
! Leif's formula:
! ssz5a(i)=0.5*(sx+sy) + (real(z)**2 + aimag(z)**2 - sx*sy)/(sx+sy)
else
ssz5a(i)=sx
endif
enddo
if(ihsym.eq.278) then
if(iqadjust.ne.0 .and. ipkx.ne.0 .and. ipky.ne.0) then
rejectx=10.0*log10(savg(1,1+nfft-ipkx)/savg(1,1+ipkx))
rejecty=10.0*log10(savg(3,1+nfft-ipky)/savg(3,1+ipky))
endif
endif
nkhz=nint(1000.d0*(fcenter-int(fcenter)))
if(fcenter.eq.0.d0) nkhz=125
999 return
end subroutine symspec
subroutine symspec(k,nxpol,ndiskdat,nb,nbslider,idphi,nfsample,fgreen, &
iqadjust,iqapply,gainx,gainy,phasex,phasey,rejectx,rejecty, &
pxdb,pydb,ssz5a,nkhz,ihsym,nzap,slimit,lstrong)
! k pointer to the most recent new data
! nxpol 0/1 to indicate single- or dual-polarization
! ndiskdat 0/1 to indicate if data from disk
! nb 0/1 status of noise blanker
! idphi Phase correction for Y channel, degrees
! nfsample sample rate (Hz)
! fgreen Frequency of green marker in I/Q calibrate mode (-48.0 to +48.0 kHz)
! iqadjust 0/1 to indicate whether IQ adjustment is active
! iqapply 0/1 to indicate whether to apply I/Q calibration
! pxdb power in x channel (0-60 dB)
! pydb power in y channel (0-60 dB)
! ssz5a polarized spectrum, for waterfall display
! nkhz integer kHz portion of center frequency, e.g., 125 for 144.125
! ihsym index number of this half-symbol (1-322)
! nzap number of samples zero'ed by noise blanker
parameter (NSMAX=60*96000) !Total sample intervals per minute
parameter (NFFT=32768) !Length of FFTs
real*8 ts,hsym
real*8 fcenter
common/datcom/dd(4,5760000),ss(4,322,NFFT),savg(4,NFFT),fcenter,nutc,junk(34)
real*4 ssz5a(NFFT),w(NFFT)
complex z,zfac
complex zsumx,zsumy
complex cx(NFFT),cy(NFFT)
complex cx0(0:1023),cx1(0:1023)
complex cy0(0:1023),cy1(0:1023)
logical*1 lstrong(0:1023)
data rms/999.0/,k0/99999999/,nadjx/0/,nadjy/0/
save
if(k.gt.5751000) go to 999
if(k.lt.NFFT) then
ihsym=0
go to 999 !Wait for enough samples to start
endif
if(k.lt.k0) k1=0
if(k0.eq.99999999) then
pi=4.0*atan(1.0)
do i=1,NFFT
w(i)=(sin(i*pi/NFFT))**2
enddo
endif
nzap=0
sigmas=1.5*(10.0**(0.01*nbslider)) + 0.7
peaklimit=sigmas*max(10.0,rms)
faclim=3.0
px=0.
py=0.
iqapply0=0
iqadjust0=0
if(iqadjust.ne.0) iqapply0=0
nwindow=2
nfft2=1024
kstep=nfft2
if(nwindow.ne.0) kstep=nfft2/2
nblks=(k-k1)/kstep
do nblk=1,nblks
j=k1+1
do i=0,nfft2-1
cx0(i)=cmplx(dd(1,j+i),dd(2,j+i))
if(nxpol.ne.0) cy0(i)=cmplx(dd(3,j+i),dd(4,j+i))
enddo
call timf2(nxpol,nfft2,nwindow,nb,peaklimit,iqadjust0,iqapply0,faclim, &
cx0,cy0,gainx,gainy,phasex,phasey,cx1,cy1,slimit,lstrong, &
px,py,nzap)
do i=0,kstep-1
dd(1,j+i)=real(cx1(i))
dd(2,j+i)=aimag(cx1(i))
if(nxpol.ne.0) then
dd(3,j+i)=real(cy1(i))
dd(4,j+i)=aimag(cy1(i))
endif
enddo
k1=k1+kstep
enddo
hsym=2048.d0*96000.d0/11025.d0 !Samples per JT65 half-symbol
if(nfsample.eq.95238) hsym=2048.d0*95238.1d0/11025.d0
npts=NFFT !Samples used in each half-symbol FFT
if(k.lt.k0) then
ts=1.d0 - hsym
savg=0.
ihsym=0
endif
k0=k
ihsym=ihsym+1
ja=ts+hsym !Index of first sample
jb=ja+npts-1 !Last sample
ts=ts+hsym
i=0
fac=0.0002
dphi=idphi/57.2957795
zfac=fac*cmplx(cos(dphi),sin(dphi))
do j=ja,jb !Copy data into cx, cy
x1=dd(1,j)
x2=dd(2,j)
if(nxpol.ne.0) then
x3=dd(3,j)
x4=dd(4,j)
else
x3=0.
x4=0.
endif
i=i+1
cx(i)=fac*cmplx(x1,x2)
cy(i)=zfac*cmplx(x3,x4) !NB: cy includes dphi correction
enddo
if(nzap/178.lt.50 .and. (ndiskdat.eq.0 .or. ihsym.lt.280)) then
nsum=nblks*kstep - nzap
if(nsum.le.0) nsum=1
rmsx=sqrt(0.5*px/nsum)
rmsy=sqrt(0.5*py/nsum)
rms=rmsx
if(nxpol.ne.0) rms=sqrt((px+py)/(4.0*nsum))
endif
pxdb=0.
pydb=0.
if(rmsx.gt.1.0) pxdb=20.0*log10(rmsx)
if(rmsy.gt.1.0) pydb=20.0*log10(rmsy)
if(pxdb.gt.60.0) pxdb=60.0
if(pydb.gt.60.0) pydb=60.0
cx=w*cx !Apply window for 2nd forward FFT
if(nxpol.ne.0) cy=w*cy
call four2a(cx,NFFT,1,1,1) !Second forward FFT
if(iqadjust.eq.0) nadjx=0
if(iqadjust.ne.0 .and. nadjx.lt.50) call iqcal(nadjx,cx,NFFT,gainx,phasex, &
zsumx,ipkx,rejectx0)
if(iqapply.ne.0) call iqfix(cx,NFFT,gainx,phasex)
if(nxpol.ne.0) then
call four2a(cy,NFFT,1,1,1)
if(iqadjust.eq.0) nadjy=0
if(iqadjust.ne.0 .and. nadjy.lt.50) call iqcal(nadjy,cy,NFFT,gainy,phasey,&
zsumy,ipky,rejecty)
if(iqapply.ne.0) call iqfix(cy,NFFT,gainy,phasey)
endif
n=ihsym
do i=1,NFFT
sx=real(cx(i))**2 + aimag(cx(i))**2
ss(1,n,i)=sx ! Pol = 0
savg(1,i)=savg(1,i) + sx
if(nxpol.ne.0) then
z=cx(i) + cy(i)
s45=0.5*(real(z)**2 + aimag(z)**2)
ss(2,n,i)=s45 ! Pol = 45
savg(2,i)=savg(2,i) + s45
sy=real(cy(i))**2 + aimag(cy(i))**2
ss(3,n,i)=sy ! Pol = 90
savg(3,i)=savg(3,i) + sy
z=cx(i) - cy(i)
s135=0.5*(real(z)**2 + aimag(z)**2)
ss(4,n,i)=s135 ! Pol = 135
savg(4,i)=savg(4,i) + s135
z=cx(i)*conjg(cy(i))
q=sx - sy
u=2.0*real(z)
ssz5a(i)=0.707*sqrt(q*q + u*u) !Spectrum of linear polarization
! Leif's formula:
! ssz5a(i)=0.5*(sx+sy) + (real(z)**2 + aimag(z)**2 - sx*sy)/(sx+sy)
else
ssz5a(i)=sx
endif
enddo
if(ihsym.eq.278) then
if(iqadjust.ne.0 .and. ipkx.ne.0 .and. ipky.ne.0) then
rejectx=10.0*log10(savg(1,1+nfft-ipkx)/savg(1,1+ipkx))
rejecty=10.0*log10(savg(3,1+nfft-ipky)/savg(3,1+ipky))
endif
endif
nkhz=nint(1000.d0*(fcenter-int(fcenter)))
if(fcenter.eq.0.d0) nkhz=125
999 return
end subroutine symspec
libm65/tastro.f90
+35 -35
View File
@@ -1,35 +1,35 @@
program tastro
implicit real*8 (a-h,o-z)
character grid*6
character*9 cauxra,cauxdec
character*12 clock(3)
integer nt(8)
equivalence (nt(1),nyear)
grid='FN20qi'
nfreq=144
cauxra='00:00:00'
10 call date_and_time(clock(1),clock(2),clock(3),nt)
ih=ihour-ntz/60
if(ih.le.0) then
ih=ih+24
nday=nday+1
endif
uth8=ih + imin/60.d0 + isec/3600.d0 + ims/3600000.d0
call astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
RaAux8,DecAux8,AzAux8,ElAux8,width1,width2,w501,w502,xlst8)
write(*,1010) nyear,month,nday,ih,imin,isec,AzMoon8,ElMoon8, &
AzSun8,ElSun8,ndop,dgrd8,ntsky
1010 format(i4,i3,i3,i4.2,':',i2.2,':',i2.2,4f8.1,i6,f6.1,i6)
call system('sleep 1')
go to 10
end program tastro
program tastro
implicit real*8 (a-h,o-z)
character grid*6
character*9 cauxra,cauxdec
character*12 clock(3)
integer nt(8)
equivalence (nt(1),nyear)
grid='FN20qi'
nfreq=144
cauxra='00:00:00'
10 call date_and_time(clock(1),clock(2),clock(3),nt)
ih=ihour-ntz/60
if(ih.le.0) then
ih=ih+24
nday=nday+1
endif
uth8=ih + imin/60.d0 + isec/3600.d0 + ims/3600000.d0
call astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
RaAux8,DecAux8,AzAux8,ElAux8,width1,width2,w501,w502,xlst8)
write(*,1010) nyear,month,nday,ih,imin,isec,AzMoon8,ElMoon8, &
AzSun8,ElSun8,ndop,dgrd8,ntsky
1010 format(i4,i3,i3,i4.2,':',i2.2,':',i2.2,4f8.1,i6,f6.1,i6)
call system('sleep 1')
go to 10
end program tastro
libm65/timf2.f90
+220 -220
View File
@@ -1,220 +1,220 @@
subroutine timf2(nxpol,nfft,nwindow,nb,peaklimit,iqadjust,iqapply,faclim, &
cx0,cy0,gainx,gainy,phasex,phasey,cx1,cy1,slimit,lstrong,px,py,nzap)
! Sequential processing of time-domain I/Q data, using Linrad-like
! "first FFT" and "first backward FFT".
! cx0,cy0 - complex input data
! nfft - length of FFTs
! nwindow - 0 for no window, 2 for sin^2 window
! iqapply - 0/1 determines if I/Q phase and amplitude corrections applied
! gainx,y - gain error in Q channel, relative to I
! phasex,y - phase error
! cx1,cy1 - output data
! Non-windowed processing means no overlap, so kstep=nfft.
! Sin^2 window has 50% overlap, kstep=nfft/2.
! Frequencies with strong signals are identified and separated. The back
! transforms are done separately for weak and strong signals, so that
! noise blanking can be applied to the weak-signal portion. Strong and
! weak are finally re-combined in the time domain.
parameter (MAXFFT=1024,MAXNH=MAXFFT/2)
parameter (MAXSIGS=100)
complex cx0(0:nfft-1),cx1(0:nfft-1)
complex cy0(0:nfft-1),cy1(0:nfft-1)
complex cx(0:MAXFFT-1),cxt(0:MAXFFT-1)
complex cy(0:MAXFFT-1),cyt(0:MAXFFT-1)
complex cxs(0:MAXFFT-1),covxs(0:MAXNH-1) !Strong X signals
complex cys(0:MAXFFT-1),covys(0:MAXNH-1) !Strong Y signals
complex cxw(0:MAXFFT-1),covxw(0:MAXNH-1) !Weak X signals
complex cyw(0:MAXFFT-1),covyw(0:MAXNH-1) !Weak Y signals
real*4 w(0:MAXFFT-1)
real*4 s(0:MAXFFT-1),stmp(0:MAXFFT-1)
logical*1 lstrong(0:MAXFFT-1),lprev
integer ia(MAXSIGS),ib(MAXSIGS)
complex h,u,v
logical first
data first/.true./
save w,covxs,covxw,covys,covyw,s,ntc,ntot,nh,kstep,fac,first
if(first) then
pi=4.0*atan(1.0)
do i=0,nfft-1
w(i)=(sin(i*pi/nfft))**2
enddo
covxs=0.
covxw=0.
covys=0.
covyw=0.
s=0.
ntc=0
ntot=0
nh=nfft/2
kstep=nfft
if(nwindow.eq.2) kstep=nh
fac=1.0/nfft
slimit=1.e30
first=.false.
endif
cx(0:nfft-1)=cx0
if(nwindow.eq.2) cx(0:nfft-1)=w(0:nfft-1)*cx(0:nfft-1)
call four2a(cx,nfft,1,1,1) !First forward FFT
if(nxpol.ne.0) then
cy(0:nfft-1)=cy0
if(nwindow.eq.2) cy(0:nfft-1)=w(0:nfft-1)*cy(0:nfft-1)
call four2a(cy,nfft,1,1,1) !First forward FFT
endif
if(iqapply.ne.0) then !Apply I/Q corrections
h=gainx*cmplx(cos(phasex),sin(phasex))
v=0.
do i=0,nfft-1
u=cx(i)
if(i.gt.0) v=cx(nfft-i)
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
cxt(i)=0.5*cmplx(x,y)
enddo
else
cxt(0:nfft-1)=cx(0:nfft-1)
endif
if(nxpol.ne.0) then
if(iqapply.ne.0) then !Apply I/Q corrections
h=gainy*cmplx(cos(phasey),sin(phasey))
v=0.
do i=0,nfft-1
u=cy(i)
if(i.gt.0) v=cy(nfft-i)
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
cyt(i)=0.5*cmplx(x,y)
enddo
else
cyt(0:nfft-1)=cy(0:nfft-1)
endif
endif
! Identify frequencies with strong signals, copy frequency-domain
! data into array cs (strong) or cw (weak).
ntot=ntot+1
if(mod(ntot,128).eq.5) then
call pctile(s,stmp,1024,50,xmedian)
slimit=faclim*xmedian
endif
if(ntc.lt.96000/nfft) ntc=ntc+1
uu=1.0/ntc
smax=0.
do i=0,nfft-1
p=real(cxt(i))**2 + aimag(cxt(i))**2
if(nxpol.ne.0) p=p + real(cyt(i))**2 + aimag(cyt(i))**2
s(i)=(1.0-uu)*s(i) + uu*p
lstrong(i)=(s(i).gt.slimit)
if(s(i).gt.smax) smax=s(i)
enddo
nsigs=0
lprev=.false.
iwid=1
ib=-99
do i=0,nfft-1
if(lstrong(i) .and. (.not.lprev)) then
if(nsigs.lt.MAXSIGS) nsigs=nsigs+1
ia(nsigs)=i-iwid
if(ia(nsigs).lt.0) ia(nsigs)=0
endif
if(.not.lstrong(i) .and. lprev) then
ib(nsigs)=i-1+iwid
if(ib(nsigs).gt.nfft-1) ib(nsigs)=nfft-1
endif
lprev=lstrong(i)
enddo
if(nsigs.gt.0) then
do i=1,nsigs
ja=ia(i)
jb=ib(i)
if(ja.lt.0 .or. ja.gt.nfft-1 .or. jb.lt.0 .or. jb.gt.nfft-1) then
cycle
endif
if(jb.eq.-99) jb=ja + min(2*iwid,nfft-1)
lstrong(ja:jb)=.true.
enddo
endif
do i=0,nfft-1
if(lstrong(i)) then
cxs(i)=fac*cxt(i)
cxw(i)=0.
if(nxpol.ne.0) then
cys(i)=fac*cyt(i)
cyw(i)=0.
endif
else
cxw(i)=fac*cxt(i)
cxs(i)=0.
if(nxpol.ne.0) then
cyw(i)=fac*cyt(i)
cys(i)=0.
endif
endif
enddo
call four2a(cxw,nfft,1,-1,1) !Transform weak and strong X
call four2a(cxs,nfft,1,-1,1) !back to time domain, separately
if(nxpol.ne.0) then
call four2a(cyw,nfft,1,-1,1) !Transform weak and strong Y
call four2a(cys,nfft,1,-1,1) !back to time domain, separately
endif
if(nwindow.eq.2) then
cxw(0:nh-1)=cxw(0:nh-1)+covxw(0:nh-1) !Add previous segment's 2nd half
covxw(0:nh-1)=cxw(nh:nfft-1) !Save 2nd half
cxs(0:nh-1)=cxs(0:nh-1)+covxs(0:nh-1) !Ditto for strong signals
covxs(0:nh-1)=cxs(nh:nfft-1)
if(nxpol.ne.0) then
cyw(0:nh-1)=cyw(0:nh-1)+covyw(0:nh-1) !Add previous segment's 2nd half
covyw(0:nh-1)=cyw(nh:nfft-1) !Save 2nd half
cys(0:nh-1)=cys(0:nh-1)+covys(0:nh-1) !Ditto for strong signals
covys(0:nh-1)=cys(nh:nfft-1)
endif
endif
! Apply noise blanking to weak data
if(nb.ne.0) then
do i=0,kstep-1
peak=abs(cxw(i))
if(nxpol.ne.0) peak=max(peak,abs(cyw(i)))
if(peak.gt.peaklimit) then
cxw(i)=0.
if(nxpol.ne.0) cyw(i)=0.
nzap=nzap+1
endif
enddo
endif
! Compute power levels from weak data only
do i=0,kstep-1
px=px + real(cxw(i))**2 + aimag(cxw(i))**2
if(nxpol.ne.0) py=py + real(cyw(i))**2 + aimag(cyw(i))**2
enddo
cx1(0:kstep-1)=cxw(0:kstep-1) + cxs(0:kstep-1) !Recombine weak + strong
if(nxpol.ne.0) then
cy1(0:kstep-1)=cyw(0:kstep-1) + cys(0:kstep-1) !Weak + strong
endif
return
end subroutine timf2
subroutine timf2(nxpol,nfft,nwindow,nb,peaklimit,iqadjust,iqapply,faclim, &
cx0,cy0,gainx,gainy,phasex,phasey,cx1,cy1,slimit,lstrong,px,py,nzap)
! Sequential processing of time-domain I/Q data, using Linrad-like
! "first FFT" and "first backward FFT".
! cx0,cy0 - complex input data
! nfft - length of FFTs
! nwindow - 0 for no window, 2 for sin^2 window
! iqapply - 0/1 determines if I/Q phase and amplitude corrections applied
! gainx,y - gain error in Q channel, relative to I
! phasex,y - phase error
! cx1,cy1 - output data
! Non-windowed processing means no overlap, so kstep=nfft.
! Sin^2 window has 50% overlap, kstep=nfft/2.
! Frequencies with strong signals are identified and separated. The back
! transforms are done separately for weak and strong signals, so that
! noise blanking can be applied to the weak-signal portion. Strong and
! weak are finally re-combined in the time domain.
parameter (MAXFFT=1024,MAXNH=MAXFFT/2)
parameter (MAXSIGS=100)
complex cx0(0:nfft-1),cx1(0:nfft-1)
complex cy0(0:nfft-1),cy1(0:nfft-1)
complex cx(0:MAXFFT-1),cxt(0:MAXFFT-1)
complex cy(0:MAXFFT-1),cyt(0:MAXFFT-1)
complex cxs(0:MAXFFT-1),covxs(0:MAXNH-1) !Strong X signals
complex cys(0:MAXFFT-1),covys(0:MAXNH-1) !Strong Y signals
complex cxw(0:MAXFFT-1),covxw(0:MAXNH-1) !Weak X signals
complex cyw(0:MAXFFT-1),covyw(0:MAXNH-1) !Weak Y signals
real*4 w(0:MAXFFT-1)
real*4 s(0:MAXFFT-1),stmp(0:MAXFFT-1)
logical*1 lstrong(0:MAXFFT-1),lprev
integer ia(MAXSIGS),ib(MAXSIGS)
complex h,u,v
logical first
data first/.true./
save w,covxs,covxw,covys,covyw,s,ntc,ntot,nh,kstep,fac,first
if(first) then
pi=4.0*atan(1.0)
do i=0,nfft-1
w(i)=(sin(i*pi/nfft))**2
enddo
covxs=0.
covxw=0.
covys=0.
covyw=0.
s=0.
ntc=0
ntot=0
nh=nfft/2
kstep=nfft
if(nwindow.eq.2) kstep=nh
fac=1.0/nfft
slimit=1.e30
first=.false.
endif
cx(0:nfft-1)=cx0
if(nwindow.eq.2) cx(0:nfft-1)=w(0:nfft-1)*cx(0:nfft-1)
call four2a(cx,nfft,1,1,1) !First forward FFT
if(nxpol.ne.0) then
cy(0:nfft-1)=cy0
if(nwindow.eq.2) cy(0:nfft-1)=w(0:nfft-1)*cy(0:nfft-1)
call four2a(cy,nfft,1,1,1) !First forward FFT
endif
if(iqapply.ne.0) then !Apply I/Q corrections
h=gainx*cmplx(cos(phasex),sin(phasex))
v=0.
do i=0,nfft-1
u=cx(i)
if(i.gt.0) v=cx(nfft-i)
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
cxt(i)=0.5*cmplx(x,y)
enddo
else
cxt(0:nfft-1)=cx(0:nfft-1)
endif
if(nxpol.ne.0) then
if(iqapply.ne.0) then !Apply I/Q corrections
h=gainy*cmplx(cos(phasey),sin(phasey))
v=0.
do i=0,nfft-1
u=cy(i)
if(i.gt.0) v=cy(nfft-i)
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
(real(u) - real(v))*real(h)
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
(real(u) - real(v))*aimag(h)
cyt(i)=0.5*cmplx(x,y)
enddo
else
cyt(0:nfft-1)=cy(0:nfft-1)
endif
endif
! Identify frequencies with strong signals, copy frequency-domain
! data into array cs (strong) or cw (weak).
ntot=ntot+1
if(mod(ntot,128).eq.5) then
call pctile(s,stmp,1024,50,xmedian)
slimit=faclim*xmedian
endif
if(ntc.lt.96000/nfft) ntc=ntc+1
uu=1.0/ntc
smax=0.
do i=0,nfft-1
p=real(cxt(i))**2 + aimag(cxt(i))**2
if(nxpol.ne.0) p=p + real(cyt(i))**2 + aimag(cyt(i))**2
s(i)=(1.0-uu)*s(i) + uu*p
lstrong(i)=(s(i).gt.slimit)
if(s(i).gt.smax) smax=s(i)
enddo
nsigs=0
lprev=.false.
iwid=1
ib=-99
do i=0,nfft-1
if(lstrong(i) .and. (.not.lprev)) then
if(nsigs.lt.MAXSIGS) nsigs=nsigs+1
ia(nsigs)=i-iwid
if(ia(nsigs).lt.0) ia(nsigs)=0
endif
if(.not.lstrong(i) .and. lprev) then
ib(nsigs)=i-1+iwid
if(ib(nsigs).gt.nfft-1) ib(nsigs)=nfft-1
endif
lprev=lstrong(i)
enddo
if(nsigs.gt.0) then
do i=1,nsigs
ja=ia(i)
jb=ib(i)
if(ja.lt.0 .or. ja.gt.nfft-1 .or. jb.lt.0 .or. jb.gt.nfft-1) then
cycle
endif
if(jb.eq.-99) jb=ja + min(2*iwid,nfft-1)
lstrong(ja:jb)=.true.
enddo
endif
do i=0,nfft-1
if(lstrong(i)) then
cxs(i)=fac*cxt(i)
cxw(i)=0.
if(nxpol.ne.0) then
cys(i)=fac*cyt(i)
cyw(i)=0.
endif
else
cxw(i)=fac*cxt(i)
cxs(i)=0.
if(nxpol.ne.0) then
cyw(i)=fac*cyt(i)
cys(i)=0.
endif
endif
enddo
call four2a(cxw,nfft,1,-1,1) !Transform weak and strong X
call four2a(cxs,nfft,1,-1,1) !back to time domain, separately
if(nxpol.ne.0) then
call four2a(cyw,nfft,1,-1,1) !Transform weak and strong Y
call four2a(cys,nfft,1,-1,1) !back to time domain, separately
endif
if(nwindow.eq.2) then
cxw(0:nh-1)=cxw(0:nh-1)+covxw(0:nh-1) !Add previous segment's 2nd half
covxw(0:nh-1)=cxw(nh:nfft-1) !Save 2nd half
cxs(0:nh-1)=cxs(0:nh-1)+covxs(0:nh-1) !Ditto for strong signals
covxs(0:nh-1)=cxs(nh:nfft-1)
if(nxpol.ne.0) then
cyw(0:nh-1)=cyw(0:nh-1)+covyw(0:nh-1) !Add previous segment's 2nd half
covyw(0:nh-1)=cyw(nh:nfft-1) !Save 2nd half
cys(0:nh-1)=cys(0:nh-1)+covys(0:nh-1) !Ditto for strong signals
covys(0:nh-1)=cys(nh:nfft-1)
endif
endif
! Apply noise blanking to weak data
if(nb.ne.0) then
do i=0,kstep-1
peak=abs(cxw(i))
if(nxpol.ne.0) peak=max(peak,abs(cyw(i)))
if(peak.gt.peaklimit) then
cxw(i)=0.
if(nxpol.ne.0) cyw(i)=0.
nzap=nzap+1
endif
enddo
endif
! Compute power levels from weak data only
do i=0,kstep-1
px=px + real(cxw(i))**2 + aimag(cxw(i))**2
if(nxpol.ne.0) py=py + real(cyw(i))**2 + aimag(cyw(i))**2
enddo
cx1(0:kstep-1)=cxw(0:kstep-1) + cxs(0:kstep-1) !Recombine weak + strong
if(nxpol.ne.0) then
cy1(0:kstep-1)=cyw(0:kstep-1) + cys(0:kstep-1) !Weak + strong
endif
return
end subroutine timf2
libm65/tm2.f90
+14 -14
View File
@@ -1,14 +1,14 @@
subroutine tm2(day,xlat4,xlon4,xl4,b4)
implicit real*8 (a-h,o-z)
parameter (RADS=0.0174532925199433d0)
real*4 day4,xlat4,xlon4,xl4,b4
glat=xlat4*RADS
glong=xlon4*RADS
call tmoonsub(day,glat,glong,el,rv,xl,b,pax)
xl4=xl
b4=b
end subroutine tm2
subroutine tm2(day,xlat4,xlon4,xl4,b4)
implicit real*8 (a-h,o-z)
parameter (RADS=0.0174532925199433d0)
real*4 day4,xlat4,xlon4,xl4,b4
glat=xlat4*RADS
glong=xlon4*RADS
call tmoonsub(day,glat,glong,el,rv,xl,b,pax)
xl4=xl
b4=b
end subroutine tm2
libm65/tmoonsub.c
+514 -514
View File
File diff suppressed because it is too large Load Diff
libm65/toxyz.f
+25 -25
View File
@@ -1,25 +1,25 @@
subroutine toxyz(alpha,delta,r,vec)
implicit real*8 (a-h,o-z)
real*8 vec(3)
vec(1)=r*cos(delta)*cos(alpha)
vec(2)=r*cos(delta)*sin(alpha)
vec(3)=r*sin(delta)
return
end
subroutine fromxyz(vec,alpha,delta,r)
implicit real*8 (a-h,o-z)
real*8 vec(3)
data twopi/6.283185307d0/
r=sqrt(vec(1)**2 + vec(2)**2 + vec(3)**2)
alpha=atan2(vec(2),vec(1))
if(alpha.lt.0.d0) alpha=alpha+twopi
delta=asin(vec(3)/r)
return
end
subroutine toxyz(alpha,delta,r,vec)
implicit real*8 (a-h,o-z)
real*8 vec(3)
vec(1)=r*cos(delta)*cos(alpha)
vec(2)=r*cos(delta)*sin(alpha)
vec(3)=r*sin(delta)
return
end
subroutine fromxyz(vec,alpha,delta,r)
implicit real*8 (a-h,o-z)
real*8 vec(3)
data twopi/6.283185307d0/
r=sqrt(vec(1)**2 + vec(2)**2 + vec(3)**2)
alpha=atan2(vec(2),vec(1))
if(alpha.lt.0.d0) alpha=alpha+twopi
delta=asin(vec(3)/r)
return
end
libm65/trimlist.f
+28 -28
View File
@@ -1,28 +1,28 @@
subroutine trimlist(sig,km,ftol,indx,nsiz,nz)
parameter (MAXMSG=1000) !Size of decoded message list
real sig(MAXMSG,30)
integer indx(MAXMSG),nsiz(MAXMSG)
C 1 2 3 4 5 6 7 8
C nfile nutc freq snr dt ipol flip sync
call indexx(km,sig(1,3),indx) !Sort list by frequency
n=1
i0=1
do i=2,km
j0=indx(i-1)
j=indx(i)
if(sig(j,3)-sig(j0,3).gt.ftol) then
nsiz(n)=i-i0
i0=i
n=n+1
endif
enddo
nz=n
nsiz(nz)=km+1-i0
nsiz(nz+1)=-1
return
end
subroutine trimlist(sig,km,ftol,indx,nsiz,nz)
parameter (MAXMSG=1000) !Size of decoded message list
real sig(MAXMSG,30)
integer indx(MAXMSG),nsiz(MAXMSG)
C 1 2 3 4 5 6 7 8
C nfile nutc freq snr dt ipol flip sync
call indexx(km,sig(1,3),indx) !Sort list by frequency
n=1
i0=1
do i=2,km
j0=indx(i-1)
j=indx(i)
if(sig(j,3)-sig(j0,3).gt.ftol) then
nsiz(n)=i-i0
i0=i
n=n+1
endif
enddo
nz=n
nsiz(nz)=km+1-i0
nsiz(nz+1)=-1
return
end
libm65/twkfreq.f
+29 -29
View File
@@ -1,29 +1,29 @@
subroutine twkfreq(c4aa,c4bb,n5,a)
complex c4aa(n5)
complex c4bb(n5)
real a(5)
complex w,wstep
data twopi/6.283185307/
C Apply AFC corrections to the c4aa and c4bb data
w=1.0
wstep=1.0
x0=0.5*(n5+1)
s=2.0/n5
do i=1,n5
x=s*(i-x0)
if(mod(i,1000).eq.1) then
p2=1.5*x*x - 0.5
! p3=2.5*(x**3) - 1.5*x
! p4=4.375*(x**4) - 3.75*(x**2) + 0.375
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/1378.125)
wstep=cmplx(cos(dphi),sin(dphi))
endif
w=w*wstep
c4aa(i)=w*c4aa(i)
c4bb(i)=w*c4bb(i)
enddo
return
end
subroutine twkfreq(c4aa,c4bb,n5,a)
complex c4aa(n5)
complex c4bb(n5)
real a(5)
complex w,wstep
data twopi/6.283185307/
C Apply AFC corrections to the c4aa and c4bb data
w=1.0
wstep=1.0
x0=0.5*(n5+1)
s=2.0/n5
do i=1,n5
x=s*(i-x0)
if(mod(i,1000).eq.1) then
p2=1.5*x*x - 0.5
! p3=2.5*(x**3) - 1.5*x
! p4=4.375*(x**4) - 3.75*(x**2) + 0.375
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/1378.125)
wstep=cmplx(cos(dphi),sin(dphi))
endif
w=w*wstep
c4aa(i)=w*c4aa(i)
c4bb(i)=w*c4bb(i)
enddo
return
end

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