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

Merge branch 'master' of ../map65 into feat-map65-integration

Browse Source
This commit is contained in:
Bill Somerville 2021-04-09 14:00:10 +01:00
commit 96e8908866
No known key found for this signature in database
GPG Key ID: D864B06D1E81618F
243 changed files with 39167 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lib/encode_rs.c
View File

@ -13,24 +13,19 @@
#endif #endif
void ENCODE_RS( void ENCODE_RS(
#ifdef FIXED #ifndef FIXED
DTYPE *data, DTYPE *bb,int pad){ void *p,
#else #endif
void *p,DTYPE *data, DTYPE *bb){ DTYPE *data, DTYPE *bb){
#ifndef FIXED
struct rs *rs = (struct rs *)p; struct rs *rs = (struct rs *)p;
#endif #endif
int i, j; int i, j;
DTYPE feedback; DTYPE feedback;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return;
#endif
memset(bb,0,NROOTS*sizeof(DTYPE)); memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS-PAD;i++){ for(i=0;i<NN-NROOTS;i++){
feedback = INDEX_OF[data[i] ^ bb[0]]; feedback = INDEX_OF[data[i] ^ bb[0]];
if(feedback != A0){ /* feedback term is non-zero */ if(feedback != A0){ /* feedback term is non-zero */
#ifdef UNNORMALIZED #ifdef UNNORMALIZED

0
lib/ft2/portaudio.h Normal file → Executable file
View File

18
lib/init_rs.c
View File

@ -28,30 +28,30 @@ void FREE_RS(void *p){
* fcr = first root of RS code generator polynomial, index form * fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots * prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of 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, void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned fcr,unsigned prim,
int nroots,int pad){ unsigned int nroots){
struct rs *rs; struct rs *rs;
int i, j, sr,root,iprim; int i, j, sr,root,iprim;
<<<<<<< HEAD:lib/init_rs.c
/* Check parameter ranges */ /* Check parameter ranges */
if(symsize < 0 || symsize > (int)(8*sizeof(DTYPE))) if(symsize < 0 || symsize > (int)(8*sizeof(DTYPE)))
=======
if(symsize > 8*sizeof(DTYPE))
>>>>>>> 280c8344cd80339491e9bad1dcc4ac9a1e5f684e:map65/libm65/init_rs.c
return NULL; /* Need version with ints rather than chars */ return NULL; /* Need version with ints rather than chars */
if(fcr < 0 || fcr >= (1<<symsize)) if(fcr >= (1<<symsize))
return NULL; return NULL;
if(prim <= 0 || prim >= (1<<symsize)) if(prim == 0 || prim >= (1<<symsize))
return NULL; return NULL;
if(nroots < 0 || nroots >= (1<<symsize)) if(nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */ 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 = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize; rs->mm = symsize;
rs->nn = (1<<symsize)-1; rs->nn = (1<<symsize)-1;
rs->pad = pad;
rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1)); rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->alpha_to == NULL){ if(rs->alpha_to == NULL){

1
map65/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
~*

165
map65/CMakeLists.txt Normal file
View File

@ -0,0 +1,165 @@
cmake_minimum_required (VERSION 2.8.9)
project (map65 C CXX Fortran)
set (MAP65_VERSION_MAJOR 1)
set (MAP65_VERSION_MINOR 3)
if (POLICY CMP0020)
cmake_policy (SET CMP0020 NEW) # link to Qt winmain on Windows
endif (POLICY CMP0020)
# make sure that the default is a RELEASE
if (NOT CMAKE_BUILD_TYPE)
set (CMAKE_BUILD_TYPE RELEASE CACHE STRING
"Choose the type of build, options are: None Debug Release."
FORCE)
endif (NOT CMAKE_BUILD_TYPE)
# C++ setup
set (CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wall")
set (CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wall")
set (CXXSRCS
about.cpp
astro.cpp
bandmap.cpp
devsetup.cpp
displaytext.cpp
getdev.cpp
getfile.cpp
main.cpp
mainwindow.cpp
messages.cpp
meterwidget.cpp
plotter.cpp
set570.cpp
signalmeter.cpp
soundin.cpp
soundout.cpp
txtune.cpp
widegraph.cpp
)
if (WIN32)
set (CXXSRCS ${CXXSRCS} killbyname.cpp)
endif (WIN32)
set (CSRCS
paInputDevice.c
pa_get_device_info.c
)
set_property (SOURCE ${CXXSRCS} ${CSRCS} APPEND PROPERTY COMPILE_FLAGS "-include map65_config.h")
set (UISRCS
about.ui
astro.ui
bandmap.ui
devsetup.ui
mainwindow.ui
messages.ui
txtune.ui
widegraph.ui
)
# sort out pre-requisites
# libfftw3 setup
find_path (fftw3f_INCLUDES fftw3.f)
find_library (fftw3f_LIBRARIES NAMES fftw3f fftw3f-3)
include_directories (${fftw3f_INCLUDES})
if (WIN32)
find_library (usb_RUNTIME NAMES usb0 PATH_SUFFIXES bin)
set (CMAKE_INSTALL_PREFIX C:/MAP65)
endif (WIN32)
# Qt5 setup
# Widgets finds its own dependencies.
find_package (Qt5Widgets REQUIRED)
find_package (Qt5Multimedia REQUIRED)
# Tell CMake to run moc when necessary
set (CMAKE_AUTOMOC ON)
# don't use Qt "keywords" signal, slot, emit in generated files to
# avoid compatability issue with other libraries
#ADD_DEFINITIONS (-DQT_NO_KEYWORDS)
# As moc files are generated in the binary dir, tell CMake to always
# look for includes there:
set (CMAKE_INCLUDE_CURRENT_DIR ON)
# project definitions
add_definitions (-DQT5)
if (CMAKE_HOST_UNIX)
add_definitions (-DUNIX)
elseif (CMAKE_HOST_WIN32)
add_definitions (-DWIN32)
endif ()
#set_property (DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS_RELEASE QT_NO_DEBUG_OUTPUT QT_NO_WARNING_OUTPUT)
set_property (DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS_RELEASE QT_NO_WARNING_OUTPUT)
# build the subdirectories
add_subdirectory (libm65)
# UI generation
qt5_wrap_ui (GENUISRCS ${UISRCS})
add_executable (map65 ${CXXSRCS} ${CSRCS} ${GENUISRCS} map65.rc)
target_link_libraries (map65 m65impl ${fftw3f_LIBRARIES} ${CMAKE_CURRENT_SOURCE_DIR}/palir-02.dll ${CMAKE_CURRENT_SOURCE_DIR}/libusb0.dll ${CMAKE_CURRENT_SOURCE_DIR}/libwsock32.a)
if (WIN32)
target_link_libraries (map65)
# set_target_properties (map65 PROPERTIES LINK_FLAGS_RELEASE "${LINKER_FLAGS_RELEASE} ")
set_target_properties (map65 PROPERTIES LINK_FLAGS_RELEASE "${LINKER_FLAGS_RELEASE} -mwindows")
endif (WIN32)
qt5_use_modules (map65 Widgets Multimedia OpenGL)
install (
TARGETS map65
RUNTIME DESTINATION bin
LIBRARY DESTINATION lib
)
# install (DIRECTORY Palettes DESTINATION bin PATTERN *.pal)
# install (DIRECTORY samples DESTINATION bin/save)
install (FILES
# CALL3.TXT
# prefixes.txt
DESTINATION bin
)
if (WIN32)
install (
FILES ${fftw3f_LIBRARIES} ${usb_RUNTIME}
DESTINATION bin COMPONENT Runtime
)
endif (WIN32)
# a custom target that is always built
ADD_CUSTOM_TARGET (revisiontag ALL)
# creates svnversion.h using cmake script
ADD_CUSTOM_COMMAND (TARGET revisiontag COMMAND ${CMAKE_COMMAND}
-DSOURCE_DIR=${CMAKE_CURRENT_SOURCE_DIR}
-P ${CMAKE_CURRENT_SOURCE_DIR}/getsvn.cmake)
# explicitly say that the executable depends on custom target
add_dependencies(map65 revisiontag)
# versioning
configure_file (
"${PROJECT_SOURCE_DIR}/map65_config.h.in"
"${PROJECT_BINARY_DIR}/map65_config.h"
)
include_directories ("${PROJECT_BINARY_DIR}")

30
map65/LICENSE_WHEATLEY.TXT Normal file
View File

@ -0,0 +1,30 @@
+ + + This Software is released under the "Simplified BSD License" + + +
Copyright 2010 Moe Wheatley. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution.
THIS SOFTWARE IS PROVIDED BY Moe Wheatley ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL Moe Wheatley OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
The views and conclusions contained in the software and documentation
are those of the authors and should not be interpreted as representing
official policies, either expressed or implied, of Moe Wheatley.

BIN
map65/MAP65_Beta_Release.docx Normal file
View File

Binary file not shown.

23
map65/about.cpp Normal file
View File

@ -0,0 +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-2021 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;
}

24
map65/about.h Normal file
View File

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

41
map65/about.ui Normal file
View File

@ -0,0 +1,41 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>CAboutDlg</class>
<widget class="QDialog" name="CAboutDlg">
<property name="windowModality">
<enum>Qt::NonModal</enum>
</property>
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>374</width>
<height>164</height>
</rect>
</property>
<property name="sizePolicy">
<sizepolicy hsizetype="Preferred" vsizetype="Preferred">
<horstretch>0</horstretch>
<verstretch>0</verstretch>
</sizepolicy>
</property>
<property name="windowTitle">
<string>About MAP65</string>
</property>
<widget class="QLabel" name="labelTxt">
<property name="geometry">
<rect>
<x>20</x>
<y>10</y>
<width>331</width>
<height>131</height>
</rect>
</property>
<property name="text">
<string/>
</property>
</widget>
</widget>
<resources/>
<connections/>
</ui>

257
map65/afmhot.dat Normal file
View File

@ -0,0 +1,257 @@
0 0.0000 0.0000 0.0000
1 0.0000 0.0000 0.0000
2 0.0078 0.0000 0.0000
3 0.0157 0.0000 0.0000
4 0.0235 0.0000 0.0000
5 0.0314 0.0000 0.0000
6 0.0392 0.0000 0.0000
7 0.0471 0.0000 0.0000
8 0.0549 0.0000 0.0000
9 0.0627 0.0000 0.0000
10 0.0706 0.0000 0.0000
11 0.0784 0.0000 0.0000
12 0.0863 0.0000 0.0000
13 0.0941 0.0000 0.0000
14 0.1020 0.0000 0.0000
15 0.1098 0.0000 0.0000
16 0.1176 0.0000 0.0000
17 0.1255 0.0000 0.0000
18 0.1333 0.0000 0.0000
19 0.1412 0.0000 0.0000
20 0.1490 0.0000 0.0000
21 0.1569 0.0000 0.0000
22 0.1647 0.0000 0.0000
23 0.1725 0.0000 0.0000
24 0.1804 0.0000 0.0000
25 0.1882 0.0000 0.0000
26 0.1961 0.0000 0.0000
27 0.2039 0.0000 0.0000
28 0.2118 0.0000 0.0000
29 0.2196 0.0000 0.0000
30 0.2275 0.0000 0.0000
31 0.2353 0.0000 0.0000
32 0.2431 0.0000 0.0000
33 0.2510 0.0000 0.0000
34 0.2588 0.0000 0.0000
35 0.2667 0.0000 0.0000
36 0.2745 0.0000 0.0000
37 0.2824 0.0000 0.0000
38 0.2902 0.0000 0.0000
39 0.2980 0.0000 0.0000
40 0.3059 0.0000 0.0000
41 0.3137 0.0000 0.0000
42 0.3216 0.0000 0.0000
43 0.3294 0.0000 0.0000
44 0.3373 0.0000 0.0000
45 0.3451 0.0000 0.0000
46 0.3529 0.0000 0.0000
47 0.3608 0.0000 0.0000
48 0.3686 0.0000 0.0000
49 0.3765 0.0000 0.0000
50 0.3843 0.0000 0.0000
51 0.3922 0.0000 0.0000
52 0.4000 0.0000 0.0000
53 0.4078 0.0000 0.0000
54 0.4157 0.0000 0.0000
55 0.4235 0.0000 0.0000
56 0.4314 0.0000 0.0000
57 0.4392 0.0000 0.0000
58 0.4471 0.0000 0.0000
59 0.4549 0.0000 0.0000
60 0.4627 0.0000 0.0000
61 0.4706 0.0000 0.0000
62 0.4784 0.0000 0.0000
63 0.4863 0.0000 0.0000
64 0.4941 0.0000 0.0000
65 0.5020 0.0000 0.0000
66 0.5098 0.0098 0.0000
67 0.5176 0.0176 0.0000
68 0.5255 0.0255 0.0000
69 0.5333 0.0333 0.0000
70 0.5412 0.0412 0.0000
71 0.5490 0.0490 0.0000
72 0.5569 0.0569 0.0000
73 0.5647 0.0647 0.0000
74 0.5725 0.0725 0.0000
75 0.5804 0.0804 0.0000
76 0.5882 0.0882 0.0000
77 0.5961 0.0961 0.0000
78 0.6039 0.1039 0.0000
79 0.6118 0.1118 0.0000
80 0.6196 0.1196 0.0000
81 0.6275 0.1275 0.0000
82 0.6353 0.1353 0.0000
83 0.6431 0.1431 0.0000
84 0.6510 0.1510 0.0000
85 0.6588 0.1588 0.0000
86 0.6667 0.1667 0.0000
87 0.6745 0.1745 0.0000
88 0.6824 0.1824 0.0000
89 0.6902 0.1902 0.0000
90 0.6980 0.1980 0.0000
91 0.7059 0.2059 0.0000
92 0.7137 0.2137 0.0000
93 0.7216 0.2216 0.0000
94 0.7294 0.2294 0.0000
95 0.7373 0.2373 0.0000
96 0.7451 0.2451 0.0000
97 0.7529 0.2529 0.0000
98 0.7608 0.2608 0.0000
99 0.7686 0.2686 0.0000
100 0.7765 0.2765 0.0000
101 0.7843 0.2843 0.0000
102 0.7922 0.2922 0.0000
103 0.8000 0.3000 0.0000
104 0.8078 0.3078 0.0000
105 0.8157 0.3157 0.0000
106 0.8235 0.3235 0.0000
107 0.8314 0.3314 0.0000
108 0.8392 0.3392 0.0000
109 0.8471 0.3471 0.0000
110 0.8549 0.3549 0.0000
111 0.8627 0.3627 0.0000
112 0.8706 0.3706 0.0000
113 0.8784 0.3784 0.0000
114 0.8863 0.3863 0.0000
115 0.8941 0.3941 0.0000
116 0.9020 0.4020 0.0000
117 0.9098 0.4098 0.0000
118 0.9176 0.4176 0.0000
119 0.9255 0.4255 0.0000
120 0.9333 0.4333 0.0000
121 0.9412 0.4412 0.0000
122 0.9490 0.4490 0.0000
123 0.9569 0.4569 0.0000
124 0.9647 0.4647 0.0000
125 0.9725 0.4725 0.0000
126 0.9804 0.4804 0.0000
127 0.9882 0.4882 0.0000
128 0.9961 0.4961 0.0000
129 1.0000 0.5039 0.0000
130 1.0000 0.5118 0.0118
131 1.0000 0.5196 0.0196
132 1.0000 0.5275 0.0275
133 1.0000 0.5353 0.0353
134 1.0000 0.5431 0.0431
135 1.0000 0.5510 0.0510
136 1.0000 0.5588 0.0588
137 1.0000 0.5667 0.0667
138 1.0000 0.5745 0.0745
139 1.0000 0.5824 0.0824
140 1.0000 0.5902 0.0902
141 1.0000 0.5980 0.0980
142 1.0000 0.6059 0.1059
143 1.0000 0.6137 0.1137
144 1.0000 0.6216 0.1216
145 1.0000 0.6294 0.1294
146 1.0000 0.6373 0.1373
147 1.0000 0.6451 0.1451
148 1.0000 0.6529 0.1529
149 1.0000 0.6608 0.1608
150 1.0000 0.6686 0.1686
151 1.0000 0.6765 0.1765
152 1.0000 0.6843 0.1843
153 1.0000 0.6922 0.1922
154 1.0000 0.7000 0.2000
155 1.0000 0.7078 0.2078
156 1.0000 0.7157 0.2157
157 1.0000 0.7235 0.2235
158 1.0000 0.7314 0.2314
159 1.0000 0.7392 0.2392
160 1.0000 0.7471 0.2471
161 1.0000 0.7549 0.2549
162 1.0000 0.7627 0.2627
163 1.0000 0.7706 0.2706
164 1.0000 0.7784 0.2784
165 1.0000 0.7863 0.2863
166 1.0000 0.7941 0.2941
167 1.0000 0.8020 0.3020
168 1.0000 0.8098 0.3098
169 1.0000 0.8176 0.3176
170 1.0000 0.8255 0.3255
171 1.0000 0.8333 0.3333
172 1.0000 0.8412 0.3412
173 1.0000 0.8490 0.3490
174 1.0000 0.8569 0.3569
175 1.0000 0.8647 0.3647
176 1.0000 0.8725 0.3725
177 1.0000 0.8804 0.3804
178 1.0000 0.8882 0.3882
179 1.0000 0.8961 0.3961
180 1.0000 0.9039 0.4039
181 1.0000 0.9118 0.4118
182 1.0000 0.9196 0.4196
183 1.0000 0.9275 0.4275
184 1.0000 0.9353 0.4353
185 1.0000 0.9431 0.4431
186 1.0000 0.9510 0.4510
187 1.0000 0.9588 0.4588
188 1.0000 0.9667 0.4667
189 1.0000 0.9745 0.4745
190 1.0000 0.9824 0.4824
191 1.0000 0.9902 0.4902
192 1.0000 0.9980 0.4980
193 1.0000 1.0000 0.5059
194 1.0000 1.0000 0.5137
195 1.0000 1.0000 0.5216
196 1.0000 1.0000 0.5294
197 1.0000 1.0000 0.5373
198 1.0000 1.0000 0.5451
199 1.0000 1.0000 0.5529
200 1.0000 1.0000 0.5608
201 1.0000 1.0000 0.5686
202 1.0000 1.0000 0.5765
203 1.0000 1.0000 0.5843
204 1.0000 1.0000 0.5922
205 1.0000 1.0000 0.6000
206 1.0000 1.0000 0.6078
207 1.0000 1.0000 0.6157
208 1.0000 1.0000 0.6235
209 1.0000 1.0000 0.6314
210 1.0000 1.0000 0.6392
211 1.0000 1.0000 0.6471
212 1.0000 1.0000 0.6549
213 1.0000 1.0000 0.6627
214 1.0000 1.0000 0.6706
215 1.0000 1.0000 0.6784
216 1.0000 1.0000 0.6863
217 1.0000 1.0000 0.6941
218 1.0000 1.0000 0.7020
219 1.0000 1.0000 0.7098
220 1.0000 1.0000 0.7176
221 1.0000 1.0000 0.7255
222 1.0000 1.0000 0.7333
223 1.0000 1.0000 0.7412
224 1.0000 1.0000 0.7490
225 1.0000 1.0000 0.7569
226 1.0000 1.0000 0.7647
227 1.0000 1.0000 0.7725
228 1.0000 1.0000 0.7804
229 1.0000 1.0000 0.7882
230 1.0000 1.0000 0.7961
231 1.0000 1.0000 0.8039
232 1.0000 1.0000 0.8118
233 1.0000 1.0000 0.8196
234 1.0000 1.0000 0.8275
235 1.0000 1.0000 0.8353
236 1.0000 1.0000 0.8431
237 1.0000 1.0000 0.8510
238 1.0000 1.0000 0.8588
239 1.0000 1.0000 0.8667
240 1.0000 1.0000 0.8745
241 1.0000 1.0000 0.8824
242 1.0000 1.0000 0.8902
243 1.0000 1.0000 0.8980
244 1.0000 1.0000 0.9059
245 1.0000 1.0000 0.9137
246 1.0000 1.0000 0.9216
247 1.0000 1.0000 0.9294
248 1.0000 1.0000 0.9373
249 1.0000 1.0000 0.9451
250 1.0000 1.0000 0.9529
251 1.0000 1.0000 0.9608
252 1.0000 1.0000 0.9686
253 1.0000 1.0000 0.9765
254 1.0 0.0 0.0
255 1.0 1.0 0.0
256 0.0 1.000 0.0

106
map65/astro.cpp Normal file
View File

@ -0,0 +1,106 @@
#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();
m_AzElDir0="";
}
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.toLatin1(),
hisgrid.toLatin1(), &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"
"MyDop: %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)) {
if(azelDir==m_AzElDir0) return;
m_AzElDir0=azelDir;
QMessageBox mb;
mb.setText("Cannot open " + fname + "\nCorrect the setting of AzEl Directory in Setup?");
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);
}

36
map65/astro.h Normal file
View File

@ -0,0 +1,36 @@
#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;
QString m_AzElDir0;
};
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

37
map65/astro.ui Normal file
View File

@ -0,0 +1,37 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>Astro</class>
<widget class="QWidget" name="Astro">
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>262</width>
<height>483</height>
</rect>
</property>
<property name="windowTitle">
<string>Form</string>
</property>
<widget class="QTextBrowser" name="astroTextBrowser">
<property name="geometry">
<rect>
<x>0</x>
<y>10</y>
<width>256</width>
<height>451</height>
</rect>
</property>
<property name="font">
<font>
<family>Courier New</family>
<pointsize>20</pointsize>
<weight>75</weight>
<bold>true</bold>
</font>
</property>
</widget>
</widget>
<resources/>
<connections/>
</ui>

89
map65/bandmap.cpp Normal file
View File

@ -0,0 +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);
}

34
map65/bandmap.h Normal file
View File

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

43
map65/bandmap.ui Normal file
View File

@ -0,0 +1,43 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>BandMap</class>
<widget class="QWidget" name="BandMap">
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>329</width>
<height>379</height>
</rect>
</property>
<property name="minimumSize">
<size>
<width>0</width>
<height>0</height>
</size>
</property>
<property name="windowTitle">
<string>Form</string>
</property>
<layout class="QGridLayout" name="gridLayout">
<item row="0" column="0">
<widget class="QTextBrowser" name="bmTextBrowser">
<property name="minimumSize">
<size>
<width>107</width>
<height>0</height>
</size>
</property>
<property name="font">
<font>
<family>Courier New</family>
<pointsize>9</pointsize>
</font>
</property>
</widget>
</item>
</layout>
</widget>
<resources/>
<connections/>
</ui>

256
map65/blue.dat Normal file
View File

@ -0,0 +1,256 @@
0 0.0000 0.0000 0.0000
1 0.0902 0.0902 0.2558
2 0.1176 0.1176 0.2694
3 0.1412 0.1412 0.2820
4 0.1569 0.1569 0.2938
5 0.1725 0.1725 0.3049
6 0.1843 0.1843 0.3154
7 0.1961 0.1961 0.3254
8 0.2039 0.2039 0.3349
9 0.2157 0.2157 0.3440
10 0.2235 0.2235 0.3528
11 0.2314 0.2314 0.3612
12 0.2392 0.2392 0.3693
13 0.2471 0.2471 0.3772
14 0.2549 0.2549 0.3848
15 0.2588 0.2588 0.3921
16 0.2667 0.2667 0.3992
17 0.2706 0.2706 0.4061
18 0.2784 0.2784 0.4129
19 0.2824 0.2824 0.4194
20 0.2902 0.2902 0.4258
21 0.2941 0.2941 0.4319
22 0.2980 0.2980 0.4380
23 0.3059 0.3059 0.4439
24 0.3098 0.3098 0.4496
25 0.3137 0.3137 0.4553
26 0.3176 0.3176 0.4608
27 0.3216 0.3216 0.4661
28 0.3294 0.3294 0.4714
29 0.3333 0.3333 0.4765
30 0.3373 0.3373 0.4815
31 0.3412 0.3412 0.4865
32 0.3451 0.3451 0.4913
33 0.3490 0.3490 0.4960
34 0.3529 0.3529 0.5006
35 0.3569 0.3569 0.5052
36 0.3608 0.3608 0.5096
37 0.3647 0.3647 0.5140
38 0.3686 0.3686 0.5183
39 0.3725 0.3725 0.5225
40 0.3765 0.3765 0.5266
41 0.3804 0.3804 0.5306
42 0.3843 0.3843 0.5346
43 0.3843 0.3843 0.5385
44 0.3882 0.3882 0.5423
45 0.3922 0.3922 0.5460
46 0.3961 0.3961 0.5497
47 0.4000 0.4000 0.5533
48 0.4039 0.4039 0.5569
49 0.4078 0.4078 0.5603
50 0.4118 0.4118 0.5638
51 0.4118 0.4118 0.5671
52 0.4157 0.4157 0.5704
53 0.4196 0.4196 0.5736
54 0.4235 0.4235 0.5768
55 0.4275 0.4275 0.5799
56 0.4314 0.4314 0.5829
57 0.4314 0.4314 0.5859
58 0.4353 0.4353 0.5889
59 0.4392 0.4392 0.5917
60 0.4431 0.4431 0.5946
61 0.4471 0.4471 0.5973
62 0.4471 0.4471 0.6001
63 0.4510 0.4510 0.6027
64 0.4549 0.4549 0.6053
65 0.4588 0.4588 0.6079
66 0.4627 0.4627 0.6104
67 0.4627 0.4627 0.6129
68 0.4667 0.4667 0.6153
69 0.4706 0.4706 0.6176
70 0.4745 0.4745 0.6199
71 0.4745 0.4745 0.6222
72 0.4784 0.4784 0.6244
73 0.4824 0.4824 0.6266
74 0.4863 0.4863 0.6287
75 0.4863 0.4863 0.6308
76 0.4902 0.4902 0.6328
77 0.4941 0.4941 0.6348
78 0.4980 0.4980 0.6367
79 0.5020 0.5020 0.6386
80 0.5020 0.5020 0.6404
81 0.5059 0.5059 0.6422
82 0.5098 0.5098 0.6440
83 0.5098 0.5098 0.6457
84 0.5137 0.5137 0.6474
85 0.5176 0.5176 0.6490
86 0.5216 0.5216 0.6506
87 0.5216 0.5216 0.6521
88 0.5255 0.5255 0.6536
89 0.5294 0.5294 0.6551
90 0.5333 0.5333 0.6565
91 0.5333 0.5333 0.6578
92 0.5373 0.5373 0.6591
93 0.5412 0.5412 0.6604
94 0.5451 0.5451 0.6617
95 0.5451 0.5451 0.6629
96 0.5490 0.5490 0.6640
97 0.5529 0.5529 0.6651
98 0.5569 0.5569 0.6662
99 0.5569 0.5569 0.6672
100 0.5608 0.5608 0.6682
101 0.5647 0.5647 0.6692
102 0.5647 0.5647 0.6701
103 0.5686 0.5686 0.6710
104 0.5725 0.5725 0.6718
105 0.5765 0.5765 0.6726
106 0.5765 0.5765 0.6733
107 0.5804 0.5804 0.6740
108 0.5843 0.5843 0.6747
109 0.5843 0.5843 0.6753
110 0.5882 0.5882 0.6759
111 0.5922 0.5922 0.6765
112 0.5961 0.5961 0.6770
113 0.5961 0.5961 0.6774
114 0.6000 0.6000 0.6779
115 0.6039 0.6039 0.6783
116 0.6039 0.6039 0.6786
117 0.6078 0.6078 0.6789
118 0.6118 0.6118 0.6792
119 0.6157 0.6157 0.6794
120 0.6157 0.6157 0.6796
121 0.6196 0.6196 0.6798
122 0.6235 0.6235 0.6799
123 0.6235 0.6235 0.6800
124 0.6275 0.6275 0.6800
125 0.6314 0.6314 0.6800
126 0.6353 0.6353 0.6799
127 0.6353 0.6353 0.6799
128 0.6392 0.6392 0.6797
129 0.6431 0.6431 0.6796
130 0.6431 0.6431 0.6794
131 0.6471 0.6471 0.6791
132 0.6510 0.6510 0.6789
133 0.6549 0.6549 0.6785
134 0.6549 0.6549 0.6782
135 0.6588 0.6588 0.6778
136 0.6627 0.6627 0.6773
137 0.6627 0.6627 0.6769
138 0.6667 0.6667 0.6763
139 0.6706 0.6706 0.6758
140 0.6745 0.6745 0.6752
141 0.6745 0.6745 0.6746
142 0.6784 0.6784 0.6739
143 0.6824 0.6824 0.6732
144 0.6824 0.6824 0.6724
145 0.6863 0.6863 0.6716
146 0.6902 0.6902 0.6708
147 0.6941 0.6941 0.6699
148 0.6941 0.6941 0.6690
149 0.6980 0.6980 0.6680
150 0.7020 0.7020 0.6670
151 0.7020 0.7020 0.6660
152 0.7059 0.7059 0.6649
153 0.7098 0.7098 0.6638
154 0.7098 0.7098 0.6626
155 0.7137 0.7137 0.6614
156 0.7176 0.7176 0.6601
157 0.7216 0.7216 0.6589
158 0.7216 0.7216 0.6575
159 0.7255 0.7255 0.6561
160 0.7294 0.7294 0.6547
161 0.7294 0.7294 0.6533
162 0.7333 0.7333 0.6518
163 0.7373 0.7373 0.6502
164 0.7412 0.7412 0.6486
165 0.7412 0.7412 0.6470
166 0.7451 0.7451 0.6453
167 0.7490 0.7490 0.6436
168 0.7490 0.7490 0.6418
169 0.7529 0.7529 0.6400
170 0.7569 0.7569 0.6382
171 0.7608 0.7608 0.6363
172 0.7608 0.7608 0.6343
173 0.7647 0.7647 0.6324
174 0.7686 0.7686 0.6303
175 0.7686 0.7686 0.6282
176 0.7725 0.7725 0.6261
177 0.7765 0.7765 0.6239
178 0.7804 0.7804 0.6217
179 0.7804 0.7804 0.6194
180 0.7843 0.7843 0.6171
181 0.7882 0.7882 0.6147
182 0.7882 0.7882 0.6123
183 0.7922 0.7922 0.6098
184 0.7961 0.7961 0.6073
185 0.8000 0.8000 0.6047
186 0.8000 0.8000 0.6021
187 0.8039 0.8039 0.5994
188 0.8078 0.8078 0.5967
189 0.8078 0.8078 0.5939
190 0.8118 0.8118 0.5911
191 0.8157 0.8157 0.5882
192 0.8196 0.8196 0.5853
193 0.8196 0.8196 0.5823
194 0.8235 0.8235 0.5792
195 0.8275 0.8275 0.5761
196 0.8275 0.8275 0.5729
197 0.8314 0.8314 0.5697
198 0.8353 0.8353 0.5664
199 0.8392 0.8392 0.5630
200 0.8392 0.8392 0.5596
201 0.8431 0.8431 0.5561
202 0.8471 0.8471 0.5525
203 0.8471 0.8471 0.5489
204 0.8510 0.8510 0.5452
205 0.8549 0.8549 0.5414
206 0.8588 0.8588 0.5376
207 0.8588 0.8588 0.5337
208 0.8627 0.8627 0.5297
209 0.8667 0.8667 0.5257
210 0.8667 0.8667 0.5215
211 0.8706 0.8706 0.5173
212 0.8745 0.8745 0.5130
213 0.8784 0.8784 0.5086
214 0.8784 0.8784 0.5042
215 0.8824 0.8824 0.4996
216 0.8863 0.8863 0.4950
217 0.8863 0.8863 0.4902
218 0.8902 0.8902 0.4854
219 0.8941 0.8941 0.4804
220 0.8980 0.8980 0.4754
221 0.8980 0.8980 0.4702
222 0.9020 0.9020 0.4649
223 0.9059 0.9059 0.4595
224 0.9098 0.9098 0.4540
225 0.9098 0.9098 0.4484
226 0.9137 0.9137 0.4426
227 0.9176 0.9176 0.4366
228 0.9176 0.9176 0.4306
229 0.9216 0.9216 0.4243
230 0.9255 0.9255 0.4179
231 0.9294 0.9294 0.4114
232 0.9294 0.9294 0.4046
233 0.9333 0.9333 0.3977
234 0.9373 0.9373 0.3905
235 0.9373 0.9373 0.3831
236 0.9412 0.9412 0.3754
237 0.9451 0.9451 0.3675
238 0.9490 0.9490 0.3594
239 0.9490 0.9490 0.3509
240 0.9529 0.9529 0.3420
241 0.9569 0.9569 0.3328
242 0.9608 0.9608 0.3232
243 0.9608 0.9608 0.3131
244 0.9647 0.9647 0.3024
245 0.9686 0.9686 0.2912
246 0.9686 0.9686 0.2792
247 0.9725 0.9725 0.2664
248 0.9765 0.9765 0.2526
249 0.9804 0.9804 0.2375
250 0.9804 0.9804 0.2208
251 0.9843 0.9843 0.2020
252 0.9882 0.9882 0.1800
253 1.0 0.0 0.0
254 1.0 1.0 0.0
255 0.0 1.000 0.0

44
map65/commons.h Normal file
View File

@ -0,0 +1,44 @@
#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 nmode; //nmode = 10*m_modeQ65 + m_modeJT65
int nfast; //No longer used
int nsave; //Number of s3(64,63) spectra saved
char mycall[12];
char mygrid[6];
char hiscall[12];
char hisgrid[6];
char datetime[20];
} datcom_;
}
#endif // COMMONS_H

354
map65/devsetup.cpp Normal file
View File

@ -0,0 +1,354 @@
#include "devsetup.h"
#include "mainwindow.h"
#include <QDebug>
#include <portaudio.h>
#define MAXDEVICES 200
//----------------------------------------------------------- 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.editorEntry->setText(m_editorCommand);
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.rbIQXT->setChecked(m_bIQxt);
ui.rbSi570->setChecked(!m_bIQxt);
ui.mult570TxSpinBox->setEnabled(m_bIQxt);
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.mult570TxSpinBox->setValue(m_mult570Tx);
ui.cal570SpinBox->setValue(m_cal570);
ui.sbTxOffset->setValue(m_TxOffset);
sscanf(m_colors.toLatin1(),"%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_editorCommand=ui.editorEntry->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_bIQxt=ui.rbIQXT->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_mult570Tx=ui.mult570TxSpinBox->value();
m_cal570=ui.cal570SpinBox->value();
m_TxOffset=ui.sbTxOffset->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()) {
}
}
void DevSetup::on_mult570TxSpinBox_valueChanged(int n)
{
m_mult570Tx=n;
}
void DevSetup::on_rbIQXT_toggled(bool checked)
{
m_bIQxt=checked;
ui.mult570TxSpinBox->setEnabled(m_bIQxt);
ui.label_25->setEnabled(m_bIQxt);
ui.sbTxOffset->setEnabled(m_bIQxt);
ui.label_26->setEnabled(m_bIQxt);
}
void DevSetup::on_sbTxOffset_valueChanged(double f)
{
m_TxOffset=f;
}

90
map65/devsetup.h Normal file
View File

@ -0,0 +1,90 @@
#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;
qint32 m_mult570Tx;
double m_fAdd;
double m_cal570;
double m_TxOffset;
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;
bool m_bIQxt;
QString m_myCall;
QString m_myGrid;
QString m_saveDir;
QString m_azelDir;
QString m_dxccPfx;
QString m_colors;
QString m_editorCommand;
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();
void on_mult570TxSpinBox_valueChanged(int arg1);
void on_rbIQXT_toggled(bool checked);
void on_sbTxOffset_valueChanged(double f);
private:
int r,g,b,r0,g0,b0,r1,g1,b1,r2,g2,b2,r3,g3,b3;
Ui::DialogSndCard ui;
};
#endif // DEVSETUP_H

1801
map65/devsetup.ui Normal file
View File

File diff suppressed because it is too large Load Diff

15
map65/displaytext.cpp Normal file
View File

@ -0,0 +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);
}

22
map65/displaytext.h Normal file
View File

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

69
map65/ffft.f Normal file
View File

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

64
map65/fftw3.f Normal file
View File

@ -0,0 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)

1
map65/ft2000_freq.sh Normal file
View File

@ -0,0 +1 @@
rigctl-wsjtx -m 129 -r COM1 -s 38400 -C data_bits=8 -C stop_bits=2 -C serial_handshake=Hardware f

259
map65/getdev.cpp Normal file
View File

@ -0,0 +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;
}
}

106
map65/getfile.cpp Normal file
View File

@ -0,0 +1,106 @@
#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.toLatin1());
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.toLatin1());
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;
}

12
map65/getfile.h Normal file
View File

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

16
map65/getsvn.cmake Normal file
View File

@ -0,0 +1,16 @@
find_package (Subversion)
if (Subversion_FOUND AND EXISTS ${PROJECT_SOURCE_DIR}/.svn)
# the FindSubversion.cmake module is part of the standard distribution
include (FindSubversion)
# extract working copy information for SOURCE_DIR into MY_XXX variables
Subversion_WC_INFO (${SOURCE_DIR} MY)
# write a file with the SVNVERSION define
file (WRITE svnversion.h.txt "#define SVNVERSION ${MY_WC_REVISION}\n")
else (Subversion_FOUND AND EXISTS ${PROJECT_SOURCE_DIR}/.svn)
file (WRITE svnversion.h.txt "#define SVNVERSION local\n")
endif (Subversion_FOUND AND EXISTS ${PROJECT_SOURCE_DIR}/.svn)
# copy the file to the final header only if the version changes
# reduces needless rebuilds
execute_process (COMMAND ${CMAKE_COMMAND} -E copy_if_different
svnversion.h.txt svnversion.h)

16
map65/in.dat Normal file
View File

@ -0,0 +1,16 @@
35 36 22 8 31 11 14 55 20 36 55 13 24 15 56 38 16 28 61 58
15 26 45 8 41 53 37 57 59 60 29 29 41 46 44 35 52 61 24 26
16 20 53 35 2 6 9 27 47 28 57 6 15 9 16 10 56 9 63 46
9 15 3
74 61 44 233 29 245 254 64 119 64 250 111 38 145 53 29 140 194 119 99
55 86 48 110 142 95 48 120 61 66 252 252 245 88 62 41 124 249 246 68
250 249 65 64 140 142 88 190 237 90 240 52 79 216 55 31 112 135 66 44
99 57 68
54 61 26 5 13 60 3 56 30 58 57 4 16 43 28 43 6 61 13 19
56 8 4 9 45 32 9 7 14 52 4 38 40 27 3 26 51 54 40 29
36 63 34 43 3 48 36 49 46 30 8 20 40 59 29 28 17 11 8 19
11 63 5
38 25 35 8 28 0 0 60 60 25 0 31 28 52 14 24 9 30 18 54
49 55 48 15 27 54 26 22 30 27 1 1 4 31 35 29 23 2 2 27
0 1 25 32 21 84 28 19 5 60 2 27 15 9 39 23 42 12 29 17
16 50 49

282
map65/killbyname.cpp Normal file
View File

@ -0,0 +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;
}

BIN
map65/libfftw3f_win.a Normal file
View File

Binary file not shown.

190
map65/libm65/CMakeLists.txt Normal file
View File

@ -0,0 +1,190 @@
cmake_minimum_required (VERSION 2.8.8)
project (libm65 C CXX Fortran)
if (POLICY CMP0020)
cmake_policy (SET CMP0020 NEW) # link to Qt winmain on Windows
endif (POLICY CMP0020)
# make sure that the default is a RELEASE
if (NOT CMAKE_BUILD_TYPE)
set (CMAKE_BUILD_TYPE RELEASE CACHE STRING
"Choose the type of build, options are: None Debug Release."
FORCE)
endif (NOT CMAKE_BUILD_TYPE)
set (CMAKE_POSITION_INDEPENDENT_CODE ON)
# Fortran setup
# FFLAGS depend on the compiler
get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER} NAME)
if (Fortran_COMPILER_NAME MATCHES "gfortran.*")
# gfortran
# set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3")
set (CMAKE_Fortran_FLAGS_RELEASE "-O2 -fbounds-check")
set (CMAKE_Fortran_FLAGS_DEBUG "-fno-f2c -O0 -g")
elseif (Fortran_COMPILER_NAME MATCHES "ifort.*")
# ifort (untested)
set (CMAKE_Fortran_FLAGS_RELEASE "-f77rtl -O3")
set (CMAKE_Fortran_FLAGS_DEBUG "-f77rtl -O0 -g")
elseif (Fortran_COMPILER_NAME MATCHES "g77")
# g77
set (CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3 -m32")
set (CMAKE_Fortran_FLAGS_DEBUG "-fno-f2c -O0 -g -m32")
else (Fortran_COMPILER_NAME MATCHES "gfortran.*")
message ("CMAKE_Fortran_COMPILER full path: " ${CMAKE_Fortran_COMPILER})
message ("Fortran compiler: " ${Fortran_COMPILER_NAME})
message ("No optimized Fortran compiler flags are known, we just try -O2...")
set (CMAKE_Fortran_FLAGS_RELEASE "-O2")
set (CMAKE_Fortran_FLAGS_DEBUG "-O0 -g")
endif (Fortran_COMPILER_NAME MATCHES "gfortran.*")
# C++ setup
if (UNIX)
SET (CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wall")
endif (UNIX)
# setup and test Fortran C/C++ interaction
include (FortranCInterface)
FortranCInterface_VERIFY (CXX QUIET)
FortranCInterface_HEADER (FC.h MACRO_NAMESPACE "FC_" SYMBOL_NAMESPACE "FC_"
SYMBOLS )
set (FSRCS
afc65b.f90
astro.f90
astro0.f90
astrosub.f90
averms.f90
badmsg.f90
ccf2.f90
ccf65.f90
cgen65.f90
chkhist.f90
chkmsg.f90
coord.f90
dcoord.f90
decode0.f90
decode1a.f90
decode65b.f90
deep65.f90
deg2grid.f90
demod64a.f90
display.f90
dot.f90
dpol.f90
encode65.f90
extract.f90
fchisq.f90
fchisq0.f90
fil6521.f90
filbig.f90
fmtmsg.f90
four2a.f90
ftninit.f90
ftnquit.f90
gen65.f90
genqra64a.f90
geocentric.f90
getdphi.f90
getpfx1.f90
getpfx2.f90
graycode.f90
graycode65.f90
grid2deg.f90
grid2k.f90
indexx.f90
interleave63.f90
iqcal.f90
iqfix.f90
jt65code.f90
k2grid.f90
lorentzian.f90
map65a.f90
moon2.f90
moondop.f90
nchar.f90
noisegen.f90
packjt.f90
pctile.f90
pfxdump.f90
qra64b.f90
qra64c.f90
qra64zap.f90
recvpkt.f90
rfile3a.f90
s3avg.f90
sec_midn.f90
set.f90
setup65.f90
shell.f90
sleep_msec.f90
smo.f90
spec64.f90
sun.f90
symspec.f90
sync64.f90
timer.f90
timf2.f90
tm2.f90
toxyz.f90
trimlist.f90
twkfreq.f90
twkfreq_xy.f90
f77_wisdom.f
)
set (CSRCS
decode_rs.c
encode_rs.c
ftrsd2.c
gran.c
igray.c
init_rs.c
tmoonsub.c
usleep.c
wrapkarn.c
qra64/qra64.c
qra64/qra64_subs.c
qracodes/npfwht.c
qracodes/pdmath.c
qracodes/qra12_63_64_irr_b.c
qracodes/qra13_64_64_irr_e.c
qracodes/qracodes.c
qracodes/normrnd.c
)
if (WIN32)
set (CSRCS ${CSRCS} ptt.c)
else (set (CSRCS ${CSRCS} ptt_unix.c))
endif (WIN32)
set (CXXSRCS
ipcomm.cpp
)
add_definitions (-DBIGSYM=1)
set_source_files_properties (sec_midn.f90 PROPERTIES COMPILE_FLAGS -fno-second-underscore)
#
# build our targets
#
add_library (m65impl STATIC ${FSRCS} ${CSRCS} ${CXXSRCS})
qt5_use_modules (m65impl Core)
add_executable (m65 m65.f90 m65a.f90)
target_link_libraries (m65 m65impl ${fftw3f_LIBRARIES})
add_dependencies (m65 fftw3f)
qt5_use_modules (m65 Core)
install (
TARGETS m65
RUNTIME DESTINATION bin
LIBRARY DESTINATION lib
)

129
map65/libm65/Makefile Normal file
View File

@ -0,0 +1,129 @@
# Makefile for MinGW on Windows
CC = c:/JTSDK/Qt55/Tools/mingw492_32/bin/gcc
FC = c:/JTSDK/Qt55/Tools/mingw492_32/bin/gfortran
CXX = c:/JTSDK/Qt55/Tools/mingw492_32/bin/g++
FFLAGS = -O2 -fbounds-check -Wall -Wno-conversion -Wno-precision-loss \
-fno-second-underscore -fbacktrace \
-ffpe-summary=none
# -ffpe-trap=invalid,zero,overflow,underflow,denormal
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: packjt.o wavhdr.o libm65.a m65.exe mapsim.exe libastro.a
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 encode65.o igray.o set.o shell.o qra64_subs.o \
grid2k.o getpfx2.o q65b.o qra64c.o twkfreq_xy.o qra64zap.o \
deg2grid.o getpfx1.o k2grid.o ftrsd2.o graycode65.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o sync64.o spec64.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 packjt.o badmsg.o fmtmsg.o \
qracodes.o qra64.o smo.o averms.o lorentzian.o npfwht.o pdmath.o \
qra13_64_64_irr_e.o fchisq0.o gen_q65_wave.o wavhdr.o
packjt.o: packjt.f90
$(FC) -c packjt.f90
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
qra64_subs.o: ./qra64/qra64_subs.c
gcc -c -O2 -o qra64_subs.o ./qra64/qra64_subs.c
qracodes.o: qracodes/qracodes.c
gcc -c -O2 -o qracodes.o qracodes/qracodes.c
qra64.o: qra64/qra64.c
gcc -c -O2 -o qra64.o qra64/qra64.c
qra13_64_64_irr_e.o: qracodes/qra13_64_64_irr_e.c
gcc -c -O2 -o qra13_64_64_irr_e.o \
qracodes/qra13_64_64_irr_e.c
npfwht.o: qracodes/npfwht.c
gcc -c -O2 -o npfwht.o qracodes/npfwht.c
pdmath.o: qracodes/pdmath.c
gcc -c -O2 -o pdmath.o qracodes/pdmath.c
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o usleep.o
# cutil.o
LIBS3 = -L'C:/JTSDK/Qt55/5.5/mingw492_32/lib' -lQt5Core
m65.exe: $(OBJS3) libm65.a
$(CXX) -o m65.exe $(OBJS3) $(LIBS3) libm65.a ../libfftw3f_win.a \
-lgfortran
cp m65.exe ../../map65_install
OBJS7 = astrosub.o astro0.o astro.o tm2.o grid2deg.o sun.o moondop.o \
coord.o dot.o moon2.o tmoonsub.o toxyz.o geocentric.o \
dcoord.o
libastro.a: $(OBJS7)
ar cr libastro.a $(OBJS7)
ranlib libastro.a
OBJS6 = mapsim.o cgen65.o noisegen.o gran.o
mapsim.exe: $(OBJS6) libm65.a
$(FC) -o mapsim.exe $(OBJS6) libm65.a
INCPATH = -I'C:/JTSDK/Qt55/5.5/mingw492_32/include/QtCore' \
-I'C:/JTSDK/Qt55/5.5/mingw492_32/include'
ipcomm.o: ipcomm.cpp
$(CXX) -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 *.mod libm65.a m65.exe

114
map65/libm65/Makefile.0 Normal file
View File

@ -0,0 +1,114 @@
# Makefile for Linux
CC = gcc
FC = gfortran
CXX = g++
FFLAGS = -O2 -fbounds-check -Wall -Wno-precision-loss -fno-second-underscore
# 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: packjt.o libm65.a m65 mapsim libastro.a
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 encode65.o igray.o set.o shell.o qra64_subs.o \
grid2k.o getpfx2.o qra64b.o qra64c.o twkfreq_xy.o qra64zap.o \
deg2grid.o getpfx1.o k2grid.o ftrsd2.o graycode65.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o sync64.o spec64.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 astrosub.o astro0.o recvpkt.o symspec.o \
iqcal.o iqfix.o timf2.o s3avg.o packjt.o badmsg.o fmtmsg.o \
qracodes.o qra64.o smo.o averms.o lorentzian.o npfwht.o pdmath.o \
qra13_64_64_irr_e.o fchisq0.o genqra64a.o ptt_unix.o
packjt.o: packjt.f90
$(FC) -c packjt.f90
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
qra64_subs.o: ./qra64/qra64_subs.c
gcc -c -O2 -o qra64_subs.o ./qra64/qra64_subs.c
qracodes.o: ./qracodes/qracodes.c
gcc -c -O2 -o qracodes.o ./qracodes/qracodes.c
qra64.o: ./qra64/qra64.c
gcc -c -O2 -o qra64.o ./qra64/qra64.c
qra13_64_64_irr_e.o: ./qracodes/qra13_64_64_irr_e.c
gcc -c -O2 -o qra13_64_64_irr_e.o ./qracodes/qra13_64_64_irr_e.c
npfwht.o: ./qracodes/npfwht.c
gcc -c -O2 -o npfwht.o ./qracodes/npfwht.c
pdmath.o: ./qracodes/pdmath.c
gcc -c -O2 -o pdmath.o ./qracodes/pdmath.c
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o usleep.o
m65: $(OBJS3) libm65.a
$(CXX) -o m65 $(OBJS3) libm65.a -lfftw3f -lQt5Core -lfftw3f -lgfortran
cp m65 ../../map65_install
OBJS7 = astrosub.o astro0.o astro.o tm2.o grid2deg.o sun.o moondop.o \
coord.o dot.o moon2.o tmoonsub.o toxyz.o geocentric.o \
dcoord.o
libastro.a: $(OBJS7)
ar cr libastro.a $(OBJS7)
ranlib libastro.a
OBJS6 = mapsim.o cgen65.o noisegen.o gran.o
mapsim: $(OBJS6) libm65.a
$(FC) -o mapsim $(OBJS6) libm65.a
INCPATH = -I. -I'/usr/include/x86_64-linux-gnu/qt5' \
-I'/usr/include/x86_64-linux-gnu/qt5/QtCore'
ipcomm.o: ipcomm.cpp
$(CXX) -c $(INCPATH) -fPIC ipcomm.cpp
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 *.mod libm65.a m65

105
map65/libm65/Makefile.MinGW Normal file
View File

@ -0,0 +1,105 @@
# Makefile for MinGW on Windows
CC = gcc
FC = g95
CXX = c:/wsjt-env/Qt5/Tools/mingw48_32/bin/g++
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 mapsim.exe libastro.a
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:/wsjt-env/Qt5/5.2.1/mingw48_32/lib' -lQt5Core
m65.exe: $(OBJS3) libm65.a
$(CXX) -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
OBJS7 = astrosub.o astro0.o astro.o tm2.o grid2deg.o sun.o moondop.o \
coord.o dot.o moon2.o tmoonsub.o toxyz.o geocentric.o \
dcoord.o
libastro.a: $(OBJS7)
ar cr libastro.a $(OBJS7)
ranlib libastro.a
OBJS6 = mapsim.o cgen65.o noisegen.o gran.o
mapsim.exe: $(OBJS6) libm65.a
$(FC) -o mapsim.exe $(OBJS6) libm65.a
INCPATH = -I'C:/wsjt-env/Qt5/5.2.1/mingw48_32/include/QtCore' \
-I'C:/wsjt-env/Qt5/5.2.1/mingw48_32/include'
ipcomm.o: ipcomm.cpp
$(CXX) -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

129
map65/libm65/Makefile.jtsdk Normal file
View File

@ -0,0 +1,129 @@
# Makefile for MinGW on Windows
CC = c:/JTSDK/Qt55/Tools/mingw492_32/bin/gcc
FC = c:/JTSDK/Qt55/Tools/mingw492_32/bin/gfortran
CXX = c:/JTSDK/Qt55/Tools/mingw492_32/bin/g++
FFLAGS = -O2 -fbounds-check -Wall -Wno-conversion -Wno-precision-loss \
-fno-second-underscore -fbacktrace \
-ffpe-summary=none
# -ffpe-trap=invalid,zero,overflow,underflow,denormal
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: packjt.o wavhdr.o libm65.a m65.exe mapsim.exe libastro.a
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 encode65.o igray.o set.o shell.o qra64_subs.o \
grid2k.o getpfx2.o q65b.o qra64c.o twkfreq_xy.o qra64zap.o \
deg2grid.o getpfx1.o k2grid.o ftrsd2.o graycode65.o \
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o sync64.o spec64.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 packjt.o badmsg.o fmtmsg.o \
qracodes.o qra64.o smo.o averms.o lorentzian.o npfwht.o pdmath.o \
qra13_64_64_irr_e.o fchisq0.o genqra64a.o wavhdr.o
packjt.o: packjt.f90
$(FC) -c packjt.f90
libm65.a: $(OBJS1)
ar cr libm65.a $(OBJS1)
ranlib libm65.a
qra64_subs.o: ./qra64/qra64_subs.c
gcc -c -O2 -o qra64_subs.o ./qra64/qra64_subs.c
qracodes.o: qracodes/qracodes.c
gcc -c -O2 -o qracodes.o qracodes/qracodes.c
qra64.o: qra64/qra64.c
gcc -c -O2 -o qra64.o qra64/qra64.c
qra13_64_64_irr_e.o: qracodes/qra13_64_64_irr_e.c
gcc -c -O2 -o qra13_64_64_irr_e.o \
qracodes/qra13_64_64_irr_e.c
npfwht.o: qracodes/npfwht.c
gcc -c -O2 -o npfwht.o qracodes/npfwht.c
pdmath.o: qracodes/pdmath.c
gcc -c -O2 -o pdmath.o qracodes/pdmath.c
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
timer.o ipcomm.o sec_midn.o usleep.o
# cutil.o
LIBS3 = -L'C:/JTSDK/Qt55/5.5/mingw492_32/lib' -lQt5Core
m65.exe: $(OBJS3) libm65.a
$(CXX) -o m65.exe $(OBJS3) $(LIBS3) libm65.a ../libfftw3f_win.a \
-lgfortran
cp m65.exe ../../map65_install
OBJS7 = astrosub.o astro0.o astro.o tm2.o grid2deg.o sun.o moondop.o \
coord.o dot.o moon2.o tmoonsub.o toxyz.o geocentric.o \
dcoord.o
libastro.a: $(OBJS7)
ar cr libastro.a $(OBJS7)
ranlib libastro.a
OBJS6 = mapsim.o cgen65.o noisegen.o gran.o
mapsim.exe: $(OBJS6) libm65.a
$(FC) -o mapsim.exe $(OBJS6) libm65.a
INCPATH = -I'C:/JTSDK/Qt55/5.5/mingw492_32/include/QtCore' \
-I'C:/JTSDK/Qt55/5.5/mingw492_32/include'
ipcomm.o: ipcomm.cpp
$(CXX) -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 *.mod libm65.a m65.exe

96
map65/libm65/Makefile.linux Normal file
View File

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

71
map65/libm65/afc65b.f90 Normal file
View File

@ -0,0 +1,71 @@
subroutine afc65b(cx,cy,npts,fsample,nflip,ipol,xpol,ndphi,iloop, &
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
! Don't fit polarization when solving for dphi
if(ndphi.ne.0) nterms=3
! Start the iteration
chisqr=0.
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
! 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

105
map65/libm65/astro.f90 Normal file
View File

@ -0,0 +1,105 @@
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)
! Computes astronomical quantities for display and tracking.
! NB: may want to smooth the Tsky map to 10 degrees or so.
character*6 MyGrid,HisGrid
real 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)
! 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

81
map65/libm65/astro0.f90 Normal file
View File

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

14
map65/libm65/astrosub.f90 Normal file
View File

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

20
map65/libm65/averms.f90 Normal file
View File

@ -0,0 +1,20 @@
subroutine averms(x,n,nskip,ave,rms)
real x(n)
integer ipk(1)
ns=0
s=0.
sq=0.
ipk=maxloc(x)
do i=1,n
if(abs(i-ipk(1)).gt.nskip) then
s=s + x(i)
sq=sq + x(i)**2
ns=ns+1
endif
enddo
ave=s/ns
rms=sqrt(sq/ns - ave*ave)
return
end subroutine averms

46
map65/libm65/badmsg.f90 Normal file
View File

@ -0,0 +1,46 @@
subroutine badmsg(irc,dat,nc1,nc2,ng2)
! Get rid of a few QRA64 false decodes that cannot be correct messages.
integer dat(12) !Decoded message (as 12 integers)
ic1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ &
ishft(dat(4),4) + iand(ishft(dat(5),-2),15)
! Test for "......" or "CQ 000"
if(ic1.eq.262177560 .or. ic1.eq.262177563) then
irc=-1
return
endif
ic2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) + &
ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) + &
iand(ishft(dat(10),-4),3)
ig=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12)
! Test for blank, -01 to -30, R-01 to R-30, RO, RRR, 73
if(ig.ge.32401 .and. ig.le.32464) return
if(ig.ge.14220 .and. ig.le.14229) return !-41 to -50
if(ig.ge.14040 .and. ig.le.14049) return !-31 to -40
if(ig.ge.13320 .and. ig.le.13329) return !+00 to +09
if(ig.ge.13140 .and. ig.le.13149) return !+10 to +19
if(ig.ge.12960 .and. ig.le.12969) return !+20 to +29
if(ig.ge.12780 .and. ig.le.12789) return !+30 to +39
if(ig.ge.12600 .and. ig.le.12609) return !+40 to +49
if(ig.ge.12420 .and. ig.le.12429) return !R-41 to R-50
if(ig.ge.12240 .and. ig.le.12249) return !R-31 to R-40
if(ig.ge.11520 .and. ig.le.11529) return !R+00 to R+09
if(ig.ge.11340 .and. ig.le.11349) return !R+10 to R+19
if(ig.ge.11160 .and. ig.le.11169) return !R+20 to R+29
if(ig.ge.10980 .and. ig.le.10989) return !R+30 to R+39
if(ig.ge.10800 .and. ig.le.10809) return !R+40 to R+49
if(ic1.eq.nc1 .and. ic2.eq.nc2 .and. ng2.ne.32401 .and. ig.ne.ng2) irc=-1
return
end subroutine badmsg

45
map65/libm65/ccf2.f90 Normal file
View File

@ -0,0 +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)
! 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

121
map65/libm65/ccf65.f90 Normal file
View File

@ -0,0 +1,121 @@
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 ccf(-11:54,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
call pctile(s,nhsym-1,50,base)
s(1:nhsym-1)=s(1:nhsym-1)-base
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=-11,54 !Check for best JT65 sync
j=lag
if(j.lt.1) j=j+NFFT
ccf(lag,ip)=s(j)
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=-11,54 !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=-11,54
if(abs(lag-lagpk).gt.1) sum=sum + ccf(lag,ipol1)
enddo
base=sum/50.0
sq=0.
do lag=-11,54
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=lagpk*(2048.0/11025.0) - 2.5
! Find base level for normalizing snr2.
do i=1,nhsym
tmp1(i)=ss(ipol2,i)
enddo
call pctile(tmp1,nhsym,40,base)
snr2=0.398107*ccfbest2/base !### empirical
syncshort=0.5*ccfbest2/rms - 4.0 !### better normalizer than rms?
dt2=2.5 + lagpk2*(2048.0/11025.0)
return
end subroutine ccf65

99
map65/libm65/cgen65.f90 Normal file
View File

@ -0,0 +1,99 @@
subroutine cgen65(message,mode65,samfac,nsendingsh,msgsent,cwave,nwave)
! Encodes a JT65 message into a wavefile.
! Executes in 17 ms on opti-745.
use packjt
parameter (NMAX=60*96000) !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 t,dt,phi,f,f0,dfgen,dphi,twopi,samfac,tsymbol
complex cwave(NMAX) !Generated complex 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) !See if it's a shorthand
if(nspecial.eq.0) then
call packmsg(message,dgen,itype) !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
tsymbol=4096.d0/11025.d0 !Time per symbol
else
nsendingsh=1 !Flag for shorthand message
nsym=32
tsymbol=16384.d0/11025.d0
endif
! Set up necessary constants
dt=1.d0/(samfac*96000.d0)
f0=118*11025.d0/1024
dfgen=mode65*11025.d0/4096.d0
t=0.d0
phi=0.d0
k=0
j0=0
ndata=nsym*96000.d0*samfac*tsymbol
do i=1,ndata
t=t+dt
j=int(t/tsymbol) + 1 !Symbol number, 1-126
if(j.ne.j0) then
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
j0=j
endif
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
cwave(i)=cmplx(cos(xphi),-sin(xphi))
enddo
cwave(ndata+1:)=0
nwave=ndata + 48000
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
return
end subroutine cgen65

23
map65/libm65/chkhist.f90 Normal file
View File

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

31
map65/libm65/chkmsg.f90 Normal file
View File

@ -0,0 +1,31 @@
subroutine chkmsg(message,cok,nspecial,flip)
character message*22,cok*3
nspecial=0
flip=1.0
cok=" "
do i=22,1,-1
if(message(i:i).ne.' ') go to 10
enddo
i=22
10 if(i.ge.11) then
if ((message(i-3:i).eq.' OOO') .or. (message(20:22).eq.' OO')) then
cok='OOO'
flip=-1.0
if(message(20:22).eq.' OO') then
message=message(1:19)
else
message=message(1:i-4)
endif
endif
endif
if(message(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

40
map65/libm65/coord.f90 Normal file
View File

@ -0,0 +1,40 @@
SUBROUTINE COORD(A0,B0,AP,BP,A1,B1,A2,B2)
! Examples:
! 1. From ha,dec to az,el:
! call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
! 2. From az,el to ha,dec:
! call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
! 3. From ra,dec to l,b
! call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
! ra,dec,l,b)
! 4. From l,b to ra,dec
! call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
! 0.478220215d0,l,b,ra,dec)
! 5. From ra,dec to ecliptic latitude (eb) and longitude (el):
! call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
! 6. From ecliptic latitude (eb) and longitude (el) to ra,dec:
! call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,el,eb,ra,dec)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.e0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
TA2O2=0.0 !Shut up compiler warnings. -db
IF(CA2.LE.0.e0) TA2O2=(1.e0-CA2)/SA2
IF(CA2.GT.0.e0) TA2O2=SA2/(1.e0+CA2)
A2=2.e0*atan(TA2O2)
IF(A2.LT.0.e0) A2=A2+6.2831853
RETURN
END SUBROUTINE COORD

93
map65/libm65/cutil.c Normal file
View File

@ -0,0 +1,93 @@
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
// #include <sys/times.h>
// #include <time.h>
// #include <sys/time.h>
#include "sleep.h"
#include "timeval.h"
/* FORTRAN: fd = close(filedes) */
int close_(int *filedes)
{
return(close(*filedes));
}
/* FORTRAN: fd = open(filnam,mode) */
int open_(char filnam[], int *mode)
{
return(open(filnam,*mode));
}
/* FORTRAN: fd = creat(filnam,mode) */
int creat_(char filnam[],int *mode)
{
return(creat(filnam,*mode));
}
/* FORTRAN: nread = read(fd,buf,n) */
int read_(int *fd, char buf[], int *n)
{
return(read(*fd,buf,*n));
}
/* FORTRAN: nwrt = write(fd,buf,n) */
int write_(int *fd, char buf[], int *n)
{
return(write(*fd,buf,*n));
}
/* FORTRAN: ns = lseek(fd,offset,origin) */
int lseek_(int *fd,int *offset, int *origin)
{
return(lseek(*fd,*offset,*origin));
}
/* times(2) */
//int times_(struct tms *buf)
//{
// return (times(buf));
//}
/* ioperm(2) */
//ioperm_(from,num,turn_on)
//unsigned long *from,*num,*turn_on;
//{
// return (ioperm(*from,*num,*turn_on));
// return (i386_get_ioperm(*from,*num,*turn_on));
//}
/* usleep(3) */
void usleep_(unsigned long *microsec)
{
usleep(*microsec);
}
/* returns random numbers between 0 and 32767 to FORTRAN program */
int iran_(int *arg)
{
return (rand());
}
int exit_(int *n)
{
printf("\n\n");
exit(*n);
}
/*
struct tm *
gmtime_r_(const time_t *clock, struct tm *result)
{
gmtime_r(clock, result);
}
*/
time_t time_(void)
{
return time(0);
}
/* hrtime() */
double hrtime_(void)
{
struct timeval tv;
gettimeofday(&tv,NULL);
return(tv.tv_sec+1.e-6*tv.tv_usec);
}

40
map65/libm65/dcoord.f90 Normal file
View File

@ -0,0 +1,40 @@
SUBROUTINE DCOORD(A0,B0,AP,BP,A1,B1,A2,B2)
implicit real*8 (a-h,o-z)
! Examples:
! 1. From ha,dec to az,el:
! call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
! 2. From az,el to ha,dec:
! call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
! 3. From ra,dec to l,b
! call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
! ra,dec,l,b)
! 4. From l,b to ra,dec
! call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
! 0.478220215d0,l,b,ra,dec)
! 5. From ecliptic latitude (eb) and longitude (el) to ra, dec:
! 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

67
map65/libm65/decode0.f90 Normal file
View File

@ -0,0 +1,67 @@
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,nmode, &
nfast,nsave,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,nsum,nsave,nxant,rmsdd,mycall,mygrid, &
neme,ndepth,hiscall,hisgrid,nhsym,nfsample,nxpol,nmode)
call timer('map65a ',1)
call timer('decode0 ',1)
write(*,1010) nsum,nsave
1010 format('<DecodeFinished>',2i4)
flush(6)
return
end subroutine decode0

154
map65/libm65/decode1a.f90 Normal file
View File

@ -0,0 +1,154 @@
subroutine decode1a(dd,newdat,f0,nflip,mode65,nfsample,xpol, &
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,ndphi,iloop, &
nutc,nkhz,ndf,ipol,ntol,bq65,sync2,a,dt,pol,nkv,nhist,nsum,nsave, &
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) !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,bq65
character decoded*22
character mycall*12,hiscall*12,hisgrid*6
data first/.true./,jjjmin/1000/,jjjmax/-1000/
data nutc0/-999/,nhz0/-9999999/
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)
if(nqd.eq.2) goto 900
sqa=0.
sqb=0.
do i=1,n5
sqa=sqa + real(cx(i))**2 + aimag(cx(i))**2
if(xpol) 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
if(xpol) then
z=cmplx(cos(dphi),sin(dphi))
cy(:n5)=z*cy(:n5) !Adjust for cable length difference
endif
call timer('fil6521 ',0)
! Add some zeros at start of c5 arrays -- empirical fix for negative DT's
nadd=1089
c5x(:nadd)=0.
call fil6521(cx,n5,c5x(nadd+1),n6)
if(xpol) then
c5y(:nadd)=0.
call fil6521(cy,n5,c5y(nadd+1),n6)
endif
n6=n6+nadd
call timer('fil6521 ',1)
fsample=1378.125/4.
a(5)=dt00
i0=nint((a(5)+0.5)*fsample) - 2 + nadd
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, &
ndphi,iloop,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_xy(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
j=(dt00+dtbest+2.685)*1378.125
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 n=1,1
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
jj=i
if(mode65.eq.2) jj=2*i-1
if(mode65.eq.4) jj=4*i-3
s2(i,k)=real(c5a(jj))**2 + aimag(c5a(jj))**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 + 1.7
call timer('dec65b ',1)
if(nqd.eq.1 .and. decoded.eq.' ') then
nhz=1000*nkhz + ndf
ihzdiff=min(500,ntol)
if(nutc.ne.nutc0 .or. abs(nhz-nhz0).ge.ihzdiff) syncbest=0.
if(sync2.gt.0.99999*syncbest) then
nsave=nsave+1
nsave=mod(nsave-1,64)+1
npol=nint(57.296*pol)
call s3avg(nsave,mode65,nutc,nhz,xdt,npol,ntol,s3,nsum,nkv,decoded)
syncbest=sync2
nhz0=nhz
endif
nutc0=nutc
endif
900 return
end subroutine decode1a

48
map65/libm65/decode65b.f90 Normal file
View File

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

268
map65/libm65/decode_rs.c Normal file
View File

@ -0,0 +1,268 @@
/* Reed-Solomon decoder
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
* Modified by Steve Franke, K9AN, for use in a soft-symbol RS decoder
*/
#ifdef DEBUG
#include <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(
#ifndef FIXED
void *p,
#endif
DTYPE *data, int *eras_pos, int no_eras, int calc_syn){
#ifndef FIXED
struct rs *rs = (struct rs *)p;
#endif
int deg_lambda, el, deg_omega;
int i, j, r,k;
DTYPE u,q,tmp,num1,num2,den,discr_r;
DTYPE lambda[NROOTS+1]; // Err+Eras Locator poly
static DTYPE s[51]; // and syndrome poly
DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1];
DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS];
int syn_error, count;
if( calc_syn ) {
/* form the syndromes; i.e., evaluate data(x) at roots of g(x) */
for(i=0;i<NROOTS;i++)
s[i] = data[0];
for(j=1;j<NN;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++)
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 = 0;
for (i = 0; i < NROOTS;i++){
tmp = 0;
j = (deg_lambda < i) ? deg_lambda : i;
for(;j >= 0; j--){
if ((s[i - j] != A0) && (lambda[j] != A0))
tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])];
}
if(tmp != 0)
deg_omega = i;
omega[i] = INDEX_OF[tmp];
}
omega[NROOTS] = A0;
/*
* Compute error values in poly-form. num1 = omega(inv(X(l))), num2 =
* inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form
*/
for (j = count-1; j >=0; j--) {
num1 = 0;
for (i = deg_omega; i >= 0; i--) {
if (omega[i] != A0)
num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])];
}
num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)];
den = 0;
/* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */
for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) {
if(lambda[i+1] != A0)
den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])];
}
if (den == 0) {
#if DEBUG >= 1
printf("\n ERROR: denominator = 0\n");
#endif
count = -1;
goto finish;
}
/* Apply error to data */
if (num1 != 0) {
data[loc[j]] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])];
}
}
finish:
if(eras_pos != NULL){
for(i=0;i<count;i++)
eras_pos[i] = loc[i];
}
return count;
}

169
map65/libm65/deep65.f90 Normal file
View File

@ -0,0 +1,169 @@
subroutine deep65(s3,mode65,neme,flip,mycall,hiscall,hisgrid,decoded,qual)
parameter (MAXCALLS=10000,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,bestmsg
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. 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
do k=1,ntot
pp(k)=0.
if(k.ge.2 .and. k.le.64 .and. flip.lt.0.0) cycle
! Test all messages if flip=+1; skip the CQ messages if flip=-1.
if(flip.gt.0.0 .or. testmsg(k)(1:3).ne.'CQ ') then
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
bestmsg=testmsg(k)
endif
endif
enddo
p2=-1.e30
do i=1,ntot
if(pp(i).gt.p2 .and. testmsg(i).ne.bestmsg) p2=pp(i)
enddo
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) then
open(77,file='error.log',status='unknown',access='append')
write(77,*) p1,p2,ip1,bestmsg
close(77)
endif
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

30
map65/libm65/deg2grid.f90 Normal file
View File

@ -0,0 +1,30 @@
subroutine deg2grid(dlong0,dlat,grid)
real dlong !West longitude (deg)
real dlat !Latitude (deg)
character grid*6
dlong=dlong0
if(dlong.lt.-180.0) dlong=dlong+360.0
if(dlong.gt.180.0) dlong=dlong-360.0
! Convert to units of 5 min of longitude, working east from 180 deg.
nlong=60.0*(180.0-dlong)/5.0
n1=nlong/240 !20-degree field
n2=(nlong-240*n1)/24 !2 degree square
n3=nlong-240*n1-24*n2 !5 minute subsquare
grid(1:1)=char(ichar('A')+n1)
grid(3:3)=char(ichar('0')+n2)
grid(5:5)=char(ichar('a')+n3)
! Convert to units of 2.5 min of latitude, working north from -90 deg.
nlat=60.0*(dlat+90)/2.5
n1=nlat/240 !10-degree field
n2=(nlat-240*n1)/24 !1 degree square
n3=nlat-240*n1-24*n2 !2.5 minuts subsquare
grid(2:2)=char(ichar('A')+n1)
grid(4:4)=char(ichar('0')+n2)
grid(6:6)=char(ichar('a')+n3)
return
end subroutine deg2grid

77
map65/libm65/demod64a.f90 Normal file
View File

@ -0,0 +1,77 @@
subroutine demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! Demodulate the 64-bin spectra for each of 63 symbols in a frame.
! Parameters
! nadd number of spectra already summed
! mrsym most reliable symbol value
! mr2sym second most likely symbol value
! mrprob probability that mrsym was the transmitted value
! mr2prob probability that mr2sym was the transmitted value
implicit real*8 (a-h,o-z)
real*4 s3(64,63)
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
! 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
! Compute probabilities for most reliable symbol values
do j=1,63
s1=-1.e30
fsum=0.
psum=0.
do i=1,64
x=min(afac*s3(i,j)/ave,50.d0)
fs(i)=exp(x)
fsum=fsum+fs(i)
psum=psum + s3(i,j)
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
p1=s1/psum
p2=s2/psum
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
ntest=sum
return
end subroutine demod64a

170
map65/libm65/display.f90 Normal file
View File

@ -0,0 +1,170 @@
subroutine display(nkeep,ftol)
parameter (MAXLINES=400,MX=400,MAXCALLS=500)
integer indx(MAXLINES),indx2(MX)
character*83 line(MAXLINES),line2(MX),line3(MAXLINES)
character out*52,cfreq0*3,livecq*58
character*6 callsign,callsign0
character*12 freqcall(MAXCALLS)
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(a77)
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 backspace(26)
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)(73:74),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,1022) line(i)
1022 format(a77)
enddo
endif
call flush(26)
call indexx(freqkHz,nz,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(utc2,kz,indx2)
k3=0
do k=1,kz
k3=min(k3+1,400)
line3(k3)=line2(indx2(k))
enddo
nstart=0
else
call indexx(utc2,kz,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(utc2,kz,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:45)// &
line3(k)(35:38)//line3(k)(46:74)
if(out(1:3).ne.' ') then
cfreq0=out(1:3)
if(iw.lt.MAXLINES-1) iw=iw+1
livecq=line3(k)(6:13)//line3(k)(28:31)//line3(k)(39:45)// &
line3(k)(23:27)//line3(k)(35:38)//line3(k)(46:70)// &
line3(k)(73:77)
if(index(livecq,' CQ ').gt.0 .or. index(livecq,' QRZ ').gt.0 .or. &
index(livecq,' QRT ').gt.0 .or. index(livecq,' CQV ').gt.0 .or. &
index(livecq,' CQH ').gt.0) write(19,1029) livecq
1029 format(a58)
write(*,1030) out !Messages
1030 format('@',a52)
i1=index(out(26:),' ')
callsign=out(i1+26:)
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"
if(nc.lt.MAXCALLS) nc=nc+1
freqcall(nc)=cfreq0//' '//callsign//line3(k)(73:74)
callsign0=callsign
endif
endif
if(callsign.ne.' ' .and. callsign.eq.callsign0) then
freqcall(nc)=cfreq0//' '//callsign//line3(k)(73:74)
endif
endif
enddo
flush(19)
if(nc.lt.MAXCALLS) nc=nc+1
freqcall(nc)=' '
if(nc.lt.MAXCALLS) nc=nc+1
freqcall(nc)=' '
freqcall(nc+1)=' '
freqcall(nc+2)=' '
do i=1,nc
write(*,1042) freqcall(i) !Band Map
1042 format('&',a12)
enddo
999 continue
return
end subroutine display

11
map65/libm65/dot.f90 Normal file
View File

@ -0,0 +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 function dot

41
map65/libm65/dpol.f90 Normal file
View File

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

14
map65/libm65/encode65.f90 Normal file
View File

@ -0,0 +1,14 @@
subroutine encode65(message,sent)
use packjt
character message*22
integer dgen(12)
integer sent(63)
call packmsg(message,dgen,itype)
call rs_encode(dgen,sent)
call interleave63(sent,1)
call graycode(sent,63,1)
return
end subroutine encode65

47
map65/libm65/encode_rs.c Normal file
View File

@ -0,0 +1,47 @@
/* Reed-Solomon encoder
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <string.h>
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
void ENCODE_RS(
#ifndef FIXED
void *p,
#endif
DTYPE *data, DTYPE *bb){
#ifndef FIXED
struct rs *rs = (struct rs *)p;
#endif
int i, j;
DTYPE feedback;
memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS;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;
}
}

135
map65/libm65/extract.f90 Normal file
View File

@ -0,0 +1,135 @@
subroutine extract(s3,nadd,ncount,nhist,decoded,ltext)
use packjt
real s3(64,63)
character decoded*22
integer era(51),dat4(12),indx(64)
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
logical first,ltext
integer correct(63),itmp(63)
integer param(0:8)
integer h0(0:11),d0(0:11),ne(0:11)
real r0(0:11)
common/test001/s3a(64,63),mrs(63),mrs2(63) !### TEST ONLY ###
! 0 1 2 3 4 5 6 7 8 9 10 11
data h0/41,42,43,43,44,45,46,47,48,48,49,49/
data d0/71,72,73,74,76,77,78,80,81,82,83,83/
! 0 1 2 3 4 5 6 7 8 9 10 11
data r0/0.70,0.72,0.74,0.76,0.78,0.80,0.82,0.84,0.86,0.88,0.90,0.90/
data first/.true./,nsec1/0/
save
nfail=0
call pctile(s3,4032,50,base) ! ### or, use ave from demod64a
s3=s3/base
s3a=s3
1 call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
! 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,4032,50,base) ! ### or, use ave from demod64a
s3(ipk,1:63)=base
if(nfail.gt.30) then
decoded=' '
ncount=-1
go to 900
endif
go to 1
endif
mrs=mrsym
mrs2=mr2sym
call graycode(mrsym,63,-1)
call interleave63(mrsym,-1)
call interleave63(mrprob,-1)
call graycode(mr2sym,63,-1)
call interleave63(mr2sym,-1)
call interleave63(mr2prob,-1)
ntrials=10000
naggressive=10
ntry=0
param=0
call timer('ftrsd ',0)
call ftrsd2(mrsym,mrprob,mr2sym,mr2prob,ntrials,correct,param,ntry)
call timer('ftrsd ',1)
ncandidates=param(0)
nhard=param(1)
nsoft=param(2)
nerased=param(3)
rtt=0.001*param(4)
ntotal=param(5)
qual=0.001*param(7)
nd0=81
r00=0.87
if(naggressive.eq.10) then
nd0=83
r00=0.90
endif
if(ntotal.le.nd0 .and. rtt.le.r00) nft=1
n=naggressive
if(nhard.gt.50) nft=0
if(nhard.gt.h0(n)) nft=0
if(ntotal.gt.d0(n)) nft=0
if(rtt.gt.r0(n)) nft=0
ncount=-1
decoded=' '
ltext=.false.
if(nft.gt.0) then
! Turn the corrected symbol array into channel symbols for subtraction;
! pass it back to jt65a via common block "chansyms65".
do i=1,12
dat4(i)=correct(13-i)
enddo
do i=1,63
itmp(i)=correct(64-i)
enddo
correct(1:63)=itmp(1:63)
call interleave63(correct,63,1)
call graycode65(correct,63,1)
call unpackmsg(dat4,decoded) !Unpack the user message
ncount=0
if(iand(dat4(10),8).ne.0) ltext=.true.
endif
900 continue
if(nft.eq.1 .and. nhard.lt.0) decoded=' '
! write(81,3001) naggressive,ncandidates,nhard,ntotal,rtt,qual,decoded
!3001 format(i2,i6,i3,i4,2f8.2,2x,a22)
return
end subroutine extract
subroutine getpp(workdat,p)
integer workdat(63)
integer a(63)
common/test001/s3a(64,63),mrs(63),mrs2(63)
a(1:63)=workdat(63:1:-1)
call interleave63(a,1)
call graycode(a,63,1,a)
psum=0.
do j=1,63
i=a(j)+1
x=s3a(i,j)
s3a(i,j)=0.
psum=psum + x
s3a(i,j)=x
enddo
p=psum/63.0
return
end subroutine getpp

45
map65/libm65/f77_wisdom.f Normal file
View File

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

76
map65/libm65/fchisq.f90 Normal file
View File

@ -0,0 +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(3000)
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
nsps=nint(fsample/baud) !Samples per symbol
nsph=nsps/2 !Samples per half-symbol
ndiv=16 !Output ss() steps per symbol
nout=ndiv*npts/nsps
dtstep=1.0/(ndiv*baud) !Time per output step
if(a(1).ne.a1 .or. a(2).ne.a2 .or. a(3).ne.a3) then
a1=a(1)
a2=a(2)
a3=a(3)
! Mix and integrate the complex 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
! 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)
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 function fchisq

23
map65/libm65/fchisq0.f90 Normal file
View File

@ -0,0 +1,23 @@
real function fchisq0(y,npts,a)
real y(npts),a(4)
! rewind 51
chisq = 0.
do i=1,npts
x=i
z=(x-a(3))/(0.5*a(4))
yfit=a(1)
if(abs(z).lt.3.0) then
d=1.0 + z*z
yfit=a(1) + a(2) * (1.0/d - 0.1)
endif
chisq=chisq + (y(i) - yfit)**2
! write(51,3001) i,y(i),yfit,y(i)-yfit
!3001 format(i5,3f10.4)
enddo
fchisq0=chisq
return
end function fchisq0

64
map65/libm65/fftw3.f Normal file
View File

@ -0,0 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)

64
map65/libm65/fftw3.f90 Normal file
View File

@ -0,0 +1,64 @@
INTEGER FFTW_R2HC
PARAMETER (FFTW_R2HC=0)
INTEGER FFTW_HC2R
PARAMETER (FFTW_HC2R=1)
INTEGER FFTW_DHT
PARAMETER (FFTW_DHT=2)
INTEGER FFTW_REDFT00
PARAMETER (FFTW_REDFT00=3)
INTEGER FFTW_REDFT01
PARAMETER (FFTW_REDFT01=4)
INTEGER FFTW_REDFT10
PARAMETER (FFTW_REDFT10=5)
INTEGER FFTW_REDFT11
PARAMETER (FFTW_REDFT11=6)
INTEGER FFTW_RODFT00
PARAMETER (FFTW_RODFT00=7)
INTEGER FFTW_RODFT01
PARAMETER (FFTW_RODFT01=8)
INTEGER FFTW_RODFT10
PARAMETER (FFTW_RODFT10=9)
INTEGER FFTW_RODFT11
PARAMETER (FFTW_RODFT11=10)
INTEGER FFTW_FORWARD
PARAMETER (FFTW_FORWARD=-1)
INTEGER FFTW_BACKWARD
PARAMETER (FFTW_BACKWARD=+1)
INTEGER FFTW_MEASURE
PARAMETER (FFTW_MEASURE=0)
INTEGER FFTW_DESTROY_INPUT
PARAMETER (FFTW_DESTROY_INPUT=1)
INTEGER FFTW_UNALIGNED
PARAMETER (FFTW_UNALIGNED=2)
INTEGER FFTW_CONSERVE_MEMORY
PARAMETER (FFTW_CONSERVE_MEMORY=4)
INTEGER FFTW_EXHAUSTIVE
PARAMETER (FFTW_EXHAUSTIVE=8)
INTEGER FFTW_PRESERVE_INPUT
PARAMETER (FFTW_PRESERVE_INPUT=16)
INTEGER FFTW_PATIENT
PARAMETER (FFTW_PATIENT=32)
INTEGER FFTW_ESTIMATE
PARAMETER (FFTW_ESTIMATE=64)
INTEGER FFTW_ESTIMATE_PATIENT
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
INTEGER FFTW_BELIEVE_PCOST
PARAMETER (FFTW_BELIEVE_PCOST=256)
INTEGER FFTW_DFT_R2HC_ICKY
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
INTEGER FFTW_NONTHREADED_ICKY
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
INTEGER FFTW_NO_BUFFERING
PARAMETER (FFTW_NO_BUFFERING=2048)
INTEGER FFTW_NO_INDIRECT_OP
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
INTEGER FFTW_ALLOW_LARGE_GENERIC
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
INTEGER FFTW_NO_RANK_SPLITS
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
INTEGER FFTW_NO_VRANK_SPLITS
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
INTEGER FFTW_NO_VRECURSE
PARAMETER (FFTW_NO_VRECURSE=65536)
INTEGER FFTW_NO_SIMD
PARAMETER (FFTW_NO_SIMD=131072)

44
map65/libm65/fil6521.f90 Normal file
View File

@ -0,0 +1,44 @@
subroutine fil6521(c1,n1,c2,n2)
! FIR lowpass filter designed using ScopeFIR
! Pass #1 Pass #2
!-----------------------------------------------
! fsample (Hz) 1378.125 Input sample rate
! Ntaps 21 Number of filter taps
! fc (Hz) 40 Cutoff frequency
! fstop (Hz) 172.266 Lower limit of stopband
! Ripple (dB) 0.1 Ripple in passband
! Stop Atten (dB) 38 Stopband attenuation
! fout (Hz) 344.531 Output sample rate
parameter (NTAPS=21)
parameter (NH=NTAPS/2)
parameter (NDOWN=4) !Downsample ratio = 1/4
complex c1(n1)
complex c2(n1/NDOWN)
! Filter coefficients:
real a(-NH:NH)
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
! 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

133
map65/libm65/filbig.f90 Normal file
View File

@ -0,0 +1,133 @@
subroutine filbig(dd,nmax,f0,newdat,nfsample,xpol,c4a,c4b,n4)
! Filter and downsample complex data stored in array dd(4,nmax).
! 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'
common/cacb/ca,cb
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
if(nmax.lt.0) go to 900
nfft1=MAXFFT1
nfft2=MAXFFT2
if(nfsample.eq.95238) then
nfft1=5120000
nfft2=74088
endif
if(first) then
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
! Plan the FFTs just once
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)
! 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
! When new data comes along, we need to compute a new "big FFT"
! 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
! NB: f0 is the frequency at which we want our filter centered.
! 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
! 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

21
map65/libm65/fmtmsg.f90 Normal file
View File

@ -0,0 +1,21 @@
subroutine fmtmsg(msg,iz)
character*22 msg
! Convert all letters to upper case
iz=22
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'))
if(msg(i:i).ne.' ') iz=i
enddo
do iter=1,5 !Collapse multiple blanks into one
ib2=index(msg(1:iz),' ')
if(ib2.lt.1) go to 100
msg=msg(1:ib2)//msg(ib2+2:)
iz=iz-1
enddo
100 return
end subroutine fmtmsg

115
map65/libm65/four2a.f90 Normal file
View File

@ -0,0 +1,115 @@
subroutine four2a(a,nfft,ndim,isign,iform)
! IFORM = 1, 0 or -1, as data is
! complex, real, or the first half of a complex array. Transform
! values are returned in array DATA. They are complex, real, or
! the first half of a complex array, as IFORM = 1, -1 or 0.
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
! by ... will be returned in the same array, now considered to
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
! IFORM = 0 or -1, N(1) must be even, and enough room must be
! reserved. The missing values may be obtained by complex conjugation.
! The reverse transformation of a half complex array dimensioned
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
! The transform will be real and returned to the input array.
! This version of four2a makes calls to the FFTW library to do the
! actual computations.
parameter (NPMAX=2100) !Max numberf of stored plans
parameter (NSMALL=16384) !Max size of "small" FFTs
complex a(nfft) !Array to be transformed
complex aa(NSMALL) !Local copy of "small" a()
integer nn(NPMAX),ns(NPMAX),nf(NPMAX) !Params of stored plans
integer*8 nl(NPMAX),nloc !More params of plans
integer*8 plan(NPMAX) !Pointers to stored plans
logical found_plan
data nplan/0/ !Number of stored plans
common/patience/npatience,nthreads !Patience and threads for FFTW plans
include 'fftw3.f90' !FFTW definitions
save plan,nplan,nn,ns,nf,nl
if(nfft.lt.0) go to 999
nloc=loc(a)
found_plan = .false.
!$omp critical(four2a_setup)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
iform.eq.nf(i) .and. nloc.eq.nl(i)) then
found_plan = .true.
exit
end if
enddo
if(i.ge.NPMAX) stop 'Too many FFTW plans requested.'
if (.not. found_plan) then
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
! FFTW_PATIENT, FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
aa(1:jz)=a(1:jz)
endif
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
!$omp end critical(fftw)
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
a(1:jz)=aa(1:jz)
endif
end if
!$omp end critical(four2a_setup)
call sfftw_execute(plan(i))
return
999 continue
!$omp critical(four2a)
do i=1,nplan
! The test is only to silence a compiler warning:
if(ndim.ne.-999) then
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
call sfftw_destroy_plan(plan(i))
!$omp end critical(fftw)
end if
enddo
nplan=0
!$omp end critical(four2a)
return
end subroutine four2a

57
map65/libm65/ftninit.f90 Normal file
View File

@ -0,0 +1,57 @@
! 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
! 23 CALL3.TXT
! 24
! 25
! 26 tmp26.txt
! 27
! 28 fftw_wisdom.dat
!------------------------------------------------ ftn_init
subroutine ftninit(appd)
character*(*) appd
character firstline*30
character addpfx*8
integer junk(256)
common/pfxcom/addpfx
addpfx=' '
call pfxdump(appd//'/prefixes.txt')
open(12,file=appd//'/timer_map65.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(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 flush(13)
return
920 write(0,*) '!Error opening timer.out'
stop
950 write(0,*) '!Error opening ALL65.TXT'
stop
end subroutine ftninit

9
map65/libm65/ftnquit.f90 Normal file
View File

@ -0,0 +1,9 @@
subroutine ftnquit
! Destroy the FFTW plans
call four2a(a,-1,1,1,1)
call filbig(id,-1,1,f0,newdat,nfsample,c4a,c4b,n4)
stop
return
end subroutine ftnquit

213
map65/libm65/ftrsd2.c Normal file
View File

@ -0,0 +1,213 @@
/*
ftrsd2.c
A soft-decision decoder for the JT65 (63,12) Reed-Solomon code.
This decoding scheme is built around Phil Karn's Berlekamp-Massey
errors and erasures decoder. The approach is inspired by a number of
publications, including the stochastic Chase decoder described
in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
"Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
Steve Franke K9AN and Joe Taylor K1JT
*/
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h>
#include <string.h>
#include "rs2.h"
static void *rs;
void getpp_(int workdat[], float *pp);
void ftrsd2_(int mrsym[], int mrprob[], int mr2sym[], int mr2prob[],
int* ntrials0, int correct[], int param[], int ntry[])
{
int rxdat[63], rxprob[63], rxdat2[63], rxprob2[63];
int workdat[63];
int indexes[63];
int era_pos[51];
int i, j, numera, nerr, nn=63;
int ntrials = *ntrials0;
int nhard=0,nhard_min=32768,nsoft=0,nsoft_min=32768;
int ntotal=0,ntotal_min=32768,ncandidates;
int nera_best=0;
float pp,pp1,pp2;
static unsigned int nseed;
// Power-percentage symbol metrics - composite gnnf/hf
int perr[8][8] = {
{ 4, 9, 11, 13, 14, 14, 15, 15},
{ 2, 20, 20, 30, 40, 50, 50, 50},
{ 7, 24, 27, 40, 50, 50, 50, 50},
{13, 25, 35, 46, 52, 70, 50, 50},
{17, 30, 42, 54, 55, 64, 71, 70},
{25, 39, 48, 57, 64, 66, 77, 77},
{32, 45, 54, 63, 66, 75, 78, 83},
{51, 58, 57, 66, 72, 77, 82, 86}};
// Initialize the KA9Q Reed-Solomon encoder/decoder
unsigned int symsize=6, gfpoly=0x43, fcr=3, prim=1, nroots=51;
rs=init_rs_int(symsize, gfpoly, fcr, prim, nroots, 0);
// Reverse the received symbol vectors for BM decoder
for (i=0; i<63; i++) {
rxdat[i]=mrsym[62-i];
rxprob[i]=mrprob[62-i];
rxdat2[i]=mr2sym[62-i];
rxprob2[i]=mr2prob[62-i];
}
// Sort rxprob to find indexes of the least reliable symbols
int k, pass, tmp, nsym=63;
int probs[63];
for (i=0; i<63; i++) {
indexes[i]=i;
probs[i]=rxprob[i];
}
for (pass = 1; pass <= nsym-1; pass++) {
for (k = 0; k < nsym - pass; k++) {
if( probs[k] < probs[k+1] ) {
tmp = probs[k];
probs[k] = probs[k+1];
probs[k+1] = tmp;
tmp = indexes[k];
indexes[k] = indexes[k+1];
indexes[k+1] = tmp;
}
}
}
// See if we can decode using BM HDD, and calculate the syndrome vector.
memset(era_pos,0,51*sizeof(int));
numera=0;
memcpy(workdat,rxdat,sizeof(rxdat));
nerr=decode_rs_int(rs,workdat,era_pos,numera,1);
if( nerr >= 0 ) {
// Hard-decision decoding succeeded. Save codeword and some parameters.
nhard=0;
for (i=0; i<63; i++) {
if( workdat[i] != rxdat[i] ) nhard=nhard+1;
}
memcpy(correct,workdat,63*sizeof(int));
param[0]=0;
param[1]=nhard;
param[2]=0;
param[3]=0;
param[4]=0;
param[5]=0;
param[7]=1000*1000;
ntry[0]=0;
return;
}
/*
Hard-decision decoding failed. Try the FT soft-decision method.
Generate random erasure-locator vectors and see if any of them
decode. This will generate a list of "candidate" codewords. The
soft distance between each candidate codeword and the received
word is estimated by finding the largest (pp1) and second-largest
(pp2) outputs from a synchronized filter-bank operating on the
symbol spectra, and using these to decide which candidate
codeword is "best".
*/
nseed=1; //Seed for random numbers
float ratio;
int thresh, nsum;
int thresh0[63];
ncandidates=0;
nsum=0;
int ii,jj;
for (i=0; i<nn; i++) {
nsum=nsum+rxprob[i];
j = indexes[62-i];
ratio = (float)rxprob2[j]/((float)rxprob[j]+0.01);
ii = 7.999*ratio;
jj = (62-i)/8;
thresh0[i] = 1.3*perr[ii][jj];
}
if(nsum<=0) return;
pp1=0.0;
pp2=0.0;
for (k=1; k<=ntrials; k++) {
memset(era_pos,0,51*sizeof(int));
memcpy(workdat,rxdat,sizeof(rxdat));
/*
Mark a subset of the symbols as erasures.
Run through the ranked symbols, starting with the worst, i=0.
NB: j is the symbol-vector index of the symbol with rank i.
*/
numera=0;
for (i=0; i<nn; i++) {
j = indexes[62-i];
thresh=thresh0[i];
long int ir;
// Generate a random number ir, 0 <= ir < 100 (see POSIX.1-2001 example).
nseed = nseed * 1103515245 + 12345;
ir = (unsigned)(nseed/65536) % 32768;
ir = (100*ir)/32768;
if((ir < thresh ) && numera < 51) {
era_pos[numera]=j;
numera=numera+1;
}
}
nerr=decode_rs_int(rs,workdat,era_pos,numera,0);
if( nerr >= 0 ) {
// We have a candidate codeword. Find its hard and soft distance from
// the received word. Also find pp1 and pp2 from the full array
// s3(64,63) of synchronized symbol spectra.
ncandidates=ncandidates+1;
nhard=0;
nsoft=0;
for (i=0; i<63; i++) {
if(workdat[i] != rxdat[i]) {
nhard=nhard+1;
if(workdat[i] != rxdat2[i]) {
nsoft=nsoft+rxprob[i];
}
}
}
nsoft=63*nsoft/nsum;
ntotal=nsoft+nhard;
getpp_(workdat,&pp);
if(pp>pp1) {
pp2=pp1;
pp1=pp;
nsoft_min=nsoft;
nhard_min=nhard;
ntotal_min=ntotal;
memcpy(correct,workdat,63*sizeof(int));
nera_best=numera;
ntry[0]=k;
} else {
if(pp>pp2 && pp!=pp1) pp2=pp;
}
if(nhard_min <= 41 && ntotal_min <= 71) break;
}
if(k == ntrials) ntry[0]=k;
}
param[0]=ncandidates;
param[1]=nhard_min;
param[2]=nsoft_min;
param[3]=nera_best;
param[4]=1000.0*pp2/pp1;
param[5]=ntotal_min;
param[6]=ntry[0];
param[7]=1000.0*pp2;
param[8]=1000.0*pp1;
if(param[0]==0) param[2]=-1;
return;
}

99
map65/libm65/gen65.f90 Normal file
View File

@ -0,0 +1,99 @@
subroutine gen65(message,mode65,samfac,nsendingsh,msgsent,iwave,nwave)
! Encodes a JT65 message into a wavefile.
! Executes in 17 ms on opti-745.
use packjt
parameter (NMAX=2*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,itype) !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
dphi=twopi*dt*f0
i=0
k=0
do j=1,nsym
if(message(1:5).ne.'@TUNE') then
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
endif
do ii=1,nsps
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
i=i+1
iwave(2*i-1)=32767.0*cos(xphi)
iwave(2*i)=32767.0*sin(xphi)
enddo
enddo
iwave(2*nsym*nsps+1:)=0
nwave=2*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

77
map65/libm65/gen_q65_wave.f90 Normal file
View File

@ -0,0 +1,77 @@
subroutine gen_q65_wave(msg,ichk,ntxfreq,mode65,itype,msgsent,iwave,nwave)
! Encodes a QRA64 message to yield complex iwave() at fsample = 11025 Hz
use packjt
parameter (NMAX=2*60*11025)
character*22 msg
character*22 msgsent !Message as it will be received
character*120 cmnd
character*80 wsjtx_dir
character*16 cjunk
real*8 t,dt,phi,f,f0,dfgen,dphi,twopi,tsym
integer itone(85)
integer dgen(13)
integer sent(63)
integer*2 iwave(NMAX)
integer icos7(0:6)
logical first
data icos7/2,5,6,0,4,1,3/ !Defines a 7x7 Costas array
data twopi/6.283185307179586476d0/,first/.true./
save
if(first) then
open(9,file='wsjtx_dir.txt',status='old')
read(9,*) wsjtx_dir
close(9)
first=.false.
endif
msgsent=msg
! 1 2 3 4 5
! 12345678901234567890123456789012345678901234567890123456789012345
cmnd='q65sim "K1ABC W9XYZ EN37 " A 1500 0 0 0 0 60 0 99 >itone.txt'
cmnd(9:30)=msg
write(cmnd(35:38),'(i4)') ntxfreq
cmnd=trim(wsjtx_dir)//cmnd
call execute_command_line(cmnd)
open(9,file='itone.txt',status='old')
do i=1,99
read(9,1000,end=999) cjunk
1000 format(a16)
if(cjunk.eq.'Channel symbols:') exit
enddo
read(9,1002) itone
1002 format(20i3)
! Set up necessary constants
nsym=85
tsym=7200.d0/12000.d0
dt=1.d0/11025.d0
f0=ntxfreq
ndf=2**(mode65-1)
dfgen=ndf*12000.d0/7200.d0
phi=0.d0
dphi=twopi*dt*f0
i=0
iz=85*7200*11025.d0/12000.d0
t=0.d0
j0=0
do i=1,iz
t=t+dt
j=t/tsym
if(j.ne.j0) then
f=f0 + itone(j)*dfgen
dphi=twopi*dt*f
j0=j
endif
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
iwave(2*i-1)=32767.0*cos(xphi)
iwave(2*i)=32767.0*sin(xphi)
enddo
nwave=2*iz
999 return
end subroutine gen_q65_wave

87
map65/libm65/genqra64a.f90 Normal file
View File

@ -0,0 +1,87 @@
subroutine genqra64a(msg0,ichk,ntxfreq,mode64,itype,msgsent,iwave,nwave)
! Encodes a QRA64 message to yield itone(1:84)
use packjt
parameter (NMAX=2*60*11025)
character*22 msg0
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
integer itone(84)
character*3 cok !' ' or 'OOO'
real*8 t,dt,phi,f,f0,dfgen,dphi,twopi,samfac,tsym
integer dgen(13)
integer sent(63)
integer*2 iwave(NMAX)
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/ !Defines a 7x7 Costas array
data twopi/6.283185307179586476d0/
save
if(msg0(1:1).eq.'@') then
read(msg0(2:5),*,end=1,err=1) nfreq
go to 2
1 nfreq=1000
2 itone(1)=nfreq
write(msgsent,1000) nfreq
1000 format(i5,' Hz')
else
message=msg0
do i=1,22
if(ichar(message(i:i)).eq.0) then
message(i:)=' '
exit
endif
enddo
do i=1,22 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
call chkmsg(message,cok,nspecial,flip)
call packmsg(message,dgen,itype) !Pack message into 72 bits
call unpackmsg(dgen,msgsent) !Unpack to get message sent
if(ichk.ne.0) go to 999 !Return if checking only
call qra64_enc(dgen,sent) !Encode using QRA64
nsync=10
itone(1:7)=nsync*icos7 !Insert 7x7 Costas array in 3 places
itone(8:39)=sent(1:32)
itone(40:46)=nsync*icos7
itone(47:77)=sent(33:63)
itone(78:84)=nsync*icos7
endif
! Set up necessary constants
nsym=84
tsym=6912.d0/12000.d0
samfac=1.d0
dt=1.d0/(samfac*11025.d0)
f0=ntxfreq
ndf=2**(mode64-1)
dfgen=ndf*12000.d0/6912.d0
phi=0.d0
dphi=twopi*dt*f0
i=0
iz=84*6912*11025.d0/12000.d0
t=0.d0
j0=0
do i=1,iz
t=t+dt
j=t/tsym
if(j.ne.j0) then
f=f0 + itone(j)*dfgen
dphi=twopi*dt*f
j0=j
endif
phi=phi+dphi
if(phi.gt.twopi) phi=phi-twopi
xphi=phi
iwave(2*i-1)=32767.0*cos(xphi)
iwave(2*i)=32767.0*sin(xphi)
enddo
nwave=2*iz
999 return
end subroutine genqra64a

17
map65/libm65/geocentric.f90 Normal file
View File

@ -0,0 +1,17 @@
subroutine geocentric(alat,elev,hlt,erad)
implicit real*8 (a-h,o-z)
! 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

18
map65/libm65/getdphi.f90 Normal file
View File

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

96
map65/libm65/getpfx1.f90 Normal file
View File

@ -0,0 +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.f90'
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

24
map65/libm65/getpfx2.f90 Normal file
View File

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

28
map65/libm65/gran.c Normal file
View File

@ -0,0 +1,28 @@
#include <stdlib.h>
#include <math.h>
/* 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;
}

10
map65/libm65/graycode.f90 Normal file
View File

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

9
map65/libm65/graycode65.f90 Normal file
View File

@ -0,0 +1,9 @@
subroutine graycode65(dat,n,idir)
integer dat(n)
do i=1,n
dat(i)=igray(dat(i),idir)
enddo
return
end subroutine graycode65

38
map65/libm65/grid2deg.f90 Normal file
View File

@ -0,0 +1,38 @@
subroutine grid2deg(grid0,dlong,dlat)
! Converts Maidenhead grid locator to degrees of West longitude
! and North latitude.
character*6 grid0,grid
character*1 g1,g2,g3,g4,g5,g6
grid=grid0
i=ichar(grid(5:5))
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)= &
char(ichar(grid(1:1))+ichar('A')-ichar('a'))
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)= &
char(ichar(grid(2:2))+ichar('A')-ichar('a'))
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)= &
char(ichar(grid(5:5))-ichar('A')+ichar('a'))
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)= &
char(ichar(grid(6:6))-ichar('A')+ichar('a'))
g1=grid(1:1)
g2=grid(2:2)
g3=grid(3:3)
g4=grid(4:4)
g5=grid(5:5)
g6=grid(6:6)
nlong = 180 - 20*(ichar(g1)-ichar('A'))
n20d = 2*(ichar(g3)-ichar('0'))
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
dlong = nlong - n20d - xminlong/60.0
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
dlat = nlat + xminlat/60.0
return
end subroutine grid2deg

12
map65/libm65/grid2k.f90 Normal file
View File

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

22
map65/libm65/igray.c Normal file
View File

@ -0,0 +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);
}

91
map65/libm65/indexx.f90 Normal file
View File

@ -0,0 +1,91 @@
subroutine indexx(arr,n,indx)
parameter (M=7,NSTACK=50)
integer n,indx(n)
real arr(n)
integer i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
real a
do j=1,n
indx(j)=j
enddo
jstack=0
l=1
ir=n
1 if(ir-l.lt.M) then
do j=l+1,ir
indxt=indx(j)
a=arr(indxt)
do i=j-1,1,-1
if(arr(indx(i)).le.a) goto 2
indx(i+1)=indx(i)
enddo
i=0
2 indx(i+1)=indxt
enddo
if(jstack.eq.0) return
ir=istack(jstack)
l=istack(jstack-1)
jstack=jstack-2
else
k=(l+ir)/2
itemp=indx(k)
indx(k)=indx(l+1)
indx(l+1)=itemp
if(arr(indx(l+1)).gt.arr(indx(ir))) then
itemp=indx(l+1)
indx(l+1)=indx(ir)
indx(ir)=itemp
endif
if(arr(indx(l)).gt.arr(indx(ir))) then
itemp=indx(l)
indx(l)=indx(ir)
indx(ir)=itemp
endif
if(arr(indx(l+1)).gt.arr(indx(l))) then
itemp=indx(l+1)
indx(l+1)=indx(l)
indx(l)=itemp
endif
i=l+1
j=ir
indxt=indx(l)
a=arr(indxt)
3 continue
i=i+1
if(arr(indx(i)).lt.a) goto 3
4 continue
j=j-1
if(arr(indx(j)).gt.a) goto 4
if(j.lt.i) goto 5
itemp=indx(i)
indx(i)=indx(j)
indx(j)=itemp
goto 3
5 indx(l)=indx(j)
indx(j)=indxt
jstack=jstack+2
if(jstack.gt.NSTACK) stop 'NSTACK too small in indexx'
if(ir-i+1.ge.j-l)then
istack(jstack)=ir
istack(jstack-1)=i
ir=j-1
else
istack(jstack)=j-1
istack(jstack-1)=l
l=i
endif
endif
goto 1
end subroutine indexx

124
map65/libm65/init_rs.c Normal file
View File

@ -0,0 +1,124 @@
/* 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
void FREE_RS(void *p){
struct rs *rs = (struct rs *)p;
free(rs->alpha_to);
free(rs->index_of);
free(rs->genpoly);
free(rs);
}
/* Initialize a Reed-Solomon codec
* symsize = symbol size, bits (1-8)
* gfpoly = Field generator polynomial coefficients
* fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of roots)
*/
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned fcr,unsigned prim,
unsigned int nroots){
struct rs *rs;
int i, j, sr,root,iprim;
<<<<<<< HEAD:lib/init_rs.c
/* Check parameter ranges */
if(symsize < 0 || symsize > (int)(8*sizeof(DTYPE)))
=======
if(symsize > 8*sizeof(DTYPE))
>>>>>>> 280c8344cd80339491e9bad1dcc4ac9a1e5f684e:map65/libm65/init_rs.c
return NULL; /* Need version with ints rather than chars */
if(fcr >= (1<<symsize))
return NULL;
if(prim == 0 || prim >= (1<<symsize))
return NULL;
if(nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */
rs = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize;
rs->nn = (1<<symsize)-1;
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;
}

54
map65/libm65/int.h Normal file
View File

@ -0,0 +1,54 @@
/* Include file to configure the RS codec for integer symbols
*
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#define DTYPE int
/* Reed-Solomon codec control block */
struct rs {
unsigned int mm; /* Bits per symbol */
unsigned int nn; /* Symbols per block (= (1<<mm)-1) */
int *alpha_to; /* log lookup table */
int *index_of; /* Antilog lookup table */
int *genpoly; /* Generator polynomial */
unsigned int nroots; /* Number of generator roots = number of parity symbols */
unsigned int fcr; /* First consecutive root, index form */
unsigned int prim; /* Primitive element, index form */
unsigned int iprim; /* prim-th root of 1, index form */
};
static inline 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 FCR (rs->fcr)
#define PRIM (rs->prim)
#define IPRIM (rs->iprim)
#define A0 (NN)
#define ENCODE_RS encode_rs_int
#define DECODE_RS decode_rs_int
#define INIT_RS init_rs_int
#define FREE_RS free_rs_int
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras, int calc_syn);
void *INIT_RS(unsigned int symsize,unsigned int gfpoly,unsigned int fcr,
unsigned int prim,unsigned int nroots);
void FREE_RS(void *p);

25
map65/libm65/interleave63.f90 Normal file
View File

@ -0,0 +1,25 @@
subroutine interleave63(d1,idir)
! Interleave (idir=1) or de-interleave (idir=-1) the array d1.
integer d1(0:6,0:8)
integer d2(0:8,0:6)
if(idir.ge.0) then
do i=0,6
do j=0,8
d2(j,i)=d1(i,j)
enddo
enddo
call move(d2,d1,63)
else
call move(d1,d2,63)
do i=0,6
do j=0,8
d1(i,j)=d2(j,i)
enddo
enddo
endif
return
end subroutine interleave63

34
map65/libm65/ipcomm.cpp Normal file
View File

@ -0,0 +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();}

30
map65/libm65/iqcal.f90 Normal file
View File

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

29
map65/libm65/iqfix.f90 Normal file
View File

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

47
map65/libm65/jt65code.f90 Normal file
View File

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

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