w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-10-30 20:40:28 -04:00
Code Issues Packages Projects Releases Wiki Activity

initial import

Browse Source 
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/WSJT/trunk@1 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor 2005-12-22 16:40:53 +00:00
commit 2c17544f3f
174 changed files with 31529 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
Announce.txt Normal file
View File

@ -0,0 +1,91 @@
To: Users of WSJT
From: Joe Taylor, K1JT
Subject: WSJT 5.9.0
Date: November 14, 2005
I am pleased to announce that WSJT 5.9.0 is available for free
download from the WSJT Home Page,
http://pulsar.princeton.edu/~joe/K1JT. It should appear soon
on the European mirror site, http://www.dk5ya.de, as well.
I believe that all reported bugs found in beta-release version 5.8.6
have been fixed. In addition, new enhancements have taken the program
well beyond the capabilities of the baseline comparison versions,
4.9.8 and 5.8.6.
The new WSJT 5.9.0 is faster and better than previous versions in a
number of ways. A brief description of the enhancements since version
5.8.6 can be found at
http://pulsar.princeton.edu/~joe/K1JT/UpdateHistory.txt. There are
many program changes, so be sure to read this information carefully
before trying to use WSJT 5.9.0!
Of course there may be some new bugs, and perhaps I have overlooked an
existing problem that you already know about. Please let me know if
you find shortcomings in version 5.9.0, or if you have suggestions for
further improvements.
Sorry, I have not yet found time to implement EME Echo mode. When
that is done, and when I have finished some further enhancements to
the decoders, WSJT 6.0 will be born. With some luck, there may also
be a new User's Guide at about that time.
With best wishes,
-- 73, Joe, K1JT
Additional Information for Programmers
-----------------------------------------------------------------------
WSJT versions 5.8+ are the result of a complete re-write of the user
interface, timing control, and audio I/O portions of WSJT 4.9.8. My
principal motivation was to make the program multi-threaded, both for
real-time operational convenience and for performance reasons.
Another strong motivation was a desire to move the program away from
its dependence on a proprietary compiler (Microsoft Visual Basic) and
a single computer platform (Windows).
The user interface of WSJT 5.8+ is written in Python -- an elegant,
open, cross-platform language that has been a pleasure for me to
learn. The remainder of the program is written mostly in Fortran,
with some routines coded in C; much of that code has been carried over
directly from WSJT 4.9.8.
I hope soon to release the source code for WSJT under the GNU General
Public License (GPL). To this end, I have separated out the one piece
of proprietary code formerly in the program -- the soft-decision Reed
Solomon decoder licensed from CodeVector Technologies (CVT). A driver
for this decoder, optimized for JT65, has been compiled into a
stand-alone executable that is now distributed as part of the WSJT
installation package, but not part of the program itself. With this
approach I can honor all provisions of the CVT license, and at the
same time release everything else as an open source program under the
GPL.
WSJT 5.9.0 now includes an open source hard-decision Reed Solomon
decoder based on code written by Phil Karn, KA9Q . WSJT uses this
decoder automatically if the proprietary CVT decoder is unavailable.
In such instances the "deep search" decodes retain their full
sensitivity, but fully general decoding independent of the callsign
database will be less sensitive by 2 or more dB, depending on signal
fading characteristics. Separation of the program into two executable
units is transparent to the user.
WSJT 5.9.0 uses the following open source libraries, which are also
available under the GPL:
1. FFTW, by Matteo Frigo and Steven Johnson, for computing Fourier
transforms
2. "Secret Rabbit Code" or "libsamplerate", by Erik de Castro, for
accomplishing band-limited resampling of data
3. RS, by Phil Karn, KA9Q, for Reed Solomon encoding and
hard-decision decoding.
I hope that the open release of WSJT source code will encourage others
to read and understand the code, get involved in improving WSJT, and
perhaps porting it to other platforms. Versions of the CVT
soft-decision decoder for Linux or Macintosh will be easy to compile
and distribute, if there is demand for them.

1248
Audio.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

4732
CALL3.TXT Normal file
View File

File diff suppressed because it is too large Load Diff

172
CVS/Entries Normal file
View File

@ -0,0 +1,172 @@
/Announce.txt/1.1.1.1/Tue Nov 29 21:01:13 2005//
/Audio.f90/1.11/Wed Dec 21 17:35:26 2005//
/CALL3.TXT/1.2/Mon Dec 19 15:29:25 2005//
/GeoDist.f/1.2/Mon Dec 19 15:29:25 2005//
/JT65code/1.2/Mon Dec 19 15:29:25 2005//
/JT65code.f/1.2/Mon Dec 19 15:29:25 2005//
/JT65code_all.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/KVASD/1.1/Thu Dec 22 16:28:01 2005/-kb/
/LICENSE.TXT/1.1/Fri Dec 16 19:34:15 2005//
/Makefile/1.1.1.1/Tue Nov 29 21:01:13 2005//
/Makefile_0.Win/1.1.1.1/Tue Nov 29 21:01:13 2005//
/MoonDop.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/Pmw.py/1.1/Thu Dec 22 16:17:23 2005//
/PmwBlt.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/PmwColor.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/README.TXT/1.1.1.1/Tue Nov 29 21:01:13 2005//
/TSKY.DAT/1.3/Wed Nov 30 15:59:01 2005/-kb/
/WSJT_Source_Code.txt/1.5/Tue Dec 20 21:58:37 2005//
/abc441.f90/1.1.1.1/Tue Nov 29 21:01:13 2005//
/afc65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/astro.f/1.3/Mon Dec 19 22:06:52 2005//
/astro.py/1.3/Wed Dec 21 15:22:16 2005//
/astropak.f/1.3/Mon Dec 19 19:27:21 2005//
/avecom.h/1.1.1.1/Tue Nov 29 21:01:13 2005//
/avemsg65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/avemsg6m.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/avesp2.f/1.2/Mon Dec 19 15:29:25 2005//
/azdist.f/1.2/Mon Dec 19 15:29:25 2005//
/blanker.f90/1.1.1.1/Tue Nov 29 21:01:13 2005//
/bzap.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/char.h/1.1.1.1/Tue Nov 29 21:01:13 2005//
/chkmsg.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/clean.bat/1.1.1.1/Tue Nov 29 21:01:13 2005//
/coord.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/cutil.c/1.1/Mon Dec 19 22:06:52 2005//
/db.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/dcoord.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/decode65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/decode6m.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/decode_rs.c/1.1.1.1/Tue Nov 29 21:01:13 2005//
/deep65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/deg2grid.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/demod64a.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/detect.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/dot.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/encode65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/encode_rs.c/1.1.1.1/Tue Nov 29 21:01:13 2005//
/extract.f/1.3/Tue Dec 20 19:17:40 2005//
/f2py.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/fftw3.dll/1.1/Wed Nov 30 14:57:18 2005/-kb/
/fftw3.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/fftw3single.lib/1.4/Wed Nov 30 14:55:21 2005/-kb/
/fivehz.f90/1.2/Mon Dec 19 15:29:25 2005//
/flat1.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/flat2.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/flatten.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/four2.f/1.1/Mon Dec 19 15:29:25 2005//
/four2a.f/1.2/Mon Dec 19 15:29:25 2005//
/fsubs.f/1.4/Mon Dec 19 22:15:55 2005//
/fsubs1.f/1.2/Mon Dec 19 19:27:21 2005//
/ftsky.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/g.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/g0/1.2/Mon Dec 19 15:29:25 2005//
/g0.bat/1.1.1.1/Tue Nov 29 21:01:13 2005//
/g1/1.6/Wed Dec 21 20:57:22 2005//
/g1.bat/1.3/Mon Dec 19 19:27:21 2005//
/g1fftw.bat/1.1.1.1/Tue Nov 29 21:01:13 2005//
/g2/1.4/Wed Dec 21 20:57:22 2005//
/g2.bat/1.2/Wed Dec 21 16:51:10 2005//
/g3/1.2/Wed Dec 21 16:52:19 2005//
/g3.bat/1.1.1.1/Tue Nov 29 21:01:13 2005//
/g99/1.2/Thu Dec 22 16:29:41 2005//
/g99.bat/1.2/Wed Nov 30 15:53:27 2005//
/gasdev.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/gcom1.f90/1.2/Mon Dec 19 15:29:25 2005//
/gcom2.f90/1.2/Mon Dec 19 15:29:25 2005//
/gcom3.f90/1.2/Mon Dec 19 15:29:25 2005//
/gcom4.f90/1.2/Mon Dec 19 15:29:25 2005//
/gen65.f/1.2/Mon Dec 19 15:29:25 2005//
/gen6m.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/gencw.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/gencwid.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/gentone.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/geocentric.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/getpfx1.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/getpfx2.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/getsnr.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/glpr/1.1.1.1/Tue Nov 29 21:01:13 2005//
/go/1.1/Mon Dec 19 15:29:25 2005//
/go.bat/1.1.1.1/Tue Nov 29 21:01:13 2005//
/go.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/graycode.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/grid2deg.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/grid2k.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/igray.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/indexx.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/init_rs.c/1.1.1.1/Tue Nov 29 21:01:13 2005//
/int.h/1.1.1.1/Tue Nov 29 21:01:13 2005//
/interleave63.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/jtaudio.c/1.4/Mon Dec 19 20:30:20 2005//
/k2grid.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/libsamplerate.dll/1.1/Wed Nov 30 14:57:18 2005/-kb/
/libsamplerate.lib/1.4/Wed Nov 30 14:55:21 2005/-kb/
/limit.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/longx.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/lpf1.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/makedate.f90/1.4/Mon Dec 19 20:30:20 2005//
/moon2.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/morse.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/mtdecode.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/nchar.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/options.py/1.3/Wed Dec 21 15:22:16 2005//
/pa.lib/1.4/Wed Nov 30 14:55:21 2005/-kb/
/packcall.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/packdxcc.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/packgrid.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/packmsg.f/1.2/Mon Dec 19 15:29:25 2005//
/packtext.f/1.2/Mon Dec 19 15:29:25 2005//
/padevsub.c/1.1.1.1/Tue Nov 29 21:01:13 2005//
/palettes.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/pctile.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/peakup.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/pfx.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/ping.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/pix2d.f90/1.1.1.1/Tue Nov 29 21:01:13 2005//
/pix2d65.f90/1.1.1.1/Tue Nov 29 21:01:13 2005//
/portaudio.h/1.1/Tue Nov 29 21:27:24 2005//
/prcom.h/1.1.1.1/Tue Nov 29 21:01:13 2005//
/ps.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/ptt.c/1.1.1.1/Tue Nov 29 21:01:13 2005//
/ptt_linux.c/1.1/Mon Dec 19 15:29:25 2005//
/ran1.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/resample.c/1.1.1.1/Tue Nov 29 21:01:13 2005//
/rfile2.f/1.1/Mon Dec 19 22:06:52 2005//
/rs.h/1.1.1.1/Tue Nov 29 21:01:13 2005//
/runqqq.f90/1.6/Tue Dec 20 21:32:42 2005//
/s2shape.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/samplerate.h/1.1.1.1/Tue Nov 29 21:01:13 2005//
/set.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/setup65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/short65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/slope.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/smeter.py/1.1.1.1/Tue Nov 29 21:01:13 2005//
/smooth.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/sort.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/spec2d.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/spec2d65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/spec441.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/specjt.py/1.4/Wed Dec 21 15:22:16 2005//
/start_threads.c/1.1/Thu Dec 22 16:21:13 2005//
/stdecode.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/sun.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/sync.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/sync65.f/1.2/Mon Dec 19 15:29:25 2005//
/syncf0.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/syncf1.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/synct.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/toxyz.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/unpackcall.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/unpackgrid.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/unpackmsg.f/1.2/Mon Dec 19 15:29:25 2005//
/unpacktext.f/1.2/Mon Dec 19 15:29:25 2005//
/wrapkarn.c/1.2/Tue Nov 29 21:27:24 2005//
/wsjt.ico/1.3/Wed Nov 30 15:43:28 2005/-kb/
/wsjt.py/1.9/Wed Dec 21 20:57:22 2005//
/wsjt1.f/1.2/Mon Dec 19 15:29:25 2005//
/wsjt65.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/wsjtgen.f90/1.2/Mon Dec 19 15:29:25 2005//
/wsjtrc/1.1/Mon Dec 19 15:29:25 2005//
/xcor.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
/xfft.f/1.1.1.1/Tue Nov 29 21:01:13 2005//
D

1
CVS/Repository Normal file
View File

@ -0,0 +1 @@
WSJT

1
CVS/Root Normal file
View File

@ -0,0 +1 @@
/home/joe/cvsroot

103
GeoDist.f Normal file
View File

@ -0,0 +1,103 @@
subroutine geodist(Eplat, Eplon, Stlat, Stlon,
+ Az, Baz, Dist)
implicit none
real eplat, eplon, stlat, stlon, az, baz, dist, deg
C JHT: In actual fact, I use the first two arguments for "My Location",
C the second two for "His location"; West longitude is positive.
c
c
c Taken directly from:
c Thomas, P.D., 1970, Spheroidal geodesics, reference systems,
c & local geometry, U.S. Naval Oceanographic Office SP-138,
c 165 pp.
c
c assumes North Latitude and East Longitude are positive
c
c EpLat, EpLon = End point Lat/Long
c Stlat, Stlon = Start point lat/long
c Az, BAz = direct & reverse azimuith
c Dist = Dist (km); Deg = central angle, discarded
c
real BOA, F, P1R, P2R, L1R, L2R, DLR, T1R, T2R, TM,
+ DTM, STM, CTM, SDTM,CDTM, KL, KK, SDLMR, L,
+ CD, DL, SD, T, U, V, D, X, E, Y, A, FF64, TDLPM,
+ HAPBR, HAMBR, A1M2, A2M1
real AL,BL,D2R,Pi2
data AL/6378206.4/ ! Clarke 1866 ellipsoid
data BL/6356583.8/
c real pi /3.14159265359/
data D2R/0.01745329251994/ ! degrees to radians conversion factor
data Pi2/6.28318530718/
BOA = BL/AL
F = 1.0 - BOA
c convert st/end pts to radians
P1R = Eplat * D2R
P2R = Stlat * D2R
L1R = Eplon * D2R
L2R = StLon * D2R
DLR = L2R - L1R ! DLR = Delta Long in Rads
T1R = ATan(BOA * Tan(P1R))
T2R = ATan(BOA * Tan(P2R))
TM = (T1R + T2R) / 2.0
DTM = (T2R - T1R) / 2.0
STM = Sin(TM)
CTM = Cos(TM)
SDTM = Sin(DTM)
CDTM = Cos(DTM)
KL = STM * CDTM
KK = SDTM * CTM
SDLMR = Sin(DLR/2.0)
L = SDTM * SDTM + SDLMR * SDLMR * (CDTM * CDTM - STM * STM)
CD = 1.0 - 2.0 * L
DL = ACos(CD)
SD = Sin(DL)
T = DL/SD
U = 2.0 * KL * KL / (1.0 - L)
V = 2.0 * KK * KK / L
D = 4.0 * T * T
X = U + V
E = -2.0 * CD
Y = U - V
A = -D * E
FF64 = F * F / 64.0
Dist = AL*SD*(T -(F/4.0)*(T*X-Y)+FF64*(X*(A+(T-(A+E)
+ /2.0)*X)+Y*(-2.0*D+E*Y)+D*X*Y))/1000.0
Deg = Dist/111.195
TDLPM = Tan((DLR+(-((E*(4.0-X)+2.0*Y)*((F/2.0)*T+FF64*
+ (32.0*T+(A-20.0*T)*X-2.0*(D+2.0)*Y))/4.0)*Tan(DLR)))/2.0)
HAPBR = ATan2(SDTM,(CTM*TDLPM))
HAMBR = Atan2(CDTM,(STM*TDLPM))
A1M2 = Pi2 + HAMBR - HAPBR
A2M1 = Pi2 - HAMBR - HAPBR
1 If ((A1M2 .ge. 0.0) .AND. (A1M2 .lt. Pi2)) GOTO 5
2 If (A1M2 .lt. Pi2) GOTO 4
3 A1M2 = A1M2 - Pi2
GOTO 1
4 A1M2 = A1M2 + Pi2
GOTO 1
c
c all of this gens the proper az, baz (forward and back azimuth)
c
5 If ((A2M1 .ge. 0.0) .AND. (A2M1 .lt. Pi2)) GOTO 9
6 If (A2M1 .lt. Pi2) GOTO 8
7 A2M1 = A2M1 - Pi2
GOTO 5
8 A2M1 = A2M1 + Pi2
GOTO 5
9 Az = A1M2 / D2R
BAZ = A2M1 / D2R
c
c Fix the mirrored coords here.
c
az = 360.0 - az
baz = 360.0 - baz
end

BIN
JT65code Executable file
View File

Binary file not shown.

46
JT65code.f Normal file
View File

@ -0,0 +1,46 @@
program JT65karn
C Provides examples of message packing, bit and symbol ordering,
C Reed Solomon encoding, and other necessary details of the JT65
C 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 the 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

21
JT65code_all.f Normal file
View File

@ -0,0 +1,21 @@
include 'JT65code.f'
include 'nchar.f'
include 'grid2deg.f'
include 'packmsg.f'
include 'packtext.f'
include 'packcall.f'
include 'packgrid.f'
include 'unpackmsg.f'
include 'unpacktext.f'
include 'unpackcall.f'
include 'unpackgrid.f'
include 'deg2grid.f'
include 'chkmsg.f'
include 'getpfx1.f'
include 'getpfx2.f'
include 'k2grid.f'
include 'grid2k.f'
include 'interleave63.f'
include 'graycode.f'
include 'set.f'
include 'igray.f'

BIN
KVASD Executable file
View File

Binary file not shown.

344
LICENSE.TXT Executable file
View File

@ -0,0 +1,344 @@
The source code for WSJT is made available under the GNU General
Public License.
#####################################################################
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

29
Makefile Normal file
View File

@ -0,0 +1,29 @@
gcc = CC
FC = g77
FFLAGS = -O -Wall -fbounds-check
OBJS1 = JT65code.o nchar.o grid2deg.o packmsg.o packtext.o \
packcall.o packgrid.o unpackmsg.o unpacktext.o unpackcall.o \
unpackgrid.o deg2grid.o packdxcc.o chkmsg.o getpfx1.o \
getpfx2.o k2grid.o grid2k.o interleave63.o graycode.o set.o \
igray.o init_rs_int.o encode_rs_int.o decode_rs_int.o \
wrapkarn.o
all: JT65code
JT65code: $(OBJS1)
$(FC) -o JT65code $(OBJS1)
init_rs_int.o: init_rs.c
$(CC) -c -DBIGSYM=1 -o init_rs_int.o init_rs.c
encode_rs_int.o: encode_rs.c
$(CC) -c -DBIGSYM=1 -o encode_rs_int.o encode_rs.c
decode_rs_int.o: decode_rs.c
$(CC) -c -DBIGSYM=1 -o decode_rs_int.o decode_rs.c
.PHONY : clean
clean:
-rm *.o JT65code

31
Makefile_0.Win Normal file
View File

@ -0,0 +1,31 @@
#Makefile for WSJT
!include <dfinc.mak>
OBJS1 = pa_lib.o pa_win_mme.o jtaudio.o ...
# Much more to be done, if this is to work!
all: xcomdat.dll specjt2.dll tstsp.exe a2d.exe
xcomdat.dll xcomdat.lib: xcomdat.f xcom.f
$(FOR) $(fflags) xcomdat.f /dll /link /section:.data,RWS
specjt2.dll: specjt2.f xcom.f
$(FOR) $(fflags) specjt2.f /dll xcomdat.lib
tstsp.exe: tstsp.f xcomdat.lib
$(FOR) $(fflags) tstsp.f xcomdat.lib specjt2.lib
a2d.exe: a2d.f jtaudio.obj xcomdat.lib
$(FOR) $(fflags) /traceback /check:all a2d.f $(OBJS3) \
/link winmm.lib xcomdat.lib
clean:
-del xcomdat.dll
-del xcomdat.lib
-del xcomdat.exp
-del specjt2.dll
-del specjt2.lib
-del specjt2.exp
-del tstsp.exe
-del a2d.exe

86
MoonDop.f Normal file
View File

@ -0,0 +1,86 @@
subroutine MoonDop(nyear,month,nday,uth4,lon4,lat4,RAMoon4,
+ DecMoon4,LST4,HA4,AzMoon4,ElMoon4,ldeg4,bdeg4,vr4,dist4)
implicit real*8 (a-h,o-z)
real*4 uth4 !UT in hours
real*4 lon4 !West longitude, degrees
real*4 lat4 !Latitude, degrees
real*4 RAMoon4 !Topocentric RA of moon, hours
real*4 DecMoon4 !Topocentric Dec of Moon, degrees
real*4 LST4 !Locat sidereal time, hours
real*4 HA4 !Local Hour angle, degrees
real*4 AzMoon4 !Topocentric Azimuth of moon, degrees
real*4 ElMoon4 !Topocentric Elevation of moon, degrees
real*4 ldeg4 !Galactic longitude of moon, degrees
real*4 bdeg4 !Galactic latitude of moon, degrees
real*4 vr4 !Radial velocity of moon wrt obs, km/s
real*4 dist4 !Echo time, seconds
real*8 LST
real*8 RME(6) !Vector from Earth center to Moon
real*8 RAE(6) !Vector from Earth center to Obs
real*8 RMA(6) !Vector from Obs to Moon
real*8 pvsun(6)
real*8 rme0(6)
real*8 lrad
logical km,bary
common/stcomx/km,bary,pvsun
data rad/57.2957795130823d0/,twopi/6.28310530717959d0/
pi=0.5d0*twopi
pio2=0.5d0*pi
km=.true.
dlat=lat4/rad
dlong1=lon4/rad
elev1=200.d0
call geocentric(dlat,elev1,dlat1,erad1)
dt=100.d0 !For numerical derivative, in seconds
UT=uth4
C NB: geodetic latitude used here, but geocentric latitude used when
C determining Earth-rotation contribution to Doppler.
call moon2(nyear,month,nDay,UT-dt/3600.d0,dlong1*rad,dlat*rad,
+ RA,Dec,topRA,topDec,LST,HA,Az,El,dist)
call toxyz(RA/rad,Dec/rad,dist,rme0) !Convert to rectangular coords
call moon2(nyear,month,nDay,UT,dlong1*rad,dlat*rad,
+ RA,Dec,topRA,topDec,LST,HA,Az0,El0,dist)
call toxyz(RA/rad,Dec/rad,dist,rme) !Convert to rectangular coords
phi=LST*twopi/24.d0
call toxyz(phi,dlat1,erad1,rae) !Gencentric numbers used here!
radps=twopi/(86400.d0/1.002737909d0)
rae(4)=-rae(2)*radps !Vel of Obs wrt Earth center
rae(5)=rae(1)*radps
rae(6)=0.d0
do i=1,3
rme(i+3)=(rme(i)-rme0(i))/dt
rma(i)=rme(i)-rae(i)
rma(i+3)=rme(i+3)-rae(i+3)
enddo
call fromxyz(rma,alpha1,delta1,dtopo0) !Get topocentric coords
vr=dot(rma(4),rma)/dtopo0
rarad=RA/rad
decrad=Dec/rad
call dcoord(4.635594495d0,-0.504691042d0,3.355395488d0,
+ 0.478220215d0,rarad,decrad,lrad,brad)
RAMoon4=topRA
DecMoon4=topDec
LST4=LST
HA4=HA
AzMoon4=Az
ElMoon4=El
ldeg4=lrad*rad
bdeg4=brad*rad
vr4=vr
dist4=dist
return
end

9233
Pmw.py Normal file
View File

File diff suppressed because it is too large Load Diff

643
PmwBlt.py Normal file
View File

@ -0,0 +1,643 @@
# Python interface to some of the commands of the 2.4 version of the
# BLT extension to tcl.
import string
import types
import Tkinter
# Supported commands:
_busyCommand = '::blt::busy'
_vectorCommand = '::blt::vector'
_graphCommand = '::blt::graph'
_testCommand = '::blt::*'
_chartCommand = '::blt::stripchart'
_tabsetCommand = '::blt::tabset'
_haveBlt = None
_haveBltBusy = None
def _checkForBlt(window):
global _haveBlt
global _haveBltBusy
# Blt may be a package which has not yet been loaded. Try to load it.
try:
window.tk.call('package', 'require', 'BLT')
except Tkinter.TclError:
# Another way to try to dynamically load blt:
try:
window.tk.call('load', '', 'Blt')
except Tkinter.TclError:
pass
_haveBlt= (window.tk.call('info', 'commands', _testCommand) != '')
_haveBltBusy = (window.tk.call('info', 'commands', _busyCommand) != '')
def haveblt(window):
if _haveBlt is None:
_checkForBlt(window)
return _haveBlt
def havebltbusy(window):
if _haveBlt is None:
_checkForBlt(window)
return _haveBltBusy
def _loadBlt(window):
if _haveBlt is None:
if window is None:
window = Tkinter._default_root
if window is None:
window = Tkinter.Tk()
_checkForBlt(window)
def busy_hold(window, cursor = None):
_loadBlt(window)
if cursor is None:
window.tk.call(_busyCommand, 'hold', window._w)
else:
window.tk.call(_busyCommand, 'hold', window._w, '-cursor', cursor)
def busy_release(window):
_loadBlt(window)
window.tk.call(_busyCommand, 'release', window._w)
def busy_forget(window):
_loadBlt(window)
window.tk.call(_busyCommand, 'forget', window._w)
#=============================================================================
# Interface to the blt vector command which makes it look like the
# builtin python list type.
# The -variable, -command, -watchunset creation options are not supported.
# The dup, merge, notify, offset, populate, seq and variable methods
# and the +, -, * and / operations are not supported.
# Blt vector functions:
def vector_expr(expression):
tk = Tkinter._default_root.tk
strList = tk.splitlist(tk.call(_vectorCommand, 'expr', expression))
return tuple(map(string.atof, strList))
def vector_names(pattern = None):
tk = Tkinter._default_root.tk
return tk.splitlist(tk.call(_vectorCommand, 'names', pattern))
class Vector:
_varnum = 0
def __init__(self, size=None, master=None):
# <size> can be either an integer size, or a string "first:last".
_loadBlt(master)
if master:
self._master = master
else:
self._master = Tkinter._default_root
self.tk = self._master.tk
self._name = 'PY_VEC' + str(Vector._varnum)
Vector._varnum = Vector._varnum + 1
if size is None:
self.tk.call(_vectorCommand, 'create', self._name)
else:
self.tk.call(_vectorCommand, 'create', '%s(%s)' % (self._name, size))
def __del__(self):
self.tk.call(_vectorCommand, 'destroy', self._name)
def __str__(self):
return self._name
def __repr__(self):
return '[' + string.join(map(str, self), ', ') + ']'
def __cmp__(self, list):
return cmp(self[:], list)
def __len__(self):
return self.tk.getint(self.tk.call(self._name, 'length'))
def __getitem__(self, key):
oldkey = key
if key < 0:
key = key + len(self)
try:
return self.tk.getdouble(self.tk.globalgetvar(self._name, str(key)))
except Tkinter.TclError:
raise IndexError, oldkey
def __setitem__(self, key, value):
if key < 0:
key = key + len(self)
return self.tk.globalsetvar(self._name, str(key), float(value))
def __delitem__(self, key):
if key < 0:
key = key + len(self)
return self.tk.globalunsetvar(self._name, str(key))
def __getslice__(self, start, end):
length = len(self)
if start < 0:
start = 0
if end > length:
end = length
if start >= end:
return []
end = end - 1 # Blt vector slices include end point.
text = self.tk.globalgetvar(self._name, str(start) + ':' + str(end))
return map(self.tk.getdouble, self.tk.splitlist(text))
def __setslice__(self, start, end, list):
if start > end:
end = start
self.set(self[:start] + list + self[end:])
def __delslice__(self, start, end):
if start < end:
self.set(self[:start] + self[end:])
def __add__(self, list):
return self[:] + list
def __radd__(self, list):
return list + self[:]
def __mul__(self, n):
return self[:] * n
__rmul__ = __mul__
# Python builtin list methods:
def append(self, *args):
self.tk.call(self._name, 'append', args)
def count(self, obj):
return self[:].count(obj)
def index(self, value):
return self[:].index(value)
def insert(self, index, value):
self[index:index] = [value]
def remove(self, value):
del self[self.index(value)]
def reverse(self):
s = self[:]
s.reverse()
self.set(s)
def sort(self, *args):
s = self[:]
s.sort()
self.set(s)
# Blt vector instance methods:
# append - same as list method above
def clear(self):
self.tk.call(self._name, 'clear')
def delete(self, *args):
self.tk.call((self._name, 'delete') + args)
def expr(self, expression):
self.tk.call(self._name, 'expr', expression)
def length(self, newSize=None):
return self.tk.getint(self.tk.call(self._name, 'length', newSize))
def range(self, first, last=None):
# Note that, unlike self[first:last], this includes the last
# item in the returned range.
text = self.tk.call(self._name, 'range', first, last)
return map(self.tk.getdouble, self.tk.splitlist(text))
def search(self, start, end=None):
return self._master._getints(self.tk.call(
self._name, 'search', start, end))
def set(self, list):
if type(list) != types.TupleType:
list = tuple(list)
self.tk.call(self._name, 'set', list)
# The blt vector sort method has different semantics to the python
# list sort method. Call these blt_sort:
def blt_sort(self, *args):
self.tk.call((self._name, 'sort') + args)
def blt_sort_reverse(self, *args):
self.tk.call((self._name, 'sort', '-reverse') + args)
# Special blt vector indexes:
def min(self):
return self.tk.getdouble(self.tk.globalgetvar(self._name, 'min'))
def max(self):
return self.tk.getdouble(self.tk.globalgetvar(self._name, 'max'))
# Method borrowed from Tkinter.Var class:
def get(self):
return self[:]
#=============================================================================
# This is a general purpose configure routine which can handle the
# configuration of widgets, items within widgets, etc. Supports the
# forms configure() and configure('font') for querying and
# configure(font = 'fixed', text = 'hello') for setting.
def _doConfigure(widget, subcommand, option, kw):
if not option and not kw:
# Return a description of all options.
ret = {}
options = widget.tk.splitlist(widget.tk.call(subcommand))
for optionString in options:
optionInfo = widget.tk.splitlist(optionString)
option = optionInfo[0][1:]
ret[option] = (option,) + optionInfo[1:]
return ret
if option:
# Return a description of the option given by <option>.
if kw:
# Having keywords implies setting configuration options.
# Can't set and get in one command!
raise ValueError, 'cannot have option argument with keywords'
option = '-' + option
optionInfo = widget.tk.splitlist(widget.tk.call(subcommand + (option,)))
return (optionInfo[0][1:],) + optionInfo[1:]
# Otherwise, set the given configuration options.
widget.tk.call(subcommand + widget._options(kw))
#=============================================================================
class Graph(Tkinter.Widget):
# Wrapper for the blt graph widget, version 2.4.
def __init__(self, master=None, cnf={}, **kw):
_loadBlt(master)
Tkinter.Widget.__init__(self, master, _graphCommand, cnf, kw)
def bar_create(self, name, **kw):
self.tk.call((self._w, 'bar', 'create', name) + self._options(kw))
def line_create(self, name, **kw):
self.tk.call((self._w, 'line', 'create', name) + self._options(kw))
def extents(self, item):
return self.tk.getint(self.tk.call(self._w, 'extents', item))
def invtransform(self, winX, winY):
return self._getdoubles(
self.tk.call(self._w, 'invtransform', winX, winY))
def inside(self, x, y):
return self.tk.getint(self.tk.call(self._w, 'inside', x, y))
def snap(self, photoName):
self.tk.call(self._w, 'snap', photoName)
def transform(self, x, y):
return self._getdoubles(self.tk.call(self._w, 'transform', x, y))
def axis_cget(self, axisName, key):
return self.tk.call(self._w, 'axis', 'cget', axisName, '-' + key)
def axis_configure(self, axes, option=None, **kw):
# <axes> may be a list of axisNames.
if type(axes) == types.StringType:
axes = [axes]
subcommand = (self._w, 'axis', 'configure') + tuple(axes)
return _doConfigure(self, subcommand, option, kw)
def axis_create(self, axisName, **kw):
self.tk.call((self._w, 'axis', 'create', axisName) + self._options(kw))
def axis_delete(self, *args):
self.tk.call((self._w, 'axis', 'delete') + args)
def axis_invtransform(self, axisName, value):
return self.tk.getdouble(self.tk.call(
self._w, 'axis', 'invtransform', axisName, value))
def axis_limits(self, axisName):
return self._getdoubles(self.tk.call(
self._w, 'axis', 'limits', axisName))
def axis_names(self, *args):
return self.tk.splitlist(
self.tk.call((self._w, 'axis', 'names') + args))
def axis_transform(self, axisName, value):
return self.tk.getint(self.tk.call(
self._w, 'axis', 'transform', axisName, value))
def xaxis_cget(self, key):
return self.tk.call(self._w, 'xaxis', 'cget', '-' + key)
def xaxis_configure(self, option=None, **kw):
subcommand = (self._w, 'xaxis', 'configure')
return _doConfigure(self, subcommand, option, kw)
def xaxis_invtransform(self, value):
return self.tk.getdouble(self.tk.call(
self._w, 'xaxis', 'invtransform', value))
def xaxis_limits(self):
return self._getdoubles(self.tk.call(self._w, 'xaxis', 'limits'))
def xaxis_transform(self, value):
return self.tk.getint(self.tk.call(
self._w, 'xaxis', 'transform', value))
def xaxis_use(self, axisName = None):
return self.tk.call(self._w, 'xaxis', 'use', axisName)
def x2axis_cget(self, key):
return self.tk.call(self._w, 'x2axis', 'cget', '-' + key)
def x2axis_configure(self, option=None, **kw):
subcommand = (self._w, 'x2axis', 'configure')
return _doConfigure(self, subcommand, option, kw)
def x2axis_invtransform(self, value):
return self.tk.getdouble(self.tk.call(
self._w, 'x2axis', 'invtransform', value))
def x2axis_limits(self):
return self._getdoubles(self.tk.call(self._w, 'x2axis', 'limits'))
def x2axis_transform(self, value):
return self.tk.getint(self.tk.call(
self._w, 'x2axis', 'transform', value))
def x2axis_use(self, axisName = None):
return self.tk.call(self._w, 'x2axis', 'use', axisName)
def yaxis_cget(self, key):
return self.tk.call(self._w, 'yaxis', 'cget', '-' + key)
def yaxis_configure(self, option=None, **kw):
subcommand = (self._w, 'yaxis', 'configure')
return _doConfigure(self, subcommand, option, kw)
def yaxis_invtransform(self, value):
return self.tk.getdouble(self.tk.call(
self._w, 'yaxis', 'invtransform', value))
def yaxis_limits(self):
return self._getdoubles(self.tk.call(self._w, 'yaxis', 'limits'))
def yaxis_transform(self, value):
return self.tk.getint(self.tk.call(
self._w, 'yaxis', 'transform', value))
def yaxis_use(self, axisName = None):
return self.tk.call(self._w, 'yaxis', 'use', axisName)
def y2axis_cget(self, key):
return self.tk.call(self._w, 'y2axis', 'cget', '-' + key)
def y2axis_configure(self, option=None, **kw):
subcommand = (self._w, 'y2axis', 'configure')
return _doConfigure(self, subcommand, option, kw)
def y2axis_invtransform(self, value):
return self.tk.getdouble(self.tk.call(
self._w, 'y2axis', 'invtransform', value))
def y2axis_limits(self):
return self._getdoubles(self.tk.call(self._w, 'y2axis', 'limits'))
def y2axis_transform(self, value):
return self.tk.getint(self.tk.call(
self._w, 'y2axis', 'transform', value))
def y2axis_use(self, axisName = None):
return self.tk.call(self._w, 'y2axis', 'use', axisName)
def crosshairs_cget(self, key):
return self.tk.call(self._w, 'crosshairs', 'cget', '-' + key)
def crosshairs_configure(self, option=None, **kw):
subcommand = (self._w, 'crosshairs', 'configure')
return _doConfigure(self, subcommand, option, kw)
def crosshairs_off(self):
self.tk.call(self._w, 'crosshairs', 'off')
def crosshairs_on(self):
self.tk.call(self._w, 'crosshairs', 'on')
def crosshairs_toggle(self):
self.tk.call(self._w, 'crosshairs', 'toggle')
def element_activate(self, name, *args):
self.tk.call((self._w, 'element', 'activate', name) + args)
def element_bind(self, tagName, sequence=None, func=None, add=None):
return self._bind((self._w, 'element', 'bind', tagName),
sequence, func, add)
def element_unbind(self, tagName, sequence, funcid=None):
self.tk.call(self._w, 'element', 'bind', tagName, sequence, '')
if funcid:
self.deletecommand(funcid)
def element_cget(self, name, key):
return self.tk.call(self._w, 'element', 'cget', name, '-' + key)
def element_closest(self, x, y, *args, **kw):
var = 'python_private_1'
success = self.tk.getint(self.tk.call(
(self._w, 'element', 'closest', x, y, var) +
self._options(kw) + args))
if success:
rtn = {}
rtn['dist'] = self.tk.getdouble(self.tk.globalgetvar(var, 'dist'))
rtn['x'] = self.tk.getdouble(self.tk.globalgetvar(var, 'x'))
rtn['y'] = self.tk.getdouble(self.tk.globalgetvar(var, 'y'))
rtn['index'] = self.tk.getint(self.tk.globalgetvar(var, 'index'))
rtn['name'] = self.tk.globalgetvar(var, 'name')
return rtn
else:
return None
def element_configure(self, names, option=None, **kw):
# <names> may be a list of elemNames.
if type(names) == types.StringType:
names = [names]
subcommand = (self._w, 'element', 'configure') + tuple(names)
return _doConfigure(self, subcommand, option, kw)
def element_deactivate(self, *args):
self.tk.call((self._w, 'element', 'deactivate') + args)
def element_delete(self, *args):
self.tk.call((self._w, 'element', 'delete') + args)
def element_exists(self, name):
return self.tk.getboolean(
self.tk.call(self._w, 'element', 'exists', name))
def element_names(self, *args):
return self.tk.splitlist(
self.tk.call((self._w, 'element', 'names') + args))
def element_show(self, nameList=None):
if nameList is not None:
nameList = tuple(nameList)
return self.tk.splitlist(
self.tk.call(self._w, 'element', 'show', nameList))
def element_type(self, name):
return self.tk.call(self._w, 'element', 'type', name)
def grid_cget(self, key):
return self.tk.call(self._w, 'grid', 'cget', '-' + key)
def grid_configure(self, option=None, **kw):
subcommand = (self._w, 'grid', 'configure')
return _doConfigure(self, subcommand, option, kw)
def grid_off(self):
self.tk.call(self._w, 'grid', 'off')
def grid_on(self):
self.tk.call(self._w, 'grid', 'on')
def grid_toggle(self):
self.tk.call(self._w, 'grid', 'toggle')
def legend_activate(self, *args):
self.tk.call((self._w, 'legend', 'activate') + args)
def legend_bind(self, tagName, sequence=None, func=None, add=None):
return self._bind((self._w, 'legend', 'bind', tagName),
sequence, func, add)
def legend_unbind(self, tagName, sequence, funcid=None):
self.tk.call(self._w, 'legend', 'bind', tagName, sequence, '')
if funcid:
self.deletecommand(funcid)
def legend_cget(self, key):
return self.tk.call(self._w, 'legend', 'cget', '-' + key)
def legend_configure(self, option=None, **kw):
subcommand = (self._w, 'legend', 'configure')
return _doConfigure(self, subcommand, option, kw)
def legend_deactivate(self, *args):
self.tk.call((self._w, 'legend', 'deactivate') + args)
def legend_get(self, pos):
return self.tk.call(self._w, 'legend', 'get', pos)
def pen_cget(self, name, key):
return self.tk.call(self._w, 'pen', 'cget', name, '-' + key)
def pen_configure(self, names, option=None, **kw):
# <names> may be a list of penNames.
if type(names) == types.StringType:
names = [names]
subcommand = (self._w, 'pen', 'configure') + tuple(names)
return _doConfigure(self, subcommand, option, kw)
def pen_create(self, name, **kw):
self.tk.call((self._w, 'pen', 'create', name) + self._options(kw))
def pen_delete(self, *args):
self.tk.call((self._w, 'pen', 'delete') + args)
def pen_names(self, *args):
return self.tk.splitlist(self.tk.call((self._w, 'pen', 'names') + args))
def postscript_cget(self, key):
return self.tk.call(self._w, 'postscript', 'cget', '-' + key)
def postscript_configure(self, option=None, **kw):
subcommand = (self._w, 'postscript', 'configure')
return _doConfigure(self, subcommand, option, kw)
def postscript_output(self, fileName=None, **kw):
prefix = (self._w, 'postscript', 'output')
if fileName is None:
return self.tk.call(prefix + self._options(kw))
else:
self.tk.call(prefix + (fileName,) + self._options(kw))
def marker_after(self, first, second=None):
self.tk.call(self._w, 'marker', 'after', first, second)
def marker_before(self, first, second=None):
self.tk.call(self._w, 'marker', 'before', first, second)
def marker_bind(self, tagName, sequence=None, func=None, add=None):
return self._bind((self._w, 'marker', 'bind', tagName),
sequence, func, add)
def marker_unbind(self, tagName, sequence, funcid=None):
self.tk.call(self._w, 'marker', 'bind', tagName, sequence, '')
if funcid:
self.deletecommand(funcid)
def marker_cget(self, name, key):
return self.tk.call(self._w, 'marker', 'cget', name, '-' + key)
def marker_configure(self, names, option=None, **kw):
# <names> may be a list of markerIds.
if type(names) == types.StringType:
names = [names]
subcommand = (self._w, 'marker', 'configure') + tuple(names)
return _doConfigure(self, subcommand, option, kw)
def marker_create(self, type, **kw):
return self.tk.call(
(self._w, 'marker', 'create', type) + self._options(kw))
def marker_delete(self, *args):
self.tk.call((self._w, 'marker', 'delete') + args)
def marker_exists(self, name):
return self.tk.getboolean(
self.tk.call(self._w, 'marker', 'exists', name))
def marker_names(self, *args):
return self.tk.splitlist(
self.tk.call((self._w, 'marker', 'names') + args))
def marker_type(self, name):
type = self.tk.call(self._w, 'marker', 'type', name)
if type == '':
type = None
return type
#=============================================================================
class Stripchart(Graph):
# Wrapper for the blt stripchart widget, version 2.4.
def __init__(self, master=None, cnf={}, **kw):
_loadBlt(master)
Tkinter.Widget.__init__(self, master, _chartCommand, cnf, kw)
#=============================================================================
class Tabset(Tkinter.Widget):
# Wrapper for the blt TabSet widget, version 2.4.
def __init__(self, master=None, cnf={}, **kw):
_loadBlt(master)
Tkinter.Widget.__init__(self, master, _tabsetCommand, cnf, kw)
def activate(self, tabIndex):
self.tk.call(self._w, 'activate', tabIndex)
# This is the 'bind' sub-command:
def tag_bind(self, tagName, sequence=None, func=None, add=None):
return self._bind((self._w, 'bind', tagName), sequence, func, add)
def tag_unbind(self, tagName, sequence, funcid=None):
self.tk.call(self._w, 'bind', tagName, sequence, '')
if funcid:
self.deletecommand(funcid)
def delete(self, first, last = None):
self.tk.call(self._w, 'delete', first, last)
# This is the 'focus' sub-command:
def tab_focus(self, tabIndex):
self.tk.call(self._w, 'focus', tabIndex)
def get(self, tabIndex):
return self.tk.call(self._w, 'get', tabIndex)
def index(self, tabIndex):
index = self.tk.call(self._w, 'index', tabIndex)
if index == '':
return None
else:
return self.tk.getint(self.tk.call(self._w, 'index', tabIndex))
def insert(self, position, name1, *names, **kw):
self.tk.call(
(self._w, 'insert', position, name1) + names + self._options(kw))
def invoke(self, tabIndex):
return self.tk.call(self._w, 'invoke', tabIndex)
def move(self, tabIndex1, beforeOrAfter, tabIndex2):
self.tk.call(self._w, 'move', tabIndex1, beforeOrAfter, tabIndex2)
def nearest(self, x, y):
return self.tk.call(self._w, 'nearest', x, y)
def scan_mark(self, x, y):
self.tk.call(self._w, 'scan', 'mark', x, y)
def scan_dragto(self, x, y):
self.tk.call(self._w, 'scan', 'dragto', x, y)
def see(self, index):
self.tk.call(self._w, 'see', index)
def see(self, tabIndex):
self.tk.call(self._w,'see',tabIndex)
def size(self):
return self.tk.getint(self.tk.call(self._w, 'size'))
def tab_cget(self, tabIndex, option):
if option[:1] != '-':
option = '-' + option
if option[-1:] == '_':
option = option[:-1]
return self.tk.call(self._w, 'tab', 'cget', tabIndex, option)
def tab_configure(self, tabIndexes, option=None, **kw):
# <tabIndexes> may be a list of tabs.
if type(tabIndexes) in (types.StringType, types.IntType):
tabIndexes = [tabIndexes]
subcommand = (self._w, 'tab', 'configure') + tuple(tabIndexes)
return _doConfigure(self, subcommand, option, kw)
def tab_names(self, *args):
return self.tk.splitlist(self.tk.call((self._w, 'tab', 'names') + args))
def tab_tearoff(self, tabIndex, newName = None):
if newName is None:
name = self.tk.call(self._w, 'tab', 'tearoff', tabIndex)
return self.nametowidget(name)
else:
self.tk.call(self._w, 'tab', 'tearoff', tabIndex, newName)
def view(self):
s = self.tk.call(self._w, 'view')
return tuple(map(self.tk.getint, self.tk.splitlist(s)))
def view_moveto(self, fraction):
self.tk.call(self._w, 'view', 'moveto', fraction)
def view_scroll(self, number, what):
self.tk.call(self._w, 'view', 'scroll', number, what)

361
PmwColor.py Normal file
View File

@ -0,0 +1,361 @@
# Functions for converting colors and modifying the color scheme of
# an application.
import math
import string
import sys
import Tkinter
_PI = math.pi
_TWO_PI = _PI * 2
_THIRD_PI = _PI / 3
_SIXTH_PI = _PI / 6
_MAX_RGB = float(256 * 256 - 1) # max size of rgb values returned from Tk
def setscheme(root, background=None, **kw):
root = root._root()
palette = apply(_calcPalette, (root, background,), kw)
for option, value in palette.items():
root.option_add('*' + option, value, 'widgetDefault')
def getdefaultpalette(root):
# Return the default values of all options, using the defaults
# from a few widgets.
ckbtn = Tkinter.Checkbutton(root)
entry = Tkinter.Entry(root)
scbar = Tkinter.Scrollbar(root)
orig = {}
orig['activeBackground'] = str(ckbtn.configure('activebackground')[4])
orig['activeForeground'] = str(ckbtn.configure('activeforeground')[4])
orig['background'] = str(ckbtn.configure('background')[4])
orig['disabledForeground'] = str(ckbtn.configure('disabledforeground')[4])
orig['foreground'] = str(ckbtn.configure('foreground')[4])
orig['highlightBackground'] = str(ckbtn.configure('highlightbackground')[4])
orig['highlightColor'] = str(ckbtn.configure('highlightcolor')[4])
orig['insertBackground'] = str(entry.configure('insertbackground')[4])
orig['selectColor'] = str(ckbtn.configure('selectcolor')[4])
orig['selectBackground'] = str(entry.configure('selectbackground')[4])
orig['selectForeground'] = str(entry.configure('selectforeground')[4])
orig['troughColor'] = str(scbar.configure('troughcolor')[4])
ckbtn.destroy()
entry.destroy()
scbar.destroy()
return orig
#======================================================================
# Functions dealing with brightness, hue, saturation and intensity of colors.
def changebrightness(root, colorName, brightness):
# Convert the color name into its hue and back into a color of the
# required brightness.
rgb = name2rgb(root, colorName)
hue, saturation, intensity = rgb2hsi(rgb)
if saturation == 0.0:
hue = None
return hue2name(hue, brightness)
def hue2name(hue, brightness = None):
# Convert the requested hue and brightness into a color name. If
# hue is None, return a grey of the requested brightness.
if hue is None:
rgb = hsi2rgb(0.0, 0.0, brightness)
else:
while hue < 0:
hue = hue + _TWO_PI
while hue >= _TWO_PI:
hue = hue - _TWO_PI
rgb = hsi2rgb(hue, 1.0, 1.0)
if brightness is not None:
b = rgb2brightness(rgb)
i = 1.0 - (1.0 - brightness) * b
s = bhi2saturation(brightness, hue, i)
rgb = hsi2rgb(hue, s, i)
return rgb2name(rgb)
def bhi2saturation(brightness, hue, intensity):
while hue < 0:
hue = hue + _TWO_PI
while hue >= _TWO_PI:
hue = hue - _TWO_PI
hue = hue / _THIRD_PI
f = hue - math.floor(hue)
pp = intensity
pq = intensity * f
pt = intensity - intensity * f
pv = 0
hue = int(hue)
if hue == 0: rgb = (pv, pt, pp)
elif hue == 1: rgb = (pq, pv, pp)
elif hue == 2: rgb = (pp, pv, pt)
elif hue == 3: rgb = (pp, pq, pv)
elif hue == 4: rgb = (pt, pp, pv)
elif hue == 5: rgb = (pv, pp, pq)
return (intensity - brightness) / rgb2brightness(rgb)
def hsi2rgb(hue, saturation, intensity):
i = intensity
if saturation == 0:
rgb = [i, i, i]
else:
while hue < 0:
hue = hue + _TWO_PI
while hue >= _TWO_PI:
hue = hue - _TWO_PI
hue = hue / _THIRD_PI
f = hue - math.floor(hue)
p = i * (1.0 - saturation)
q = i * (1.0 - saturation * f)
t = i * (1.0 - saturation * (1.0 - f))
hue = int(hue)
if hue == 0: rgb = [i, t, p]
elif hue == 1: rgb = [q, i, p]
elif hue == 2: rgb = [p, i, t]
elif hue == 3: rgb = [p, q, i]
elif hue == 4: rgb = [t, p, i]
elif hue == 5: rgb = [i, p, q]
for index in range(3):
val = rgb[index]
if val < 0.0:
val = 0.0
if val > 1.0:
val = 1.0
rgb[index] = val
return rgb
def average(rgb1, rgb2, fraction):
return (
rgb2[0] * fraction + rgb1[0] * (1.0 - fraction),
rgb2[1] * fraction + rgb1[1] * (1.0 - fraction),
rgb2[2] * fraction + rgb1[2] * (1.0 - fraction)
)
def rgb2name(rgb):
return '#%02x%02x%02x' % \
(int(rgb[0] * 255), int(rgb[1] * 255), int(rgb[2] * 255))
def rgb2brightness(rgb):
# Return the perceived grey level of the color
# (0.0 == black, 1.0 == white).
rf = 0.299
gf = 0.587
bf = 0.114
return rf * rgb[0] + gf * rgb[1] + bf * rgb[2]
def rgb2hsi(rgb):
maxc = max(rgb[0], rgb[1], rgb[2])
minc = min(rgb[0], rgb[1], rgb[2])
intensity = maxc
if maxc != 0:
saturation = (maxc - minc) / maxc
else:
saturation = 0.0
hue = 0.0
if saturation != 0.0:
c = []
for index in range(3):
c.append((maxc - rgb[index]) / (maxc - minc))
if rgb[0] == maxc:
hue = c[2] - c[1]
elif rgb[1] == maxc:
hue = 2 + c[0] - c[2]
elif rgb[2] == maxc:
hue = 4 + c[1] - c[0]
hue = hue * _THIRD_PI
if hue < 0.0:
hue = hue + _TWO_PI
return (hue, saturation, intensity)
def name2rgb(root, colorName, asInt = 0):
if colorName[0] == '#':
# Extract rgb information from the color name itself, assuming
# it is either #rgb, #rrggbb, #rrrgggbbb, or #rrrrggggbbbb
# This is useful, since tk may return incorrect rgb values if
# the colormap is full - it will return the rbg values of the
# closest color available.
colorName = colorName[1:]
digits = len(colorName) / 3
factor = 16 ** (4 - digits)
rgb = (
string.atoi(colorName[0:digits], 16) * factor,
string.atoi(colorName[digits:digits * 2], 16) * factor,
string.atoi(colorName[digits * 2:digits * 3], 16) * factor,
)
else:
# We have no choice but to ask Tk what the rgb values are.
rgb = root.winfo_rgb(colorName)
if not asInt:
rgb = (rgb[0] / _MAX_RGB, rgb[1] / _MAX_RGB, rgb[2] / _MAX_RGB)
return rgb
def _calcPalette(root, background=None, **kw):
# Create a map that has the complete new palette. If some colors
# aren't specified, compute them from other colors that are specified.
new = {}
for key, value in kw.items():
new[key] = value
if background is not None:
new['background'] = background
if not new.has_key('background'):
raise ValueError, 'must specify a background color'
if not new.has_key('foreground'):
new['foreground'] = 'black'
bg = name2rgb(root, new['background'])
fg = name2rgb(root, new['foreground'])
for i in ('activeForeground', 'insertBackground', 'selectForeground',
'highlightColor'):
if not new.has_key(i):
new[i] = new['foreground']
if not new.has_key('disabledForeground'):
newCol = average(bg, fg, 0.3)
new['disabledForeground'] = rgb2name(newCol)
if not new.has_key('highlightBackground'):
new['highlightBackground'] = new['background']
# Set <lighterBg> to a color that is a little lighter that the
# normal background. To do this, round each color component up by
# 9% or 1/3 of the way to full white, whichever is greater.
lighterBg = []
for i in range(3):
lighterBg.append(bg[i])
inc1 = lighterBg[i] * 0.09
inc2 = (1.0 - lighterBg[i]) / 3
if inc1 > inc2:
lighterBg[i] = lighterBg[i] + inc1
else:
lighterBg[i] = lighterBg[i] + inc2
if lighterBg[i] > 1.0:
lighterBg[i] = 1.0
# Set <darkerBg> to a color that is a little darker that the
# normal background.
darkerBg = (bg[0] * 0.9, bg[1] * 0.9, bg[2] * 0.9)
if not new.has_key('activeBackground'):
# If the foreground is dark, pick a light active background.
# If the foreground is light, pick a dark active background.
# XXX This has been disabled, since it does not look very
# good with dark backgrounds. If this is ever fixed, the
# selectBackground and troughColor options should also be fixed.
if rgb2brightness(fg) < 0.5:
new['activeBackground'] = rgb2name(lighterBg)
else:
new['activeBackground'] = rgb2name(lighterBg)
if not new.has_key('selectBackground'):
new['selectBackground'] = rgb2name(darkerBg)
if not new.has_key('troughColor'):
new['troughColor'] = rgb2name(darkerBg)
if not new.has_key('selectColor'):
new['selectColor'] = 'yellow'
return new
def spectrum(numColors, correction = 1.0, saturation = 1.0, intensity = 1.0,
extraOrange = 1, returnHues = 0):
colorList = []
division = numColors / 7.0
for index in range(numColors):
if extraOrange:
if index < 2 * division:
hue = index / division
else:
hue = 2 + 2 * (index - 2 * division) / division
hue = hue * _SIXTH_PI
else:
hue = index * _TWO_PI / numColors
if returnHues:
colorList.append(hue)
else:
rgb = hsi2rgb(hue, saturation, intensity)
if correction != 1.0:
rgb = correct(rgb, correction)
name = rgb2name(rgb)
colorList.append(name)
return colorList
def correct(rgb, correction):
correction = float(correction)
rtn = []
for index in range(3):
rtn.append((1 - (1 - rgb[index]) ** correction) ** (1 / correction))
return rtn
#==============================================================================
def _recolorTree(widget, oldpalette, newcolors):
# Change the colors in a widget and its descendants.
# Change the colors in <widget> and all of its descendants,
# according to the <newcolors> dictionary. It only modifies
# colors that have their default values as specified by the
# <oldpalette> variable. The keys of the <newcolors> dictionary
# are named after widget configuration options and the values are
# the new value for that option.
for dbOption in newcolors.keys():
option = string.lower(dbOption)
try:
value = str(widget.cget(option))
except:
continue
if oldpalette is None or value == oldpalette[dbOption]:
apply(widget.configure, (), {option : newcolors[dbOption]})
for child in widget.winfo_children():
_recolorTree(child, oldpalette, newcolors)
def changecolor(widget, background=None, **kw):
root = widget._root()
if not hasattr(widget, '_Pmw_oldpalette'):
widget._Pmw_oldpalette = getdefaultpalette(root)
newpalette = apply(_calcPalette, (root, background,), kw)
_recolorTree(widget, widget._Pmw_oldpalette, newpalette)
widget._Pmw_oldpalette = newpalette
def bordercolors(root, colorName):
# This is the same method that Tk uses for shadows, in TkpGetShadows.
lightRGB = []
darkRGB = []
for value in name2rgb(root, colorName, 1):
value40pc = (14 * value) / 10
if value40pc > _MAX_RGB:
value40pc = _MAX_RGB
valueHalfWhite = (_MAX_RGB + value) / 2;
lightRGB.append(max(value40pc, valueHalfWhite))
darkValue = (60 * value) / 100
darkRGB.append(darkValue)
return (
'#%04x%04x%04x' % (lightRGB[0], lightRGB[1], lightRGB[2]),
'#%04x%04x%04x' % (darkRGB[0], darkRGB[1], darkRGB[2])
)

150
README.TXT Normal file
View File

@ -0,0 +1,150 @@
Changes in WSJT 5.9.0 -- November 15, 2005
------------------------------------------
1. JT65 decoding has been made faster and significantly improved in
other ways. Three new options appear on the Decode->JT65 menu:
"Fast", "Normal", and "Exhaustive". The program is most sensitive
if you choose "Exhaustive". Choosing "Normal" will make decoding
slightly less sensitive, but the loss is not great, and decoding
can be twice as fast. The "Fast" setting is faster still, but can
be less sensitive by 2 dB or more in some cases. If you have a 1.5
GHz or faster computer, use "Exhaustive". With a slower computer
you may want to experiment with the other settings.
2. In JT65 mode, double-clicking on the waterfall (SpecJT window) or
on the red curve (main window) will set "Freeze DF" at the selected
frequency, turn Freeze ON, and invoke the decoder. Using this
feature, you can quickly decode a transmission at several different
values of DF. I find this feature to be *extremely* useful.
3. The range of DT values searched to establish synchronization has
been doubled, now extending from -2 to +10 seconds. The reported
values of DT are more accurate, as well. You should normally
expect EME signals to have DT in the range 2 to 3 seconds, but the
program will now synchronize properly even if DT is well outside
this range.
4. WSJT now offers the ability to correct for errors in soundcard
input and output sampling rates. Numbers displayed in the first
panel of the status bar (at lower left of the main screen) give the
ratio of actual sample rates for input and output to the correct
value, 11025 Hz. The numbers should stabilize about one minute
after program startup. If they fall in a "safe" range between
about 0.9990 and 1.0010, you have a good sound card (at least in
respect to sampling frequency). You can then leave the entry
fields "Rate In" and "Rate Out" on the "Setup -> Options" page at
their default values, 1.0.
If your soundcard gives one or both numbers well outside the safe
range, you should enter the displayed errant numbers as "Rate In"
and/or "Rate Out" on the Setup->Options page. This needs to be
done only once; subsequent changes in the last decimal place of the
displayed values are not very significant, and can be safely
ignored.
The result of this procedure is that your Tx signal will be
"trimmed" so that your tone spacings in time and frequency are
correct. In addition, your digitized Rx signals will be adjusted
so that the software can properly interpret them.
This is an important procedure. Some recent sound cards produce
sampling error factors as low as 0.9932 or as high as 1.0068. If
uncorrected, such results can degrade your S/N in WSJT modes by 2
dB or more.
If one of the measured sample rates differs from the corresponding
value specified for "Rate In" or "Rate Out" by more than 0.1%, a
red warning label will appear just below the graphical area on the
main screen.
5. Graphical display of information obtained during JT65 decoding has
been enhanced. As before, a red line illustrates the maximum
correlation between the pseudo-random sync tone pattern and the
received signal at each value of frequency offset, DF. A blue line
shows the correlation at the best DF, plotted as a function of time
offset, DT. If a shorthand message is detected, two new lines
colored magenta and orange replace the red and blue lines. The new
lines illustrate phase-resolved spectra measured in each of the two
phases of the shorthand square-wave pattern. A properly detected
shorthand message will show a peak in the magenta curve, followed
at a specified distance by a peak in the orange curve. The correct
locations of the two peaks are marked by small yellow ticks.
Unlike the alternating shorthand message tones, birdies will appear
approximately equally in the magenta and orange curves.
6. For the convenience of temporary DXpeditions, a new JT65 feature
permits use of add-on DXCC prefixes that are not in the published
list of supported prefixes. Both stations in a QSO must enter the
required prefix (for example, PJ8 or FS) in a box on the
Setup->Options page. The effect will be to temporarily add the
entry to the table of supported prefixes.
7. The Setup->Options page has new entry fields labeled "Source RA"
and "Source DEC". You can enter the current right ascension and
declination of a radio source to be used for system calibration, or
perhaps a pulsar or a deep space probe that you wish to detect.
The program will display (on the Astronomical Data screen) the
current Azimuth and Elevation of the specified object at your
station. The source Azimuth and Elevation are also written every
second to the file azel.dat, in case you have automated tracking
capabilities that depend on this information.
8. To facilitate the coming release of the full source code of WSJT
under the General Public License, the proprietary soft-decision
Reed Solomon decoder has been removed from WSJT proper and made
into a separate executable module. This change is invisible to the
user, and the full benefit of the soft-decision decoder is still
available. An open source hard-decision decoder is also provided;
it's what you get when you select the "Fast" JT65 decoding option.
9. In WSJT 5.8.6, if the value of "Freeze DF" (as displayed in the
Status Bar) differs from the sync tone frequency by more than
"Tol", shorthand decoding was suppressed even if Freeze was not
checked. This is a bug, and it has been fixed.
10. Earlier versions of WSJT also had a bug that could cause the "Zap"
function to notch out a valid sync tone. Fixed.
11. The Help screens called up by F1 and Shift-F1 have been updated.
Be sure to read these screens: they contain many operational
conveniences that you may not have discovered!
12. At scrolling speed 5, the time labels and "minute separator" lines
were displayed erratically and the CPU load was excessive. Fixed.
13. Signal strength measurements above -20 dB were formerly compressed
and significantly underestimated. This has been fixed.
14. Decodings of the average of many properly synchronized transmissions
would sometimes go from "good" to "bad" after approximately 8-12
transmissions. This was a bug, and it has been fixed.
15. Several bugs in the FSK441 decoder have been fixed. Both automatic
decoding and mouse-picked decoding have been improved.
16. Changing WSJT modes now sets Auto to OFF, Tol to 400, and the Tx
message number to 1.
17. The generated audio tones for CW ID in FSK441 and JT6M modes have
been moved down to 440 Hz, to avoid possible confusion with the
other tones used in these modes.
18. Readout of "Rx noise" on the main screen is now highlighted in red
if the level is outside the range -10 to +10 dB.
19. The Monitor button is no longer highlighted in green while you are
transmitting.
20. No attempt is made to decode if the Rx level is very low -- for
example, if your receiver is turned off.
21. If the Grid box does not contain a valid locator, readouts of
azimuth and distance are suppressed.
22. Keying of the audio tone to produce Morse code has been "softened"
to suppress key clicks.
23. Your transmitted messages recorded in the file ALL.TXT are now
identified as to mode, and shorthand transmissions are noted.
23. A number of other very minor bugs have been fixed.

BIN
TSKY.DAT Normal file
View File

Binary file not shown.

265
WSJT_Source_Code.txt Executable file
View File

@ -0,0 +1,265 @@
1 Introduction
WSJT is a computer program designed to facilitate Amateur Radio
communication under extreme weak-signal conditions. Three very
different coding and modulation methods are provided: one for
communication by "meteor scatter" techniques on the VHF bands; one for
meteor and ionospheric scatter, primarily on the 6 meter band; and one
for the very challenging EME (Earth-Moon-Earth) path.
2 Program Overview
WSJT's user interface is written in Python. The major Python
source-code files include:
1. wsjt.py Defines the main-screen GUI for user interactions;
acts as "traffic cop" for orchestrating all
event-driven and time-shared activities.
2. specjt.py Provides real-time display of received signals as
two-dimensional "waterfall" spectra.
3. options.py Provides entry fields for user-defined parameters.
4. astro.py Displays astronomical data for sun, moon, sky
temperature, etc.
Smaller Python files serve various utility purposes.
Both wsjt.py and specjt.py make calls to external procedures compiled
from Fortran and C. A variety of global data is shared among modules
through common blocks defined in Fortran. The Python code runs in a
single thread, although timers make the functions of the several main
modules appear concurrent. Fortran routines create additional threads
to be used for soundcard I/O and the decoding of received messages.
As a small part of its overall task, the decoder for JT65 invokes an
external program named KVASD.EXE or KVASD, located in the main
WSJT directory. If this program is present it uses information on
received 64-FSK symbols and attempts to decipher it according to a
Reed Solomon (63,12) code, using the algebraic soft-decision algorithm
of Koetter and Vardy. If KVASD is not present, WSJT uses its own
internal hard-decision Reed Solomon decoder instead. Interprocess
communication between WSJT and KVASD takes place through a shared disk
file. KVASD is not an integral part of WSJT. Its algorithm is
patented, and the source code is the property of CodeVector
Technologies, LLC. However, compiled versions of KVASD may be freely
used in conjunction with WSJT for the purposes of amateur radio
weak-signal communication.
3 Some Functional Details
WSJT execution starts at the top of Python file wsjt.py. The
other Python modules are loaded and executed as needed. Fortran
routines are called to start a high-priority thread to handle
continuous A/D and D/A streams, and a background thread to decode
received or previously recorded signals. The top-level Python
code determines the overall state of program operation, e.g.,
Idle, Monitoring, or Transmitting. In normal usage the operator
puts the program into Auto mode, resulting in a timed sequence of
alternating transmission and reception intervals.
4 Other Open-Source Software used in WSJT
WSJT 5.9 uses the following open source libraries:
1. FFTW, by Matteo Frigo and Steven Johnson, for computing Fourier
transforms
2. PortAudio, by Ross Bencina and Phil Burk, for audio I/O
3. "Secret Rabbit Code" or "libsamplerate", by Erik de Castro, for
accomplishing band-limited resampling of data
4. RS, by Phil Karn, KA9Q, for Reed Solomon encoding and
hard-decision decoding.
5 Platform-Dependent Notes
The Python code should run on any supported Python platform. Most of
the remaining code can be recompiled for Linux or OS/X, instead of
Windows. Platform-dependent versions of FFTW, PortAudio, and
libsamplerate need to be installed.
Methods are provided for creating additional threads and setting their
runtime priorities in both Windows and Linux.
6 Partial List of Functions and Subroutines, and their purposes
Audio.f90 Routines for audio startup, decoding, display computations
blanker.f90 Noise blanker
fivehz.f90 Called by PortAudio callback
flat2.f Flatten the spectrum for waterfall display
pix2d65.f90 Computes pixels for waterfall display
pix2d.f90 Computes pixels for waterfall display
runqqq.f90 Executes another process
wsjtgen.f90 Generates Tx waveforms
abc441.f90 Part of FSK441 generator
gen65.f Generate JT65 waveform
chkmsg.f Check a JT65 message for presence of 'OOO'
encode65.f Encode a JT65 message
getpfx1.f Handle extra DXCC prefixes
getpfx2.f ...
graycode.f Convert binary to/from Gray code
nchar.f Convert number, letter, space to 0-36
packcall.f Routines for JT65 source encoding
packdxcc.f ...
packgrid.f ...
packmsg.f ...
packtext.f ...
pfx.f ...
gen6m.f Generate JT6M waveform
gentone.f Generate tone for JT6M message
gencw.f Generate CW waveform
morse.f Convert ascii to morse dits
gencwid.f Generate a CW ID message
grid2k.f Convert grid locator to integer
interleave63.f Interleave JT65 symbols
gcom1.f90 Global commons for sharing data among Fortran routines
gcom2.f90 and between Fortran and Python
gcom3.f90
gcom4.f90
makedate.f90 Gererates makedate_sub.f90
Astronomical calculations:
astro.f Computes Az, El, Doppler for Sun, Moon, etc.
astropak.f "Includes" for astro supoport routines
azdist.f Computes azimuth, distance, etc., between two locators
coord.f Spherical trig utility
dcoord.f Spherical trig utility in double precision
deg2grid.f Convert lat/long (degrees) to grid locator
dot.f Compute dot product
ftsky.f Get sky temperature from data file
geocentric.f Convert geodetic to geocentric coords
GeoDist.f Compute azimuth and distance between two locators
grid2deg.f Convert grid locator to lat/long
moon2.f Compute moon location at specified date and time
MoonDop.f Compute lunar doppler shift and related quantities
sun.f Compure sun location at specified date and time
toxyz.f Convert between polar and cartesian coords
Utilities:
db.f Compute decibels from ratio
gasdev.f Generate Gaussian random numbers
igray.f Gray code
indexx.f Sort routine
set.f Move, add, zero, ...
pctile.f Sort an array and get specified percentile
ran1.f Uniform random numbers
rfile2.f Read a binary file (Linux)
sort.f Sort an array
FFTs:
fftw3.f Fortran definitions for FFTW
four2a.f Wrapper to make FFTW look like four2
four2.f FFT in Fortran
ps.f Compute power spectrum
xfft.f Real to complex FFT wrapper
Routines for Decoding:
wsjt1.f Top-level decoding routine; handles FSK441 especially
avesp2.f Computes average spectrum
bzap.f Find and remove birdies
detect.f Measure power in FSK441 tones
flatten.f Flatten the spectrum
longx.f Decode normal FSK441 messages
lpf1.f Quick-and-dirty lowpass filter
mtdecode.f Multi-tone decoding
ping.f Find pings
s2shape.f Flatten the 2d spectrum
smooth.f Smooth by boxcar averaging
spec2d.f Compute 2d spectrum for FSK441
stdecode.f Decode FSK441 shorthand messages
sync.f Synchronize FSK441 data
wsjt65.f JT65 decoder
afc65.f AFC for JT65
avemsg65.f Decode average message
decode65.f Decode JT65 message
deep65.f Deep search decoder
demod64a.f Compute probabilities of transmitted symbols
extract.f Extract message from JT65 symbol probabilities
flat1.f Flatten the passband
getsnr.f Compute snr or shorthand message
k2grid.f Convert integer to 4-digit grid locator
limit.f Clipper for JT65
peakup.f Interpolate to find fractional-bin peak
setup65.f Initialize pseudorandom sync vector
short65.f Detect JT65 shorthand messages
slope.f Remove a straight-line slope
spec2d65.f Compute 2d spectrum for JT65
spec441.f Compute spectra for FSK441 decoding
sync65.f Synchronize a JT65 signal
unpackcall.f Unpack JT65 message parts ...
unpackgrid.f ...
unpackmsg.f ...
unpacktext.f ...
xcor.f Compute cross-correlation for JT65 sync
decode6m.f Decode JT65 signal
syncf0.f First frequency sync
syncf1.f Second freq sync
synct.f First time sync
avemsg6m.f Get average JT65 message
JT65code.f Program to illustrate and test JT65 coding
Hard-Decision Reed Solomon Codec
decode_rs.c Decoder
encode_rs.c Encoder
init_rs.c Initialization routine
wrapkarn.c Wapper for Fortran
cutil.c Fortran wrappers for some basic C functions
jtaudio.c Audio I/O, calls PortAudio routines
padevsub.c Select desired audio device
ptt.c PTT via serial port DTR/RTS
ptt_linux.c Ditto for Linux (dummy at present)
resample.c Wrapper for resample routine
start_threads.c Start audio and decoder threads
7 Compiling Instructions
Scripts are provided for compiling WSJT in both Windows and Linux.
They are presently set up to use Compaq Visual Fortran (v6.6) and
Microsoft C (v6.0) in Windows, and g95 and gcc in Linux. My
installation has Python 2.3. Additional tools include f2py, which
compiles Fortran and C to make Python extensions; the Python Imaging
Library; Numeric Python; and the SciPy distribution utilities.
Linux Windows Function
-------------------------------------------------------------------
g0 g0.bat Compiles the hard-decision Reed Solomon Decoder
Needs to be done only once.
g1 g1.bat Compiles the remaining Fortran and C to produce Python
extension module audio.pyd (Windows) or audio.so
(Linux).
g2.bat Uses McMillan Installer to create an f2py specification
file, wsjt.spec
g3.bat Uses Installer to produce a distributable file WSJT6.EXE
(Windows).
The final two build steps have not yet been tried in Linux. In Windows,
these steps produce a distributable file WSJT6.EXE that contains all
necessary software components, so that the user does not need to install
Python or any of its other extensions.
8 Present status (December 20, 2005)
WSJT version 5-9-2d is fully functional in Windows. The Linux version
can be used to decoded recorded files, but real-time audio I/O has not
yet been implemented.

33
abc441.f90 Normal file
View File

@ -0,0 +1,33 @@
subroutine abc441(msg,nmsg,itone,ndits)
character msg*28,msg2*29
integer itone(84)
integer lookup(0:91)
integer codeword4(4,0:42)
integer codeword7(7,0:42)
character c*1
character cc*43
data cc/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.,?/#$'/
data lookup/13, 15, 17, 46, 47, 45, 44, 12, 11, 14, &
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, &
16, 48, 18, 19, 20, 21, 22, 23, 24, 25, &
26, 27, 15, 29, 30, 14, 16, 42, 46, 35, &
36, 37, 21, 0, 11, 41, 10, 13, 43, 1, &
2, 3, 4, 5, 6, 7, 8, 9, 49, 56, &
52, 55, 54, 12, 63, 17, 18, 19, 20, 44, &
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, &
32, 33, 34, 35, 36, 37, 38, 39, 40, 41, &
45, 63/
save
do i=1,nmsg
n=ichar(msg(i:i))
if(n.lt.0 .or. n.gt.91) n=32 !Replace illegal char with blank
n=lookup(n)
itone(3*i-2)=n/16 + 1
itone(3*i-1)=mod(n/4,4) + 1
itone(3*i)=mod(n,4) + 1
enddo
ndits=3*nmsg
return
end subroutine abc441

77
afc65.f Normal file
View File

@ -0,0 +1,77 @@
subroutine afc65(s2,ipk,lagpk,flip,ftrack)
real s2(1024,320)
real s(-10:10)
real x(63),y(63),z(63)
real ftrack(126)
include 'prcom.h'
data s/21*0.0/
k=0
u=1.0
u1=0.2
fac=sqrt(1.0/u1)
do j=1,126
if(pr(j)*flip .lt. 0.0) go to 10
k=k+1
m=2*j-1+lagpk
if(m.lt.1 .or. m.gt.320) go to 10
smax=0.
do i=-10,10
s(i)=(1.0-u)*s(i) + u*s2(ipk+i,m)
if(s(i).gt.smax) then
smax=s(i)
ipk2=i
endif
enddo
u=u1
dfx=0.0
sig=100.0*fac*smax
if(ipk2.gt.-10 .and. ipk2.lt.10 .and. (sig.gt.2.0))
+ call peakup(s(ipk2-1),s(ipk2),s(ipk2+1),dfx)
dfx=ipk2+dfx
x(k)=j
y(k)=dfx
z(k)=sig
if(z(k).lt.1.5 .or. abs(y(k)).gt.5.5) then
y(k)=0.
z(k)=0.
endif
10 enddo
zlim=5.0
yfit=0.
k=0
do j=1,126
if(pr(j)*flip .lt. 0.0) go to 30
k=k+1
sumy=0.
sumz=0.
if(k.ge.1) then
sumz=z(k)
sumy=sumy+z(k)*y(k)
endif
do n=1,30
m=k-n
if(m.ge.1) then
sumz=sumz+z(m)
sumy=sumy+z(m)*y(m)
endif
m=k+n
if(m.le.63) then
sumz=sumz+z(m)
sumy=sumy+z(m)*y(m)
endif
if(sumz.ge.zlim) go to 20
enddo
n=30
20 yfit=0.
if(sumz.gt.0.0) yfit=sumy/sumz
30 ftrack(j)=yfit*2.691650
enddo
if(ftrack(1).eq.99.0) ftrack(1)=ftrack(2)
return
end

128
astro.f Normal file
View File

@ -0,0 +1,128 @@
subroutine astro(AppDir,nyear,month,nday,uth,nfreq,Mygrid,
+ NStation,mode,MoonDX,AzSun,ElSun,AzMoon,ElMoon0,
+ ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,
+ poloffset,xnr,auxra,auxdec,azaux,elaux)
C Computes astronomical quantities for display in JT65, CW, and EME Echo mode.
C NB: may want to smooth the Tsky map to 10 degrees or so.
character*80 AppDir,fname
character*240 Display
character*14 d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,d11,d12,d13,d14,d15
character*14 d1a,d2a,d3a
character*2 crlf
character*6 MyGrid,HisGrid
logical first,ltsky
real LST
real lat,lon
real ldeg
integer*1 n1sky(129600)
integer*2 nsky
common/sky/ nsky(360,180)
common/echo/xdop(2),techo,ElMoon,mjd
equivalence (n1sky,nsky)
data first/.true./
data rad/57.2957795/
save first
if(first) then
do i=80,1,-1
if(ichar(AppDir(i:i)).ne.0 .and.
+ ichar(AppDir(i:i)).ne.32) goto 1
enddo
1 lenappdir=i
call zero(nsky,180*180)
fname=Appdir(1:lenappdir)//'/TSKY.DAT'
#ifdef Win32
open(13,file=fname,status='old',form='binary',err=10)
read(13) nsky
close(13)
#else
call rfile2(fname,nsky,129600,nr)
if(nr.ne.129600) go to 10
#endif
ltsky=.true.
first=.false.
endif
go to 20
10 ltsky=.false.
20 call grid2deg(MyGrid,elon,lat)
lon=-elon
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST,
+ AzSun,ElSun,mjd)
If(NStation.eq.1 .and. ElSun.gt.-2.0) then
arg=ElSun + 8.6/(ElSun+4.4)
refraction=0.0167/tan(arg/rad) !Refraction in degrees
ElSun=ElSun+refraction
endif
mjd2=mjd
freq=nfreq*1.e6
call MoonDop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon,
+ LST,HA,AzMoon,ElMoon,ldeg,bdeg,vr,dist)
C Compute spatial polarization offset
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)*
+ cos(AzMoon/rad)*sin(ElMoon/rad)
yy=cos(lat/rad)*sin(AzMoon/rad)
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
If(NStation.eq.1 .and. ElMoon.gt.-2.0) then
arg=ElMoon + 8.6/(ElMoon+4.4)
refraction=0.0167/tan(arg/rad) !Refraction in degrees
ElMoon=ElMoon+refraction
endif
techo=2.0 * dist/2.99792458e5 !Echo delay time
doppler=-freq*vr/2.99792458e5 !One-way Doppler
t408=ftsky(ldeg,bdeg) !Read sky map
tsky=t408*(408.0/nfreq)**2.6 !Tsky for obs freq
if(ltsky.and.(tsky.lt.3.0)) tsky=3.0 !Minimum = 3 Kelvin
xdop(NStation)=doppler
if(NStation.eq.2) then
HisGrid=MyGrid
go to 900
endif
doppler00=2.0*xdop(1)
if(mode.eq.2 .or. mode.eq.5) 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.'Z') 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 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

51
astro.py Normal file
View File

@ -0,0 +1,51 @@
#------------------------------------------------------ astro
from Tkinter import *
import Pmw
import g
def done():
g.astro_geom0=root.geometry()
root.withdraw()
root=Toplevel()
root.withdraw()
root.protocol('WM_DELETE_WINDOW',done)
if g.Win32: root.iconbitmap("wsjt.ico")
root.title("Astronomical data")
frame=Frame(root)
frame.pack()
def astro2(t):
root.geometry(t)
root.deiconify()
root.focus_set()
def update():
t1= " Az El\n"
t2= "Moon: %11.2f %6.2f\n" % (g.AzMoon,g.ElMoon)
t3= "Moon/DX: %6.2f %7.2f\n" % (g.AzMoonB,g.ElMoonB)
t4= "Sun: %11.2f %6.2f\n" % (g.AzSun,g.ElSun)
t4a="Source: %8.2f %6.2f\n\n" % (g.AzAux,g.ElAux)
t5= " Doppler df/dt\n"
t6= "DX: %6d %7.2f\n" % (g.ndop,g.dfdt)
t7= "Self: %8d %7.2f\n\n" % (g.ndop00,g.dfdt0)
t7a=" RA DEC\n"
irah=int(g.RAMoon)
iram=int(60.0*(g.RAMoon-irah))
t7b="Moon: %2.2d:%2.2d %6.2f\n" % (irah,iram,g.DecMoon)
irah=int(g.RaAux)
iram=int(60.0*(g.RaAux-irah))
t7c="Source: %2.2d:%2.2d %6.2f\n\n" % (irah,iram,g.DecAux)
t8= "Freq: %4d Tsky:%6d\n" % (g.nfreq,g.ntsky)
t9= "MNR: %4.1f Dgrd:%5.1f\n" % (g.MaxNR,g.Dgrd)
t10="DPol: %4d SD:%7.2f\n" % (g.poloffset,g.sd)
t=t1+t2+t3+t4+t4a+t5+t6+t7+t7a+t7b+t7c+t8+t9+t10
lab1.configure(text=t)
g.astro_geom=root.geometry()
frame.after(1000,update)
lab1=Label(frame,font=('Arial 16'),justify=LEFT,bg="#66FFFF",
relief=RIDGE,bd=4,anchor=N)
lab1.pack(ipadx=4)
frame.after(1000,update)

14
astropak.f Normal file
View File

@ -0,0 +1,14 @@
! include 'astro.f'
include 'azdist.f'
include 'coord.f'
include 'dcoord.f'
include 'deg2grid.f'
include 'dot.f'
include 'ftsky.f'
include 'geocentric.f'
include 'GeoDist.f'
include 'grid2deg.f'
include 'moon2.f'
include 'MoonDop.f'
include 'sun.f'
include 'toxyz.f'

4
avecom.h Normal file
View File

@ -0,0 +1,4 @@
parameter (MAXAVE=120)
common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,
+ iseg(MAXAVE)

44
avemsg65.f Normal file
View File

@ -0,0 +1,44 @@
subroutine avemsg65(mseg,mode65,ndepth,decoded,nused,ns,ncount)
C Decodes averaged JT65 data for the specified segment (mseg=1 or 2).
parameter (MAXAVE=120) !Max avg count is 120
character decoded*22
real s3(64,63)
common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE)
C Count the available spectra for this Monitor segment (mseg=1 or 2),
C and the number of spectra flagged as good.
nused=0
ns=0
do i=1,nsave
if(iseg(i).eq.mseg) then
ns=ns+1
if(nflag(i).eq.1) nused=nused+1
endif
enddo
if(nused.lt.1) go to 100
C Compute the average of all flagged spectra for this segment.
do j=1,63
call zero(s3(1,j),64)
do n=1,nsave
if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then
call add(s3(1,j),ppsave(1,j,n),s3(1,j),64)
endif
enddo
enddo
nadd=nused*mode65
call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message
100 if(nused.lt.1.or.ncount.lt.0) decoded=' '
C Suppress "birdie messages":
if(decoded(1:7).eq.'000AAA ') decoded=' '
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
! print*,mseg,nused,' ',decoded
return
end

110
avemsg6m.f Normal file
View File

@ -0,0 +1,110 @@
subroutine avemsg6m(s2db,nz,nslim,NFixLen,cfile6,lcum,
+ f0,lumsg,npkept)
C Attempts to find message length and then decodes an average message.
real s2db(0:43,nz)
real s2dc(0:43,22)
real wgt(22)
real acf(0:430)
logical lcum
character*43 pua
character*6 cfile6
character*22 avemsg,blanks
data pua/'0123456789., /#?$ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
data blanks/' '/
data twopi/6.283185307/
data offset/20.6/
C Adjustable sig limit, depending on length of data to average.
nslim2=nslim - 9 + 4.0*log10(624.0/nz) !### +10 was here
k=0
sum=0.
nsum=0
do j=1,nz
if(mod(j,3).eq.1) then
sum=sum+s2db(0,j) !Measure avg sig strength for sync tone
nsum=nsum+1
else
k=k+1
call move(s2db(0,j),s2db(0,k),44) !Save data spectra
endif
enddo
sig=sum/nsum !Signal strength estimate
nsig=nint(db(sig)-offset)
C Most of the time in this routine is in this loop.
kz=k
do lag=0,kz-1
sum=0.
do j=1,kz-lag
do i=0,43
sum=sum+s2db(i,j)*s2db(i,j+lag)
enddo
enddo
acf(lag)=sum
enddo
acf0=acf(0)
do lag=0,kz-1
acf(lag)=acf(lag)/acf0
enddo
lmsg1=NFixLen/256
lmsg2=NFixLen-256*lmsg1
if(mod(lmsg1,2).eq.1) lmsg1=lmsg1+1
if(mod(lmsg2,2).eq.1) lmsg2=lmsg2+1
smax=-1.e9
do ip=4,22,2 !Compute periodogram for allowed msg periods
if(NFixLen.ne.0 .and. ip.ne.4 .and. ip.ne.lmsg1
+ .and. ip.ne.lmsg2) go to 5
f=1.0/ip
s=0.
do lag=0,kz-1
s=s+acf(lag)*cos(twopi*f*lag)
enddo
if(s.gt.smax) then
smax=s
msglen=ip !Save best message length
endif
5 enddo
C Average the symbols from s2db into s2dc.
call zero(s2dc,44*22)
call zero(wgt,22)
do j=1,kz
k=mod(j-1,msglen)+1
call add(s2db(0,j),s2dc(0,k),s2dc(0,k),44)
wgt(k)=wgt(k)+1.0
enddo
do j=1,msglen !Hard-decode the avg msg,
smax=-1.e9 !picking max bin for each char
do i=1,43
s2dc(i,j)=s2dc(i,j)/wgt(j)
if(s2dc(i,j).gt.smax) then
smax=s2dc(i,j)
ipk=i
endif
enddo
k=mod(ipk,3)
i=ipk
avemsg(j:j)=pua(i:i)
enddo
ndf0=nint(f0-1076.66)
do i=1,msglen
if(avemsg(i:i).eq.' ') goto 10
enddo
go to 20
10 avemsg=avemsg(i+1:msglen)//avemsg(1:i)
20 if(nsig.gt.nslim2) then
npkept=npkept+1
avemsg=avemsg(1:msglen)//blanks
write(lumsg,1020) cfile6,nsig,ndf0,avemsg,msglen
if(lcum) write(21,1020) cfile6,nsig,ndf0,avemsg,msglen
1020 format(a6,8x,i6,i5,7x,a22,19x,'*',i4)
endif
return
end

47
avesp2.f Normal file
View File

@ -0,0 +1,47 @@
subroutine avesp2(dat,jza,nadd,f0,NFreeze,MouseDF,
+ DFTolerance,fzap)
real dat(jza)
integer DFTolerance
real psa(1024) !Ave ps, flattened and rolled off
real ref(557) !Ref spectrum, lines excised
real birdie(557) !Birdie spectrum (ave-ref)
real variance(557)
real s2(557,323)
real fzap(200)
iz=557 !Compute the 2d spectrum
df=11025.0/2048.0
nfft=nadd*1024
jz=jza/nfft
do j=1,jz
k=(j-1)*nfft + 1
call ps(dat(k),nfft,psa)
call move(psa,s2(1,j),iz)
enddo
C Flatten s2 and get psa, ref, and birdie
call flatten(s2,557,jz,psa,ref,birdie,variance)
call zero(fzap,200)
ia=300/df
ib=2700/df
n=0
do i=ia,ib
if(birdie(i)-ref(i).gt.3.0) then
f=i*df
if(NFreeze.eq.0 .or.
+ abs(f-1270.46-MouseDF).gt.float(DFTolerance)) then
if(abs(f-f0).gt.25.0) then
if(n.lt.200 .and. variance(i-1).lt.2.5 .and.
+ variance(i).lt.2.5 .and. variance(i+1).lt.2.5) then
n=n+1
fzap(n)=i*df
endif
endif
endif
endif
enddo
return
end

108
azdist.f Normal file
View File

@ -0,0 +1,108 @@
subroutine azdist(MyGrid,HisGrid,utch,nAz,nEl,nDmiles,nDkm,
+ nHotAz,nHotABetter)
C Old calling sequence:
c subroutine azdist(MyGrid,HisGrid,UTChours,Az,Dmiles,Dkm,El,
c + HotA,HotB,HotABetter)
character*6 MyGrid,HisGrid,mygrid0,hisgrid0
real*8 utch,utch0
logical HotABetter,IamEast
real eltab(22),daztab(22)
data eltab/18.,15.,13.,11.,9.,8.,7.,6.,5.3,4.7,4.,3.3,2.7,
+ 2.,1.5,1.,0.8,0.6,0.4,0.2,0.0,0.0/
data daztab/21.,18.,16.,15.,14.,13.,12.,11.,10.7,10.3,10.,
+ 10.,10.,10.,10.,10.,10.,9.,9.,9.,8.,8./
data mygrid0/" "/,hisgrid0/" "/,utch0/-999.d0/
save
if(MyGrid.eq.HisGrid) then
naz=0
nel=0
ndmiles=0
ndkm=0
nhotaz=0
nhotabetter=1
go to 999
endif
if(mygrid.eq.mygrid0 .and. hisgrid.eq.hisgrid0 .and.
+ abs(utch-utch0).lt.0.1666667d0) go to 900
utch0=utch
mygrid0=mygrid
hisgrid0=hisgrid
utchours=utch
if(MyGrid(5:5).eq.' ') MyGrid(5:5)='m'
if(MyGrid(6:6).eq.' ') MyGrid(6:6)='m'
if(HisGrid(5:5).eq.' ') HisGrid(5:5)='m'
if(HisGrid(6:6).eq.' ') HisGrid(6:6)='m'
if(MyGrid.eq.HisGrid) then
Az=0.
Dmiles=0.
Dkm=0.0
El=0.
HotA=0.
HotB=0.
HotABetter=.true.
go to 900
endif
call grid2deg(MyGrid,dlong1,dlat1)
call grid2deg(HisGrid,dlong2,dlat2)
call geodist(dlat1,dlong1,dlat2,dlong2,Az,Baz,Dkm)
j=nint(Dkm/100.0)-4
if(j.lt.1) j=1
if(j.gt.21)j=21
ndkm=Dkm/100
d1=100.0*ndkm
u=(Dkm-d1)/100.0
El=eltab(j) + u * (eltab(j+1)-eltab(j))
daz=daztab(j) + u * (daztab(j+1)-daztab(j))
Dmiles=Dkm/1.609344
tmid=mod(UTChours-0.5*(dlong1+dlong2)/15.0+48.0,24.0)
IamEast=.false.
if(dlong1.lt.dlong2) IamEast=.true.
if(dlong1.eq.dlong2 .and. dlat1.gt.dlat2) IamEast=.false.
azEast=baz
if(IamEast) azEast=az
if((azEast.ge.45.0 .and. azEast.lt.135.0) .or.
+ (azEast.ge.225.0 .and. azEast.lt.315.0)) then
C The path will be taken as "east-west".
HotABetter=.true.
if(abs(tmid-6.0).lt.6.0) HotABetter=.false.
if((dlat1+dlat2)/2.0 .lt. 0.0) HotABetter=.not.HotABetter
else
C The path will be taken as "north-south".
HotABetter=.false.
if(abs(tmid-12.0).lt.6.0) HotABetter=.true.
endif
if(IamEast) then
HotA = Az - daz
HotB = Az + daz
else
HotA = Az + daz
HotB = Az - daz
endif
if(HotA.lt.0.0) HotA=HotA+360.0
if(HotA.gt.360.0) HotA=HotA-360.0
if(HotB.lt.0.0) HotB=HotB+360.0
if(HotB.gt.360.0) HotB=HotB-360.0
900 continue
naz=nint(Az)
nel=nint(el)
nDmiles=nint(Dmiles)
nDkm=nint(Dkm)
nHotAz=nint(HotB)
nHotABetter=0
if(HotABetter) then
nHotAz=nint(HotA)
nHotABetter=1
endif
999 return
end

18
blanker.f90 Normal file
View File

@ -0,0 +1,18 @@
subroutine blanker(d2d,jz)
integer*2 d2d(jz)
avg=700.
threshold=5.0
do i=1,jz
xmag=abs(d2d(i))
xmed=0.75*xmed + 0.25*d2d(i)
avg=0.999*avg + 0.001*xmag
if(xmag.gt.threshold*avg) then
! d2d(i)=nint(xmed)
d2d(i)=0
endif
enddo
return
end subroutine blanker

68
bzap.f Normal file
View File

@ -0,0 +1,68 @@
subroutine bzap(dat,jz,nadd,mode,fzap)
parameter (NMAX=1024*1024)
parameter (NMAXH=NMAX)
real dat(jz),x(NMAX)
real fzap(200)
complex c(NMAX)
equivalence (x,c)
xn=log(float(jz))/log(2.0)
n=xn
if((xn-n).gt.0.) n=n+1
nfft=2**n
nh=nfft/nadd
nq=nh/2
do i=1,jz
x(i)=dat(i)
enddo
if(nfft.gt.jz) call zero(x(jz+1),nfft-jz)
call xfft(x,nfft)
C This is a kludge:
df=11025.0/(nadd*nfft)
if(mode.eq.2) df=11025.0/(2*nadd*nfft)
tol=10.
itol=nint(2.0/df)
do izap=1,200
if(fzap(izap).eq.0.0) goto 10
ia=(fzap(izap)-tol)/df
ib=(fzap(izap)+tol)/df
smax=0.
do i=ia+1,ib+1
s=real(c(i))**2 + imag(c(i))**2
if(s.gt.smax) then
smax=s
ipk=i
endif
enddo
fzap(izap)=df*(ipk-1)
do i=ipk-itol,ipk+itol
c(i)=0.
enddo
enddo
10 nzaps=izap
ia=70/df
do i=1,ia
c(i)=0.
enddo
ia=2700.0/df
do i=ia,nq+1
c(i)=0.
enddo
do i=2,nq
c(nh+2-i)=conjg(c(i))
enddo
call four2a(c,nh,1,1,-1)
fac=1.0/nfft
do i=1,jz/nadd
dat(i)=fac*x(i)
enddo
return
end

57
char.h Normal file
View File

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

27
chkmsg.f Normal file
View File

@ -0,0 +1,27 @@
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 .and. message(i-3:i).eq.' OOO') then
cok='OOO'
flip=-1.0
message=message(1:i-4)
endif
if(message(1:3).eq.'ATT') nspecial=1
if(message(1:2).eq.'RO') nspecial=2
if(message(1:3).eq.'RRR') nspecial=3
if(message(1:2).eq.'73') nspecial=4
return
end

3
clean.bat Normal file
View File

@ -0,0 +1,3 @@
del *.obj
del *~
del JT65code.exe

37
coord.f Normal file
View File

@ -0,0 +1,37 @@
SUBROUTINE COORD(A0,B0,AP,BP,A1,B1,A2,B2)
C Examples:
C 1. From ha,dec to az,el:
C call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
C 2. From az,el to ha,dec:
C call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
C 3. From ra,dec to l,b
C call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
C ra,dec,l,b)
C 4. From l,b to ra,dec
C call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
C 0.478220215d0,l,b,ra,dec)
C 5. From ecliptic latitude (eb) and longitude (el) to ra, dec:
C call coord(0.e0,0.e0,-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.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
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

85
cutil.c Normal file
View File

@ -0,0 +1,85 @@
/* FORTRAN: fd = close(filedes) */
close_(filedes)
int *filedes;
{
return(close(*filedes));
}
/* FORTRAN: fd = open(filnam,mode) */
open_(filnam,mode)
char filnam[];
int *mode;
{
return(open(filnam,*mode));
}
/* FORTRAN: fd = creat(filnam,mode) */
creat_(filnam,mode)
char filnam[];
int *mode;
{
return(creat(filnam,*mode));
}
/* FORTRAN: nread = read(fd,buf,n) */
read_(fd,buf,n)
int *fd,*n;
char buf[];
{
return(read(*fd,buf,*n));
}
/* FORTRAN: nwrt = write(fd,buf,n) */
write_(fd,buf,n)
int *fd,*n;
char buf[];
{
return(write(*fd,buf,*n));
}
/* FORTRAN: ns = lseek(fd,offset,origin) */
lseek_(fd,offset,origin)
int *fd,*offset,*origin;
{
return(lseek(*fd,*offset,*origin));
}
/* times(2) */
times_(buf)
int buf[];
{
return (times(buf));
}
/* ioperm(2) */
ioperm_(from,num,turn_on)
unsigned long *from,*num,*turn_on;
{
return (ioperm(*from,*num,*turn_on));
}
/* usleep(3) */
usleep_(microsec)
unsigned long *microsec;
{
return (usleep(*microsec));
}
/* returns random numbers between 0 and 32767 to FORTRAN program */
iran_(arg)
int *arg;
{
return (rand());
}
exit_(n)
int *n;
{
printf("\n\n");
exit(*n);
}
#include <time.h>
time_t time_()
{
return time(0);
}
/* hrtime() */
double hrtime_()
{
int tv[2],tz[2];
gettimeofday(tv,tz);
return(tv[0]+1.e-6*tv[1]);
}

5
db.f Normal file
View File

@ -0,0 +1,5 @@
real function db(x)
db=-99.0
if(x.gt.1.259e-10) db=10.0*log10(x)
return
end

39
dcoord.f Normal file
View File

@ -0,0 +1,39 @@
SUBROUTINE DCOORD(A0,B0,AP,BP,A1,B1,A2,B2)
implicit real*8 (a-h,o-z)
C Examples:
C 1. From ha,dec to az,el:
C call coord(pi,pio2-lat,0.,lat,ha,dec,az,el)
C 2. From az,el to ha,dec:
C call coord(pi,pio2-lat,0.,lat,az,el,ha,dec)
C 3. From ra,dec to l,b
C call coord(4.635594495,-0.504691042,3.355395488,0.478220215,
C ra,dec,l,b)
C 4. From l,b to ra,dec
C call coord(1.705981071d0,-1.050357016d0,2.146800277d0,
C 0.478220215d0,l,b,ra,dec)
C 5. From ecliptic latitude (eb) and longitude (el) to ra, dec:
C call coord(0.d0,0.d0,-pio2,pio2-23.443*pi/180,ra,dec,el,eb)
SB0=sin(B0)
CB0=cos(B0)
SBP=sin(BP)
CBP=cos(BP)
SB1=sin(B1)
CB1=cos(B1)
SB2=SBP*SB1 + CBP*CB1*cos(AP-A1)
CB2=SQRT(1.D0-SB2**2)
B2=atan(SB2/CB2)
SAA=sin(AP-A1)*CB1/CB2
CAA=(SB1-SB2*SBP)/(CB2*CBP)
CBB=SB0/CBP
SBB=sin(AP-A0)*CB0
SA2=SAA*CBB-CAA*SBB
CA2=CAA*CBB+SAA*SBB
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

57
decode65.f Normal file
View File

@ -0,0 +1,57 @@
subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
+ mycall,hiscall,hisgrid,mode65,lsave,ftrack,decoded,ncount,
+ deepmsg,qual)
C Decodes JT65 data, assuming that DT and DF have already been determined.
real dat(npts) !Raw data
real s2(77,126)
real s3(64,63)
real ftrack(126)
logical lsave
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
include 'avecom.h'
include 'prcom.h'
save
dt=2.0/11025.0 !Sample interval (2x downsampled data)
istart=nint(dtx/dt) !Start index for synced FFTs
nsym=126
C Compute FFTs of symbols
f0=1270.46 + dfx
call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,mode65,s2)
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+7,k)
enddo
enddo
nadd=mode65
call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message
c if(lsave) call deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,hisgrid,
call deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,hisgrid,
+ deepmsg,qual)
if(ncount.lt.0) decoded=' '
C Suppress "birdie messages":
if(decoded(1:7).eq.'000AAA ') decoded=' '
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
C If ncount>=0 or if this is the "0,0" run, save spectrum in ppsave:
C Q: should ftrack be used here?
100 if((ncount.ge.0 .or. lsave)) then
do j=1,63
k=mdat(j)
if(flip.lt.0.0) k=mdat2(j)
call move(s2(8,k),ppsave(1,j,nsave),64)
enddo
endif
return
end

161
decode6m.f Normal file
View File

@ -0,0 +1,161 @@
subroutine decode6m(data,jz,cfile6,MinSigdB,istart,
+ NFixLen,lcum,f0,lumsg,npkept,yellow)
C Decode a JT6M message. Data must start at the beginning of a
C sync symbol; sync frequency is assumed to be f0.
parameter (NMAX=30*11025)
real data(jz) !Raw data
real s2db(0:43,646) !Spectra of symbols
c real s2(128,646)
real syncsig(646)
real yellow(216)
real ref(0:43)
logical lcum
character*43 pua
character*48 msg
character*6 cfile6
real*8 dpha,twopi
complex*16 z,dz
complex zz
complex ct(0:511)
complex c
common/hcom/c(NMAX)
data pua/'0123456789., /#?$ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
data offset/20.6/
ps(zz)=real(zz)**2 + imag(zz)**2 !Power spectrum function
C Convert data to baseband (complex result) using quadrature LO.
twopi=8*atan(1.d0)
dpha=twopi*f0/11025.d0
dz=cmplx(cos(dpha),-sin(dpha))
z=1.d0/dz
do i=1,jz
z=z*dz
c(i)=data(i)*z
enddo
C Get spectrum for each symbol.
C NB: for decoding pings, could do FFTs first for sync intervals only,
C and then for data symbols only where the sync amplitude is above
C threshold. However, for the average message we want all FFTs computed.
call zero(ref,44)
nh=256
nz=jz/512 - 1
fac=1.0/512.0
do j=1,nz
i0=512*(j-1) + 1
do i=0,511
c fac=1.0/512.0 * abs(i-nh)/float(nh) !Window OK?
ct(i)=fac*c(i0+i)
enddo
call four2a(ct,512,1,-1,1)
C Save PS for each symbol
do i=0,127
xps=ps(ct(i))
if(i.le.43) s2db(i,j)=xps
c s2(i+1,j)=xps
enddo
if(mod(j,3).eq.1) call add(ref,s2db(0,j),ref,44) !Accumulate ref spec
enddo
C Return sync-tone amplitudes for plotting.
iz=nz/3 -1
do i=1,iz
j=3*i-2
yellow(i)=s2db(0,j)-0.5*(s2db(0,j+1)+s2db(0,j+2))
enddo
yellow(216)=iz
fac=3.0/nz
do i=0,43 !Normalize the ref spectrum
ref(i)=fac*ref(i)
enddo
ref(0)=ref(2) !Sync bin uses bin 2 as ref
do j=1,nz !Compute strength of sync
m=mod(j-1,3) !signal at each j.
ja=j-m-3
jb=ja+3
if(ja.lt.1) ja=ja+3
if(jb.gt.nz) jb=jb-3
syncsig(j)=0.5*(s2db(0,ja)+s2db(0,jb))/ref(0)
syncsig(j)=db(syncsig(j)) - offset
do i=0,43 !Normalize s2db
s2db(i,j)=s2db(i,j)/ref(i)
enddo
enddo
C Decode any message of 2 or more consecutive characters bracketed by
C sync-tones above a threshold.
C Use hard-decoding (i.e., pick max bin).
nslim=MinSigdB !Signal limit for decoding
ndf0=nint(f0-1076.77) !Freq offset DF, in Hz
n=0 !Number of decoded characters
j0=0
sbest=-1.e9
do j=2,nz-1,3
if(syncsig(j).ge.float(nslim)) then
C Is it time to write out the results?
if((n.eq.48) .or. (j.ne.j0+3 .and. j0.ne.0)) then
nsig=nint(sbest)
width=(512./11025.)*(1.5*n+1.0)
if(nsig.ge.nslim) then
npkept=npkept+1
write(lumsg,1010) cfile6,tping,width,
+ nsig,ndf0,(msg(k:k),k=1,n)
if(lcum) write(21,1010) cfile6,tping,width,
+ nsig,ndf0,(msg(k:k),k=1,n)
1010 format(a6,2f5.1,i4,i5,6x,48a1) !### 6x was 7x ###
endif
n=0
sbest=-1.e9
endif
j0=j
smax1=-1.e9
do i=1,43 !Pick max bin for 1st char
if(s2db(i,j).gt.smax1) then
smax1=s2db(i,j)
ipk=i
endif
enddo
n=n+1
if(n.eq.1) tping=j*512./11025. + (istart-1)/11025.0 !Start of ping
msg(n:n)=pua(ipk:ipk) !Decoded character
smax2=-1.e9
do i=1,43
if(s2db(i,j+1).gt.smax2) then
smax2=s2db(i,j+1)
ipk=i
endif
enddo
n=n+1
msg(n:n)=pua(ipk:ipk)
sig0=10.0**(0.1*(syncsig(j)+offset))
sig=db(0.5*sig0 + 0.25*(smax1+smax2))-offset
sbest=max(sbest,sig)
endif
enddo
nsig=nint(sbest)
width=(512./11025.)*(1.5*n+1.0)
if(n.ne.0 .and. nsig.ge.nslim) then
npkept=npkept+1
write(lumsg,1010) cfile6,tping,
+ width,nsig,ndf0,(msg(k:k),k=1,n)
if(lcum) write(21,1010) cfile6,tping,
+ width,nsig,ndf0,(msg(k:k),k=1,n)
endif
C Decode average message for the whole record.
call avemsg6m(s2db,nz,nslim,NFixLen,cfile6,lcum,f0,lumsg,npkept)
return
end

263
decode_rs.c Normal file
View File

@ -0,0 +1,263 @@
/* Reed-Solomon decoder
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#ifdef DEBUG
#include <stdio.h>
#endif
#include <string.h>
#define NULL ((void *)0)
#define min(a,b) ((a) < (b) ? (a) : (b))
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
int DECODE_RS(
#ifdef FIXED
DTYPE *data, int *eras_pos, int no_eras,int pad){
#else
void *p,DTYPE *data, int *eras_pos, int no_eras){
struct rs *rs = (struct rs *)p;
#endif
int deg_lambda, el, deg_omega;
int i, j, r,k;
DTYPE u,q,tmp,num1,num2,den,discr_r;
DTYPE lambda[NROOTS+1], s[NROOTS]; /* Err+Eras Locator poly
* and syndrome poly */
DTYPE b[NROOTS+1], t[NROOTS+1], omega[NROOTS+1];
DTYPE root[NROOTS], reg[NROOTS+1], loc[NROOTS];
int syn_error, count;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return -1;
#endif
/* form the syndromes; i.e., evaluate data(x) at roots of g(x) */
for(i=0;i<NROOTS;i++)
s[i] = data[0];
for(j=1;j<NN-PAD;j++){
for(i=0;i<NROOTS;i++){
if(s[i] == 0){
s[i] = data[j];
} else {
s[i] = data[j] ^ ALPHA_TO[MODNN(INDEX_OF[s[i]] + (FCR+i)*PRIM)];
}
}
}
/* Convert syndromes to index form, checking for nonzero condition */
syn_error = 0;
for(i=0;i<NROOTS;i++){
syn_error |= s[i];
s[i] = INDEX_OF[s[i]];
}
if (!syn_error) {
/* if syndrome is zero, data[] is a codeword and there are no
* errors to correct. So return data[] unmodified
*/
count = 0;
goto finish;
}
memset(&lambda[1],0,NROOTS*sizeof(lambda[0]));
lambda[0] = 1;
if (no_eras > 0) {
/* Init lambda to be the erasure locator polynomial */
lambda[1] = ALPHA_TO[MODNN(PRIM*(NN-1-eras_pos[0]))];
for (i = 1; i < no_eras; i++) {
u = MODNN(PRIM*(NN-1-eras_pos[i]));
for (j = i+1; j > 0; j--) {
tmp = INDEX_OF[lambda[j - 1]];
if(tmp != A0)
lambda[j] ^= ALPHA_TO[MODNN(u + tmp)];
}
}
#if DEBUG >= 1
/* Test code that verifies the erasure locator polynomial just constructed
Needed only for decoder debugging. */
/* find roots of the erasure location polynomial */
for(i=1;i<=no_eras;i++)
reg[i] = INDEX_OF[lambda[i]];
count = 0;
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1;
for (j = 1; j <= no_eras; j++)
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
if (q != 0)
continue;
/* store root and error location number indices */
root[count] = i;
loc[count] = k;
count++;
}
if (count != no_eras) {
printf("count = %d no_eras = %d\n lambda(x) is WRONG\n",count,no_eras);
count = -1;
goto finish;
}
#if DEBUG >= 2
printf("\n Erasure positions as determined by roots of Eras Loc Poly:\n");
for (i = 0; i < count; i++)
printf("%d ", loc[i]);
printf("\n");
#endif
#endif
}
for(i=0;i<NROOTS+1;i++)
// printf("%d %d %d\n",i,lambda[i],INDEX_OF[lambda[i]]);
b[i] = INDEX_OF[lambda[i]];
/*
* Begin Berlekamp-Massey algorithm to determine error+erasure
* locator polynomial
*/
r = no_eras;
el = no_eras;
while (++r <= NROOTS) { /* r is the step number */
/* Compute discrepancy at the r-th step in poly-form */
discr_r = 0;
for (i = 0; i < r; i++){
if ((lambda[i] != 0) && (s[r-i-1] != A0)) {
discr_r ^= ALPHA_TO[MODNN(INDEX_OF[lambda[i]] + s[r-i-1])];
}
}
discr_r = INDEX_OF[discr_r]; /* Index form */
if (discr_r == A0) {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
} else {
/* 7 lines below: T(x) <-- lambda(x) - discr_r*x*b(x) */
t[0] = lambda[0];
for (i = 0 ; i < NROOTS; i++) {
if(b[i] != A0)
t[i+1] = lambda[i+1] ^ ALPHA_TO[MODNN(discr_r + b[i])];
else
t[i+1] = lambda[i+1];
}
if (2 * el <= r + no_eras - 1) {
el = r + no_eras - el;
/*
* 2 lines below: B(x) <-- inv(discr_r) *
* lambda(x)
*/
for (i = 0; i <= NROOTS; i++)
b[i] = (lambda[i] == 0) ? A0 : MODNN(INDEX_OF[lambda[i]] - discr_r + NN);
} else {
/* 2 lines below: B(x) <-- x*B(x) */
memmove(&b[1],b,NROOTS*sizeof(b[0]));
b[0] = A0;
}
memcpy(lambda,t,(NROOTS+1)*sizeof(t[0]));
}
}
/* Convert lambda to index form and compute deg(lambda(x)) */
deg_lambda = 0;
for(i=0;i<NROOTS+1;i++){
lambda[i] = INDEX_OF[lambda[i]];
if(lambda[i] != A0)
deg_lambda = i;
}
/* Find roots of the error+erasure locator polynomial by Chien search */
memcpy(&reg[1],&lambda[1],NROOTS*sizeof(reg[0]));
count = 0; /* Number of roots of lambda(x) */
for (i = 1,k=IPRIM-1; i <= NN; i++,k = MODNN(k+IPRIM)) {
q = 1; /* lambda[0] is always 0 */
for (j = deg_lambda; j > 0; j--){
if (reg[j] != A0) {
reg[j] = MODNN(reg[j] + j);
q ^= ALPHA_TO[reg[j]];
}
}
if (q != 0)
continue; /* Not a root */
/* store root (index-form) and error location number */
#if DEBUG>=2
printf("count %d root %d loc %d\n",count,i,k);
#endif
root[count] = i;
loc[count] = k;
/* If we've already found max possible roots,
* abort the search to save time
*/
if(++count == deg_lambda)
break;
}
if (deg_lambda != count) {
/*
* deg(lambda) unequal to number of roots => uncorrectable
* error detected
*/
count = -1;
goto finish;
}
/*
* Compute err+eras evaluator poly omega(x) = s(x)*lambda(x) (modulo
* x**NROOTS). in index form. Also find deg(omega).
*/
deg_omega = deg_lambda-1;
for (i = 0; i <= deg_omega;i++){
tmp = 0;
for(j=i;j >= 0; j--){
if ((s[i - j] != A0) && (lambda[j] != A0))
tmp ^= ALPHA_TO[MODNN(s[i - j] + lambda[j])];
}
omega[i] = INDEX_OF[tmp];
}
/*
* Compute error values in poly-form. num1 = omega(inv(X(l))), num2 =
* inv(X(l))**(FCR-1) and den = lambda_pr(inv(X(l))) all in poly-form
*/
for (j = count-1; j >=0; j--) {
num1 = 0;
for (i = deg_omega; i >= 0; i--) {
if (omega[i] != A0)
num1 ^= ALPHA_TO[MODNN(omega[i] + i * root[j])];
}
num2 = ALPHA_TO[MODNN(root[j] * (FCR - 1) + NN)];
den = 0;
/* lambda[i+1] for i even is the formal derivative lambda_pr of lambda[i] */
for (i = min(deg_lambda,NROOTS-1) & ~1; i >= 0; i -=2) {
if(lambda[i+1] != A0)
den ^= ALPHA_TO[MODNN(lambda[i+1] + i * root[j])];
}
#if DEBUG >= 1
if (den == 0) {
printf("\n ERROR: denominator = 0\n");
count = -1;
goto finish;
}
#endif
/* Apply error to data */
if (num1 != 0 && loc[j] >= PAD) {
data[loc[j]-PAD] ^= ALPHA_TO[MODNN(INDEX_OF[num1] + INDEX_OF[num2] + NN - INDEX_OF[den])];
}
}
finish:
if(eras_pos != NULL){
for(i=0;i<count;i++)
eras_pos[i] = loc[i];
}
return count;
}

158
deep65.f Normal file
View File

@ -0,0 +1,158 @@
subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,
+ hisgrid,decoded,qual)
parameter (MAXCALLS=7000,MAXRPT=63)
real s3(64,63)
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
character*12 mycall,hiscall
character*22 decoded,deepmsg
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*80 line
character*4 rpt(MAXRPT)
logical first
integer ncode(63,2*MAXCALLS)
common/tmp8/ p(64,63)
data neme0/-99/
data rpt/'-01','-02','-03','-04','-05',
+ '-06','-07','-08','-09','-10',
+ '-11','-12','-13','-14','-15',
+ '-16','-17','-18','-19','-20',
+ '-21','-22','-23','-24','-25',
+ '-26','-27','-28','-29','-30',
+ 'R-01','R-02','R-03','R-04','R-05',
+ 'R-06','R-07','R-08','R-09','R-10',
+ 'R-11','R-12','R-13','R-14','R-15',
+ 'R-16','R-17','R-18','R-19','R-20',
+ 'R-21','R-22','R-23','R-24','R-25',
+ 'R-26','R-27','R-28','R-29','R-30',
+ 'RO','RRR','73'/
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: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
5 icall=icall+1
j1=index(mycall,' ') - 1
if(j1.lt.3) j1=6
j2=index(callsign,' ') - 1
if(j2.lt.3) j2=6
j3=index(mycall,'/')
j4=index(callsign,'/')
callgrid(icall)=callsign(1:j2)
mz=1
if(n.eq.1) 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))
if(m.eq.1) then
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
endif
enddo
if(nsked.eq.1) go to 20
10 enddo
20 ntot=k
neme0=neme
sum0=0.
do j=1,63
smax=-1.e30
do i=1,64
smax=max(smax,s3(i,j))
enddo
sum0=sum0+smax
enddo
p1=-1.e30
ip1=0
p2=-1.e30
ip2=0
do k=1,ntot
C If sync=OOO, no CQ messages
if(flip.lt.0.0 .and. testmsg(k)(1:3).eq.'CQ ') go to 30
sum=0.
sum2=0.
do j=1,63
i=ncode(j,k)+1
sum=sum + s3(i,j)
sum2=sum2 + p(i,j)
enddo
if(sum.gt.p1) then
p1=sum
ip1=k
endif
if(sum2.gt.p2) then
p2=sum2
ip2=k
endif
30 enddo
p1=p1/sum0
qual=100.0*(p1-0.40)
if(mode65.eq.1) qual=100.0*(p1-0.33)
if(mode65.eq.4) qual=100.0*(p1-0.50)
if(qual.lt.0.) qual=0.
if(qual.gt.10.) qual=10.
decoded=' '
c=' '
if(qual.gt.0.0) then
if(qual.lt.4.0) c='?'
decoded=testmsg(ip1)
endif
decoded(22:22)=c
deepmsg=decoded
q2=0.27*p2 + 81.3
! if(mode65.eq.1) qual=100.0*(p1-0.33)
! if(mode65.eq.4) qual=100.0*(p1-0.50)
if(q2.lt.0.) q2=0.
if(q2.gt.10.) q2=10.
decoded=' '
c=' '
if(q2.gt.0.0) then
if(q2.lt.4.0) c='?'
decoded=testmsg(ip2)
endif
decoded(22:22)=c
! qual=q2
decoded=deepmsg
return
end

30
deg2grid.f 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
C Convert to units of 5 min of longitude, working east from 180 deg.
nlong=60.0*(180.0-dlong)/5.0
n1=nlong/240 !20-degree field
n2=(nlong-240*n1)/24 !2 degree square
n3=nlong-240*n1-24*n2 !5 minute subsquare
grid(1:1)=char(ichar('A')+n1)
grid(3:3)=char(ichar('0')+n2)
grid(5:5)=char(ichar('a')+n3)
C Convert to units of 2.5 min of latitude, working north from -90 deg.
nlat=60.0*(dlat+90)/2.5
n1=nlat/240 !10-degree field
n2=(nlat-240*n1)/24 !1 degree square
n3=nlat-240*n1-24*n2 !2.5 minuts subsquare
grid(2:2)=char(ichar('A')+n1)
grid(4:4)=char(ichar('0')+n2)
grid(6:6)=char(ichar('a')+n3)
return
end

63
demod64a.f Normal file
View File

@ -0,0 +1,63 @@
subroutine demod64a(signal,nadd,mrsym,mrprob,
+ mr2sym,mr2prob)
C Demodulate the 64-bin spectra for each of 63 symbols in a frame.
C Parameters
C nadd number of spectra already summed
C mrsym most reliable symbol value
C mr2sym second most likely symbol value
C mrprob probability that mrsym was the transmitted value
C mr2prob probability that mr2sym was the transmitted value
implicit real*8 (a-h,o-z)
real*4 signal(64,63)
real*8 fs(64)
integer mrsym(63),mrprob(63),mr2sym(63),mr2prob(63)
real*4 p
common/tmp8/ p(64,63)
afac=1.1 * float(nadd)**0.64
scale=255.999
C Compute average spectral value
sum=0.
do j=1,63
do i=1,64
sum=sum+signal(i,j)
enddo
enddo
ave=sum/(64.*63.)
C Compute probabilities for most reliable symbol values
do j=1,63
s1=-1.e30
fsum=0.
do i=1,64
x=min(afac*signal(i,j)/ave,50.d0)
fs(i)=exp(x)
fsum=fsum+fs(i)
if(signal(i,j).gt.s1) then
s1=signal(i,j)
i1=i !Most reliable
endif
enddo
s2=-1.e30
do i=1,64
if(i.ne.i1 .and. signal(i,j).gt.s2) then
s2=signal(i,j)
i2=i !Second most reliable
endif
p(i,j)=log(fs(i)/fsum)
enddo
p1=fs(i1)/fsum !Normalized probabilities
p2=fs(i2)/fsum
mrsym(j)=i1-1
mr2sym(j)=i2-1
mrprob(j)=scale*p1
mr2prob(j)=scale*p2
enddo
return
end

29
detect.f Normal file
View File

@ -0,0 +1,29 @@
subroutine detect(data,npts,f,y)
C Compute powers at the tone frequencies using 1-sample steps.
parameter (NZ=11025,NSPD=25)
real data(npts)
real y(npts)
complex c(NZ)
complex csum
data twopi/6.283185307/
dpha=twopi*f/11025.0
do i=1,npts
c(i)=data(i)*cmplx(cos(dpha*i),-sin(dpha*i))
enddo
csum=0.
do i=1,NSPD
csum=csum+c(i)
enddo
y(1)=real(csum)**2 + imag(csum)**2
do i=2,npts-(NSPD-1)
csum=csum-c(i-1)+c(i+NSPD-1)
y(i)=real(csum)**2 + imag(csum)**2
enddo
return
end

11
dot.f 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

13
encode65.f Normal file
View File

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

52
encode_rs.c Normal file
View File

@ -0,0 +1,52 @@
/* Reed-Solomon encoder
* Copyright 2002, Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <string.h>
#ifdef FIXED
#include "fixed.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
void ENCODE_RS(
#ifdef FIXED
DTYPE *data, DTYPE *bb,int pad){
#else
void *p,DTYPE *data, DTYPE *bb){
struct rs *rs = (struct rs *)p;
#endif
int i, j;
DTYPE feedback;
#ifdef FIXED
/* Check pad parameter for validity */
if(pad < 0 || pad >= NN)
return;
#endif
memset(bb,0,NROOTS*sizeof(DTYPE));
for(i=0;i<NN-NROOTS-PAD;i++){
feedback = INDEX_OF[data[i] ^ bb[0]];
if(feedback != A0){ /* feedback term is non-zero */
#ifdef UNNORMALIZED
/* This line is unnecessary when GENPOLY[NROOTS] is unity, as it must
* always be for the polynomials constructed by init_rs()
*/
feedback = MODNN(NN - GENPOLY[NROOTS] + feedback);
#endif
for(j=1;j<NROOTS;j++)
bb[j] ^= ALPHA_TO[MODNN(feedback + GENPOLY[NROOTS-j])];
}
/* Shift */
memmove(&bb[0],&bb[1],sizeof(DTYPE)*(NROOTS-1));
if(feedback != A0)
bb[NROOTS-1] = ALPHA_TO[MODNN(feedback + GENPOLY[0])];
else
bb[NROOTS-1] = 0;
}
}

70
extract.f Normal file
View File

@ -0,0 +1,70 @@
subroutine extract(s3,nadd,ndepth,ncount,decoded)
real s3(64,63)
character decoded*22
integer*1 dat1(12)
integer dat(63),era(51),dat4(12),indx(63)
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
logical first
data first/.true./,nsec1/0/
save
call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob)
call graycode(mrsym,63,-1)
call interleave63(mrsym,-1)
call interleave63(mrprob,-1)
ndec=0
nemax=30
maxe=8
if(ndepth.ge.2) ndec=1
if(ndepth.eq.2) xlambda=13.0
if(ndepth.eq.3) xlambda=15.0
if(ndec.eq.1) then
call graycode(mr2sym,63,-1)
call interleave63(mr2sym,-1)
call interleave63(mr2prob,-1)
nsec1=nsec1+1
write(22,rec=1) nsec1,xlambda,maxe,200,
+ mrsym,mrprob,mr2sym,mr2prob
call flushqqq(22)
call runqqq('kvasd.exe','-q',iret)
if(iret.ne.0) then
if(first) write(*,1000)
1000 format('Error in KV decoder, or no KV decoder present.'/
+ 'Using BM algorithm.')
ndec=0
first=.false.
go to 20
endif
read(22,rec=2) nsec2,ncount,dat4
decoded=' '
if(ncount.ge.0) then
call unpackmsg(dat4,decoded) !Unpack the user message
endif
endif
20 if(ndec.eq.0) then
call indexx(63,mrprob,indx)
do i=1,nemax
j=indx(i)
if(mrprob(j).gt.120) then
ne2=i-1
go to 2
endif
era(i)=j-1
enddo
ne2=nemax
2 decoded=' '
do nerase=0,ne2,2
call rs_decode(mrsym,era,nerase,dat4,ncount)
if(ncount.ge.0) then
call unpackmsg(dat4,decoded)
go to 900
endif
enddo
endif
900 return
end

4
f2py.py Normal file
View File

@ -0,0 +1,4 @@
#!/usr/bin/env python.exe
# See http://cens.ioc.ee/projects/f2py2e/
import f2py2e
f2py2e.main()

BIN
fftw3.dll Normal file
View File

Binary file not shown.

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

BIN
fftw3single.lib Normal file
View File

Binary file not shown.

208
fivehz.f90 Normal file
View File

@ -0,0 +1,208 @@
subroutine fivehz
! Called at interrupt level from the PortAudio callback routine.
! For nspb=2048 the callback rate is nfsample/nspb = 5.38 Hz.
! Thus, we should be able to control the timing of T/R sequence events
! here to within about 0.2 s.
! Do not do anything very time consuming in this routine!!
! Disk I/O is a bad idea. Writing to stdout (for diagnostic purposes)
! seems to be OK.
#ifdef Win32
use dflib
use dfport
#endif
real*8 tstart,tstop,t60
logical first,txtime,debug
integer ptt
integer TxOKz
real*8 fs,fsample,tt,tt0,u
include 'gcom1.f90'
include 'gcom2.f90'
data first/.true./,nc0/1/,nc1/1/
save
n1=time()
n2=mod(n1,86400)
tt=n1-n2+tsec-0.1d0*ndsec
if(first) then
rxdelay=0.2
txdelay=0.2
tlatency=3*2048/11025.0
first=.false.
iptt=0
ntr0=-99
debug=.false.
rxdone=.false.
ibuf00=-99
ncall=-1
tt0=tt
u=0.05d0
fsample=11025.d0
maxms=0
mfsample=110250
endif
if(txdelay.lt.0.2d0) txdelay=0.2d0
! Measure average sampling frequency over a recent interval
ncall=ncall+1
if(ncall.gt.0) then
fs=ncall*2048.d0/(tt-tt0)
fsample=u*fs + (1.d0-u)*fsample
mfsample=nint(10.d0*fsample)
endif
if(trperiod.le.0) trperiod=30
tx1=0.0 !Time to start a TX sequence
tx2=trperiod-(tlatency+txdelay) !Time to turn TX off
if(mode(1:4).eq.'JT65') then
if(nwave.lt.126*4096) nwave=126*4096
tx2=nwave/11025.0
endif
if(TxFirst.eq.0) then
tx1=tx1+trperiod
tx2=tx2+trperiod
endif
t=mod(Tsec,2.d0*trperiod)
txtime = t.ge.tx1 .and. t.lt.tx2
! If we're transmitting, freeze the input buffer pointers where they were.
receiving=1
if(((txtime .and. (lauto.eq.1)) .or. TxOK.eq.1 .or. transmitting.eq.1) &
.and. (mute.eq.0)) then
receiving=0
ibuf=ibuf000
iwrite=iwrite000
endif
ibuf000=ibuf
iwrite000=iwrite
nsec=Tsec
ntr=mod(nsec/trperiod,2) !ntr=0 in 1st sequence, 1 in 2nd
if(ntr.ne.ntr0) then
ibuf0=ibuf !Start of new sequence, save ibuf
! if(mode(1:4).ne.'JT65') then
! ibuf0=ibuf0+3 !So we don't copy our own Tx
! if(ibuf0.gt.1024) ibuf0=ibuf0-1024
! endif
ntime=time() !Save start time
if(mantx.eq.1 .and. iptt.eq.1) then
mantx=0
TxOK=0
endif
endif
! Switch PTT line and TxOK appropriately
if(lauto.eq.1) then
if(txtime .and. iptt.eq.0 .and. &
mute.eq.0) i1=ptt(nport,1,iptt) !Raise PTT
if(.not.txtime .or. mute.eq.1) TxOK=0 !Lower TxOK
else
if(mantx.eq.1 .and. iptt.eq.0 .and. &
mute.eq.0) i2=ptt(nport,1,iptt) !Raise PTT
if(mantx.eq.0 .or. mute.eq.1) TxOK=0 !Lower TxOK
endif
! Calculate Tx waveform as needed
if((iptt.eq.1 .and. iptt0.eq.0) .or. nrestart.eq.1) then
call wsjtgen
nrestart=0
endif
! If PTT was just raised, start a countdown for raising TxOK:
nc1a=txdelay/0.18576
if(nc1a.lt.2) nc1a=2
if(mode(1:4).eq.'JT65') nc1a=2 !No extra delay for JT65
if(iptt.eq.1 .and. iptt0.eq.0) nc1=-nc1a
if(nc1.le.0) nc1=nc1+1
if(nc1.eq.0) TxOK=1 ! We are transmitting
! If TxOK was just lowered, start a countdown for lowering PTT:
nc0a=txdelay/0.18576
if(nc0a.lt.4) nc0a=4
if(TxOK.eq.0 .and. TxOKz.eq.1 .and. iptt.eq.1) nc0=-nc0a
if(nc0.le.0) nc0=nc0+1
if(nc0.eq.0) i3=ptt(nport,0,iptt)
if(iptt.eq.0 .and.TxOK.eq.0) then
sending=" "
sendingsh=0
endif
nbufs=ibuf-ibuf0
if(nbufs.lt.0) nbufs=nbufs+1024
tdata=nbufs*2048.0/11025.0
if(mode(1:4).eq.'JT65' .and. monitoring.eq.1 .and. tdata.gt.53.0 &
.and. ibuf0.ne.ibuf00) then
rxdone=.true.
ibuf00=ibuf0
endif
! if(ndebug.ne.0) then
! t60=mod(tsec,60.d0)
! if(iptt.ne.iptt0) then
! if(iptt.eq.1) tstart=tsec
! if(iptt.eq.0) write(*,1101) tsec-tstop,t60
!1101 format('Delay from TxOFF to PTT was',f6.2,' s at t=',f6.2)
! endif
! if(TxOK.ne.TxOKz) then
! if(TxOK.eq.0) tstop=tsec
! if(TxOK.eq.1) write(*,1102) tsec-tstart,t60
!1102 format('Delay from PTT to TxON was ',f6.2,' s at t=',f6.2)
! endif
! endif
iptt0=iptt
TxOKz=TxOK
ntr0=ntr
return
end subroutine fivehz
subroutine fivehztx
! Called at interrupt level from the PortAudio output callback.
#ifdef Win32
use dflib
use dfport
#endif
logical first
real*8 fs,fsample,tt,tt0,u
include 'gcom1.f90'
data first/.true./
save
n1=time()
n2=mod(n1,86400)
tt=n1-n2+tsec-0.1d0*ndsec
if(first) then
first=.false.
ncall=-1
tt0=tt
fsample=11025.d0
nsec0=-999
u=0.05d0
mfsample2=110250
endif
ncall=ncall+1
if(ncall.gt.0) then
fs=ncall*2048.d0/(tt-tt0)
fsample=u*fs + (1.d0-u)*fsample
mfsample2=nint(10.d0*fsample)
endif
return
end subroutine fivehztx

30
flat1.f Normal file
View File

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

23
flat2.f Normal file
View File

@ -0,0 +1,23 @@
subroutine flat2(ss,n,nsum)
real ss(1024)
real ref(1024)
real tmp(1024)
nsmo=20
base=50*(float(nsum)**1.5)
ia=nsmo+1
ib=n-nsmo-1
do i=ia,ib
call pctile(ss(i-nsmo),tmp,2*nsmo+1,50,ref(i))
enddo
call pctile(ref(ia),tmp,ib-ia+1,50,base2)
if(base2.gt.0.1*base) then
do i=ia,ib
ss(i)=base*ss(i)/ref(i)
enddo
endif
return
end

105
flatten.f Normal file
View File

@ -0,0 +1,105 @@
subroutine flatten(s2,nbins,jz,psa,ref,birdie,variance)
C Examines the 2-d spectrum s2(nbins,jz) and makes a reference spectrum
C from the jz/2 spectra below the 50th percentile in total power. Uses
C reference spectrum (with birdies removed) to flatten the passband.
real s2(nbins,jz) !2d spectrum
real psa(nbins) !Grand average spectrum
real ref(nbins) !Ref spect: smoothed ave of lower half
real birdie(nbins) !Spec (with birdies) for plot, in dB
real variance(nbins)
real ref2(750) !Work array
real power(300)
C Find power in each time block, then get median
do j=1,jz
s=0.
do i=1,nbins
s=s+s2(i,j)
enddo
power(j)=s
enddo
call pctile(power,ref2,jz,50,xmedian)
if(jz.lt.5) go to 900
C Get variance in each freq channel, using only those spectra with
C power below the median.
do i=1,nbins
s=0.
nsum=0
do j=1,jz
if(power(j).le.xmedian) then
s=s+s2(i,j)
nsum=nsum+1
endif
enddo
s=s/nsum
sq=0.
do j=1,jz
if(power(j).le.xmedian) sq=sq + (s2(i,j)/s-1.0)**2
enddo
variance(i)=sq/nsum
enddo
C Get grand average, and average of spectra with power below median.
call zero(psa,nbins)
call zero(ref,nbins)
nsum=0
do j=1,jz
call add(psa,s2(1,j),psa,nbins)
if(power(j).le.xmedian) then
call add(ref,s2(1,j),ref,nbins)
nsum=nsum+1
endif
enddo
do i=1,nbins !Normalize the averages
psa(i)=psa(i)/jz
ref(i)=ref(i)/nsum
birdie(i)=ref(i) !Copy ref into birdie
enddo
C Compute smoothed reference spectrum with narrow lines (birdies) removed
do i=4,nbins-3
rmax=-1.e10
do k=i-3,i+3 !Get highest point within +/- 3 bins
if(ref(k).gt.rmax) then
rmax=ref(k)
kpk=k
endif
enddo
sum=0.
nsum=0
do k=i-3,i+3
if(abs(k-kpk).gt.1) then
sum=sum+ref(k)
nsum=nsum+1
endif
enddo
ref2(i)=sum/nsum
enddo
call move(ref2(4),ref(4),nbins-6) !Copy smoothed ref back into ref
call pctile(ref(4),ref2,nbins-6,50,xmedian) !Get median in-band level
C Fix ends of reference spectrum
do i=1,3
ref(i)=ref(4)
ref(nbins+1-i)=ref(nbins-3)
enddo
facmax=30.0/xmedian
do i=1,nbins !Flatten the 2d spectrum
fac=xmedian/ref(i)
fac=min(fac,facmax)
do j=1,jz
s2(i,j)=fac*s2(i,j)
enddo
psa(i)=dB(psa(i)) + 25.
ref(i)=dB(ref(i)) + 25.
birdie(i)=db(birdie(i)) + 25.
enddo
900 continue
return
end

346
four2.f Executable file
View File

@ -0,0 +1,346 @@
SUBROUTINE FOUR2a (DATA,N,NDIM,ISIGN,IFORM)
C Cooley-Tukey fast Fourier transform in USASI basic Fortran.
C multi-dimensional transform, each dimension a power of two,
C complex or real data.
C TRANSFORM(K1,K2,...) = SUM(DATA(J1,J2,...)*EXP(ISIGN*2*PI*SQRT(-1)
C *((J1-1)*(K1-1)/N(1)+(J2-1)*(K2-1)/N(2)+...))), summed for all
C J1 and K1 from 1 to N(1), J2 and K2 from 1 TO N(2),
C etc, for all NDIM subscripts. NDIM must be positive and
C each N(IDIM) must be a power of two. ISIGN is +1 or -1.
C Let NTOT = N(1)*N(2)*...*N(NDIM). Then a -1 transform
C followed by a +1 one (or vice versa) returns NTOT
C times the original data.
C IFORM = 1, 0 or -1, as data is
C complex, real, or the first half of a complex array. Transform
C values are returned in array DATA. They are complex, real, or
C the first half of a complex array, as IFORM = 1, -1 or 0.
C The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
C by ... will be returned in the same array, now considered to
C be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
C IFORM = 0 or -1, N(1) must be even, and enough room must be
C reserved. The missing values may be obtained by complex conjuga-
C tion.
C The reverse transformation of a half complex array dimensioned
C N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
C to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
C The transform will be real and returned to the input array.
C Running time is proportional to NTOT*LOG2(NTOT), rather than
C the naive NTOT**2. Furthermore, less error is built up.
C Written by Norman Brenner of MIT Lincoln Laboratory, January 1969.
C See IEEE Audio Transactions (June 1967), Special issue on FFT.
DIMENSION DATA(1), N(1)
NTOT=1
DO 10 IDIM=1,NDIM
10 NTOT=NTOT*N(IDIM)
IF (IFORM) 70,20,20
20 NREM=NTOT
DO 60 IDIM=1,NDIM
NREM=NREM/N(IDIM)
NPREV=NTOT/(N(IDIM)*NREM)
NCURR=N(IDIM)
IF (IDIM-1+IFORM) 30,30,40
30 NCURR=NCURR/2
40 CALL BITRV (DATA,NPREV,NCURR,NREM)
CALL COOL2 (DATA,NPREV,NCURR,NREM,ISIGN)
IF (IDIM-1+IFORM) 50,50,60
50 CALL FIXRL (DATA,N(1),NREM,ISIGN,IFORM)
NTOT=(NTOT/N(1))*(N(1)/2+1)
60 CONTINUE
RETURN
70 NTOT=(NTOT/N(1))*(N(1)/2+1)
NREM=1
DO 100 JDIM=1,NDIM
IDIM=NDIM+1-JDIM
NCURR=N(IDIM)
IF (IDIM-1) 80,80,90
80 NCURR=NCURR/2
CALL FIXRL (DATA,N(1),NREM,ISIGN,IFORM)
NTOT=NTOT/(N(1)/2+1)*N(1)
90 NPREV=NTOT/(N(IDIM)*NREM)
CALL BITRV (DATA,NPREV,NCURR,NREM)
CALL COOL2 (DATA,NPREV,NCURR,NREM,ISIGN)
100 NREM=NREM*N(IDIM)
RETURN
END
SUBROUTINE BITRV (DATA,NPREV,N,NREM)
C SHUFFLE THE DATA BY BIT REVERSAL.
C DIMENSION DATA(NPREV,N,NREM)
C COMPLEX DATA
C EXCHANGE DATA(J1,J4REV,J5) WITH DATA(J1,J4,J5) FOR ALL J1 FROM 1
C TO NPREV, ALL J4 FROM 1 TO N (WHICH MUST BE A POWER OF TWO), AND
C ALL J5 FROM 1 TO NREM. J4REV-1 IS THE BIT REVERSAL OF J4-1. E.G.
C SUPPOSE N = 32. THEN FOR J4-1 = 10011, J4REV-1 = 11001, ETC.
DIMENSION DATA(1)
IP0=2
IP1=IP0*NPREV
IP4=IP1*N
IP5=IP4*NREM
I4REV=1
C I4REV = 1+(J4REV-1)*IP1
DO 60 I4=1,IP4,IP1
C I4 = 1+(J4-1)*IP1
IF (I4-I4REV) 10,30,30
10 I1MAX=I4+IP1-IP0
DO 20 I1=I4,I1MAX,IP0
C I1 = 1+(J1-1)*IP0+(J4-1)*IP1
DO 20 I5=I1,IP5,IP4
C I5 = 1+(J1-1)*IP0+(J4-1)*IP1+(J5-1)*IP4
I5REV=I4REV+I5-I4
C I5REV = 1+(J1-1)*IP0+(J4REV-1)*IP1+(J5-1)*IP4
TEMPR=DATA(I5)
TEMPI=DATA(I5+1)
DATA(I5)=DATA(I5REV)
DATA(I5+1)=DATA(I5REV+1)
DATA(I5REV)=TEMPR
20 DATA(I5REV+1)=TEMPI
C ADD ONE WITH DOWNWARD CARRY TO THE HIGH ORDER BIT OF J4REV-1.
30 IP2=IP4/2
40 IF (I4REV-IP2) 60,60,50
50 I4REV=I4REV-IP2
IP2=IP2/2
IF (IP2-IP1) 60,40,40
60 I4REV=I4REV+IP2
RETURN
END
SUBROUTINE COOL2 (DATA,NPREV,N,NREM,ISIGN)
C DISCRETE FOURIER TRANSFORM OF LENGTH N. IN-PLACE COOLEY-TUKEY
C ALGORITHM, BIT-REVERSED TO NORMAL ORDER, SANDE-TUKEY PHASE SHIFTS.
C DIMENSION DATA(NPREV,N,NREM)
C COMPLEX DATA
C DATA(J1,K4,J5) = SUM(DATA(J1,J4,J5)*EXP(ISIGN*2*PI*I*(J4-1)*
C (K4-1)/N)), SUMMED OVER J4 = 1 TO N FOR ALL J1 FROM 1 TO NPREV,
C K4 FROM 1 TO N AND J5 FROM 1 TO NREM. N MUST BE A POWER OF TWO.
C METHOD--LET IPREV TAKE THE VALUES 1, 2 OR 4, 4 OR 8, ..., N/16,
C N/4, N. THE CHOICE BETWEEN 2 OR 4, ETC., DEPENDS ON WHETHER N IS
C A POWER OF FOUR. DEFINE IFACT = 2 OR 4, THE NEXT FACTOR THAT
C IPREV MUST TAKE, AND IREM = N/(IFACT*IPREV). THEN--
C DIMENSION DATA(NPREV,IPREV,IFACT,IREM,NREM)
C COMPLEX DATA
C DATA(J1,J2,K3,J4,J5) = SUM(DATA(J1,J2,J3,J4,J5)*EXP(ISIGN*2*PI*I*
C (K3-1)*((J3-1)/IFACT+(J2-1)/(IFACT*IPREV)))), SUMMED OVER J3 = 1
C TO IFACT FOR ALL J1 FROM 1 TO NPREV, J2 FROM 1 TO IPREV, K3 FROM
C 1 TO IFACT, J4 FROM 1 TO IREM AND J5 FROM 1 TO NREM. THIS IS
C A PHASE-SHIFTED DISCRETE FOURIER TRANSFORM OF LENGTH IFACT.
C FACTORING N BY FOURS SAVES ABOUT TWENTY FIVE PERCENT OVER FACTOR-
C ING BY TWOS. DATA MUST BE BIT-REVERSED INITIALLY.
C IT IS NOT NECESSARY TO REWRITE THIS SUBROUTINE INTO COMPLEX
C NOTATION SO LONG AS THE FORTRAN COMPILER USED STORES REAL AND
C IMAGINARY PARTS IN ADJACENT STORAGE LOCATIONS. IT MUST ALSO
C STORE ARRAYS WITH THE FIRST SUBSCRIPT INCREASING FASTEST.
DIMENSION DATA(1)
real*8 twopi,wstpr,wstpi,wr,wi,w2r,w2i,w3r,w3i,wtempr
TWOPI=6.2831853072*FLOAT(ISIGN)
IP0=2
IP1=IP0*NPREV
IP4=IP1*N
IP5=IP4*NREM
IP2=IP1
C IP2=IP1*IPROD
NPART=N
10 IF (NPART-2) 60,30,20
20 NPART=NPART/4
GO TO 10
C DO A FOURIER TRANSFORM OF LENGTH TWO
30 IF (IP2-IP4) 40,160,160
40 IP3=IP2*2
C IP3=IP2*IFACT
DO 50 I1=1,IP1,IP0
C I1 = 1+(J1-1)*IP0
DO 50 I5=I1,IP5,IP3
C I5 = 1+(J1-1)*IP0+(J4-1)*IP3+(J5-1)*IP4
I3A=I5
I3B=I3A+IP2
C I3 = 1+(J1-1)*IP0+(J2-1)*IP1+(J3-1)*IP2+(J4-1)*IP3+(J5-1)*IP4
TEMPR=DATA(I3B)
TEMPI=DATA(I3B+1)
DATA(I3B)=DATA(I3A)-TEMPR
DATA(I3B+1)=DATA(I3A+1)-TEMPI
DATA(I3A)=DATA(I3A)+TEMPR
50 DATA(I3A+1)=DATA(I3A+1)+TEMPI
IP2=IP3
C DO A FOURIER TRANSFORM OF LENGTH FOUR (FROM BIT REVERSED ORDER)
60 IF (IP2-IP4) 70,160,160
70 IP3=IP2*4
C IP3=IP2*IFACT
C COMPUTE TWOPI THRU WR AND WI IN DOUBLE PRECISION, IF AVAILABLE.
THETA=TWOPI/FLOAT(IP3/IP1)
SINTH=SIN(THETA/2)
WSTPR=-2*SINTH*SINTH
WSTPI=SIN(THETA)
WR=1.
WI=0.
DO 150 I2=1,IP2,IP1
C I2 = 1+(J2-1)*IP1
IF (I2-1) 90,90,80
80 W2R=WR*WR-WI*WI
W2I=2*WR*WI
W3R=W2R*WR-W2I*WI
W3I=W2R*WI+W2I*WR
90 I1MAX=I2+IP1-IP0
DO 140 I1=I2,I1MAX,IP0
C I1 = 1+(J1-1)*IP0+(J2-1)*IP1
DO 140 I5=I1,IP5,IP3
C I5 = 1+(J1-1)*IP0+(J2-1)*IP1+(J4-1)*IP3+(J5-1)*IP4
I3A=I5
I3B=I3A+IP2
I3C=I3B+IP2
I3D=I3C+IP2
C I3 = 1+(J1-1)*IP0+(J2-1)*IP1+(J3-1)*IP2+(J4-1)*IP3+(J5-1)*IP4
IF (I2-1) 110,110,100
C APPLY THE PHASE SHIFT FACTORS
100 TEMPR=DATA(I3B)
DATA(I3B)=W2R*DATA(I3B)-W2I*DATA(I3B+1)
DATA(I3B+1)=W2R*DATA(I3B+1)+W2I*TEMPR
TEMPR=DATA(I3C)
DATA(I3C)=WR*DATA(I3C)-WI*DATA(I3C+1)
DATA(I3C+1)=WR*DATA(I3C+1)+WI*TEMPR
TEMPR=DATA(I3D)
DATA(I3D)=W3R*DATA(I3D)-W3I*DATA(I3D+1)
DATA(I3D+1)=W3R*DATA(I3D+1)+W3I*TEMPR
110 T0R=DATA(I3A)+DATA(I3B)
T0I=DATA(I3A+1)+DATA(I3B+1)
T1R=DATA(I3A)-DATA(I3B)
T1I=DATA(I3A+1)-DATA(I3B+1)
T2R=DATA(I3C)+DATA(I3D)
T2I=DATA(I3C+1)+DATA(I3D+1)
T3R=DATA(I3C)-DATA(I3D)
T3I=DATA(I3C+1)-DATA(I3D+1)
DATA(I3A)=T0R+T2R
DATA(I3A+1)=T0I+T2I
DATA(I3C)=T0R-T2R
DATA(I3C+1)=T0I-T2I
IF (ISIGN) 120,120,130
120 T3R=-T3R
T3I=-T3I
130 DATA(I3B)=T1R-T3I
DATA(I3B+1)=T1I+T3R
DATA(I3D)=T1R+T3I
140 DATA(I3D+1)=T1I-T3R
WTEMPR=WR
WR=WSTPR*WTEMPR-WSTPI*WI+WTEMPR
150 WI=WSTPR*WI+WSTPI*WTEMPR+WI
IP2=IP3
GO TO 60
160 RETURN
END
SUBROUTINE FIXRL (DATA,N,NREM,ISIGN,IFORM)
C FOR IFORM = 0, CONVERT THE TRANSFORM OF A DOUBLED-UP REAL ARRAY,
C CONSIDERED COMPLEX, INTO ITS TRUE TRANSFORM. SUPPLY ONLY THE
C FIRST HALF OF THE COMPLEX TRANSFORM, AS THE SECOND HALF HAS
C CONJUGATE SYMMETRY. FOR IFORM = -1, CONVERT THE FIRST HALF
C OF THE TRUE TRANSFORM INTO THE TRANSFORM OF A DOUBLED-UP REAL
C ARRAY. N MUST BE EVEN.
C USING COMPLEX NOTATION AND SUBSCRIPTS STARTING AT ZERO, THE
C TRANSFORMATION IS--
C DIMENSION DATA(N,NREM)
C ZSTP = EXP(ISIGN*2*PI*I/N)
C DO 10 I2=0,NREM-1
C DATA(0,I2) = CONJ(DATA(0,I2))*(1+I)
C DO 10 I1=1,N/4
C Z = (1+(2*IFORM+1)*I*ZSTP**I1)/2
C I1CNJ = N/2-I1
C DIF = DATA(I1,I2)-CONJ(DATA(I1CNJ,I2))
C TEMP = Z*DIF
C DATA(I1,I2) = (DATA(I1,I2)-TEMP)*(1-IFORM)
C 10 DATA(I1CNJ,I2) = (DATA(I1CNJ,I2)+CONJ(TEMP))*(1-IFORM)
C IF I1=I1CNJ, THE CALCULATION FOR THAT VALUE COLLAPSES INTO
C A SIMPLE CONJUGATION OF DATA(I1,I2).
DIMENSION DATA(2)
TWOPI=6.283185307*FLOAT(ISIGN)
IP0=2
IP1=IP0*(N/2)
IP2=IP1*NREM
IF (IFORM) 10,70,70
C PACK THE REAL INPUT VALUES (TWO PER COLUMN)
10 J1=IP1+1
DATA(2)=DATA(J1)
IF (NREM-1) 70,70,20
20 J1=J1+IP0
I2MIN=IP1+1
DO 60 I2=I2MIN,IP2,IP1
DATA(I2)=DATA(J1)
J1=J1+IP0
IF (N-2) 50,50,30
30 I1MIN=I2+IP0
I1MAX=I2+IP1-IP0
DO 40 I1=I1MIN,I1MAX,IP0
DATA(I1)=DATA(J1)
DATA(I1+1)=DATA(J1+1)
40 J1=J1+IP0
50 DATA(I2+1)=DATA(J1)
60 J1=J1+IP0
70 DO 80 I2=1,IP2,IP1
TEMPR=DATA(I2)
DATA(I2)=DATA(I2)+DATA(I2+1)
80 DATA(I2+1)=TEMPR-DATA(I2+1)
IF (N-2) 200,200,90
90 THETA=TWOPI/FLOAT(N)
SINTH=SIN(THETA/2.)
ZSTPR=-2.*SINTH*SINTH
ZSTPI=SIN(THETA)
ZR=(1.-ZSTPI)/2.
ZI=(1.+ZSTPR)/2.
IF (IFORM) 100,110,110
100 ZR=1.-ZR
ZI=-ZI
110 I1MIN=IP0+1
I1MAX=IP0*(N/4)+1
DO 190 I1=I1MIN,I1MAX,IP0
DO 180 I2=I1,IP2,IP1
I2CNJ=IP0*(N/2+1)-2*I1+I2
IF (I2-I2CNJ) 150,120,120
120 IF (ISIGN*(2*IFORM+1)) 130,140,140
130 DATA(I2+1)=-DATA(I2+1)
140 IF (IFORM) 170,180,180
150 DIFR=DATA(I2)-DATA(I2CNJ)
DIFI=DATA(I2+1)+DATA(I2CNJ+1)
TEMPR=DIFR*ZR-DIFI*ZI
TEMPI=DIFR*ZI+DIFI*ZR
DATA(I2)=DATA(I2)-TEMPR
DATA(I2+1)=DATA(I2+1)-TEMPI
DATA(I2CNJ)=DATA(I2CNJ)+TEMPR
DATA(I2CNJ+1)=DATA(I2CNJ+1)-TEMPI
IF (IFORM) 160,180,180
160 DATA(I2CNJ)=DATA(I2CNJ)+DATA(I2CNJ)
DATA(I2CNJ+1)=DATA(I2CNJ+1)+DATA(I2CNJ+1)
170 DATA(I2)=DATA(I2)+DATA(I2)
DATA(I2+1)=DATA(I2+1)+DATA(I2+1)
180 CONTINUE
TEMPR=ZR-.5
ZR=ZSTPR*TEMPR-ZSTPI*ZI+ZR
190 ZI=ZSTPR*ZI+ZSTPI*TEMPR+ZI
C RECURSION SAVES TIME, AT A SLIGHT LOSS IN ACCURACY. IF AVAILABLE,
C USE DOUBLE PRECISION TO COMPUTE ZR AND ZI.
200 IF (IFORM) 270,210,210
C UNPACK THE REAL TRANSFORM VALUES (TWO PER COLUMN)
210 I2=IP2+1
I1=I2
J1=IP0*(N/2+1)*NREM+1
GO TO 250
220 DATA(J1)=DATA(I1)
DATA(J1+1)=DATA(I1+1)
I1=I1-IP0
J1=J1-IP0
230 IF (I2-I1) 220,240,240
240 DATA(J1)=DATA(I1)
DATA(J1+1)=0.
250 I2=I2-IP1
J1=J1-IP0
DATA(J1)=DATA(I2+1)
DATA(J1+1)=0.
I1=I1-IP0
J1=J1-IP0
IF (I2-1) 260,260,230
260 DATA(2)=0.
270 RETURN
END

75
four2a.f Normal file
View File

@ -0,0 +1,75 @@
SUBROUTINE FOUR2a (a,nfft,NDIM,ISIGN,IFORM)
C IFORM = 1, 0 or -1, as data is
C complex, real, or the first half of a complex array. Transform
C values are returned in array DATA. They are complex, real, or
C the first half of a complex array, as IFORM = 1, -1 or 0.
C The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
C by ... will be returned in the same array, now considered to
C be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
C IFORM = 0 or -1, N(1) must be even, and enough room must be
C reserved. The missing values may be obtained by complex conjuga-
C tion.
C The reverse transformation of a half complex array dimensioned
C N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
C to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
C The transform will be real and returned to the input array.
parameter (NPMAX=100)
complex a(nfft)
integer nn(NPMAX),ns(NPMAX),nf(NPMAX),nl(NPMAX)
integer plan(NPMAX)
data nplan/0/
include 'fftw3.f'
save
if(nfft.lt.0) go to 999
nloc=loc(a)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and.
+ iform.eq.nf(i) .and. nloc.eq.nl(i)) go to 10
enddo
if(nplan.ge.NPMAX) stop 'Too many FFTW plans requested.'
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
C Planning: FFTW_ESTIMATE, FFTW_MEASURE, FFTW_PATIENT, FFTW_EXHAUSTIVE
nspeed=FFTW_ESTIMATE
if(nfft.le.16384) nspeed=FFTW_MEASURE
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d_(plan(i),nfft,a,a,
+ FFTW_FORWARD,nspeed)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d_(plan(i),nfft,a,a,
+ FFTW_BACKWARD,nspeed)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d_(plan(i),nfft,a,a,nspeed)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d_(plan(i),nfft,a,a,nspeed)
else
stop 'Unsupported request in four2a'
endif
i=nplan
! write(*,3001) i,nn(i),ns(i),nf(i),nl(i),plan(i)
! 3001 format(6i10)
10 call sfftw_execute_(plan(i))
return
999 do i=1,nplan
! print*,i,nn(i),ns(i),nf(i),nl(i),plan(i)
call sfftw_destroy_plan_(plan(i))
enddo
! print*,'FFTW plans destroyed:',nplan
return
end

60
fsubs.f Normal file
View File

@ -0,0 +1,60 @@
include 'set.f'
include 'flatten.f'
include 'db.f'
include 'pctile.f'
include 'sort.f'
include 'ps.f'
include 'smooth.f'
include 'ping.f'
include 'longx.f'
include 'peakup.f'
include 'sync.f'
include 'detect.f'
include 'avemsg65.f'
include 'decode65.f'
include 'demod64a.f'
include 'encode65.f'
include 'extract.f'
include 'flat1.f'
#ifdef Win32
include 'four2a.f'
#else
include 'four2.f'
include 'rfile2.f'
#endif
include 'gencw.f'
include 'getpfx1.f'
include 'getpfx2.f'
include 'getsnr.f'
include 'graycode.f'
include 'grid2k.f'
include 'igray.f'
include 'interleave63.f'
include 'k2grid.f'
include 'limit.f'
include 'lpf1.f'
include 'deep65.f'
include 'morse.f'
include 'nchar.f'
include 'packcall.f'
include 'packgrid.f'
include 'packmsg.f'
include 'packtext.f'
include 'setup65.f'
include 'short65.f'
include 'slope.f'
include 'spec2d65.f'
include 'sync65.f'
include 'unpackcall.f'
include 'unpackgrid.f'
include 'unpackmsg.f'
include 'unpacktext.f'
include 'xcor.f'
include 'xfft.f'
include 'wsjt65.f'
include 'gasdev.f'
include 'ran1.f'

21
fsubs1.f Normal file
View File

@ -0,0 +1,21 @@
! include 'wsjt1.f'
include 'avesp2.f'
include 'bzap.f'
include 'spec441.f'
include 'spec2d.f'
include 'mtdecode.f'
include 'stdecode.f'
include 'indexx.f'
include 's2shape.f'
include 'flat2.f'
include 'gen65.f'
include 'chkmsg.f'
include 'gen6m.f'
include 'gentone.f'
include 'syncf0.f'
include 'syncf1.f'
include 'synct.f'
include 'decode6m.f'
include 'avemsg6m.f'

24
ftsky.f Normal file
View File

@ -0,0 +1,24 @@
real function ftsky(l,b)
C Returns 408 MHz sky temperature for l,b (in degrees), from
C Haslam, et al. survey. Must have already read the entire
C file tsky.dat into memory.
real*4 l,b
integer*2 nsky
common/sky/ nsky(360,180)
save
j=nint(b+91.0)
if(j.gt.180) j=180
xl=l
if(xl.lt.0.0) xl=xl+360.0
i=nint(xl+1.0)
if(i.gt.360) i=i-360
ftsky=0.0
if(i.ge.1 .and. i.le.360 .and. j.ge.1 .and. j.le.180) then
ftsky=0.1*nsky(i,j)
endif
return
end

23
g.py Normal file
View File

@ -0,0 +1,23 @@
DFreq=0.0
Freq=0.0
PingTime=0.0
PingFile="current"
report="26"
rms=1.0
mode_change=0
showspecjt=0
#------------------------------------------------------ ftnstr
def ftnstr(x):
y=""
for i in range(len(x)):
y=y+x[i]
return y
#------------------------------------------------------ filetime
def filetime(t):
i=t.rfind(".")
t=t[:i][-6:]
t=t[0:2]+":"+t[2:4]+":"+t[4:6]
return t

3
g0 Executable file
View File

@ -0,0 +1,3 @@
gcc -c -DBIGSYM=1 init_rs.c
gcc -c -DBIGSYM=1 encode_rs.c
gcc -c -DBIGSYM=1 decode_rs.c

3
g0.bat Normal file
View File

@ -0,0 +1,3 @@
cl /c /DBIGSYM=1 /Foinit_rs.o init_rs.c
cl /c /DBIGSYM=1 /Foencode_rs.o encode_rs.c
cl /c /DBIGSYM=1 /Ox /Zd /Fodecode_rs.o decode_rs.c

3
g1 Executable file
View File

@ -0,0 +1,3 @@
g95 -cpp -DLinux -fno-second-underscore -o makedate makedate.f90
makedate
python f2py.py -c --quiet --opt="-O -cpp -DLinux -fno-second-underscore" init_rs.o encode_rs.o decode_rs.o -m Audio --"f77exec=/home/joe/bin/g95" --f90exec="/home/joe/bin/g95" -L//usr/lib/gcc-lib/i386-redhat-linux/3.2.2/ -lpthread -lg2c only: ftn_init ftn_quit audio_init spec getfile azdist0 astro0 makedate_sub : Audio.f90 wsjtgen.f90 runqqq.f90 wsjt1.f fsubs1.f fsubs.f astro.f astropak.f jtaudio.c ptt_linux.c wrapkarn.c start_threads.c cutil.c fivehz.f90

4
g1.bat Normal file
View File

@ -0,0 +1,4 @@
df /fpp /define:Win32 makedate.f90
makedate
cl /c /DWin32 /Fojtaudio.o jtaudio.c
f2py.py -c --quiet --opt="/traceback /fast /fpp /define:Win32" init_rs.o encode_rs.o decode_rs.o jtaudio.o -lwinmm -lpa -lfftw3single -llibsamplerate -m Audio --"fcompiler=compaqv" only: ftn_init ftn_quit audio_init spec getfile azdist0 astro0 makedate_sub : Audio.f90 wsjtgen.f90 runqqq.f90 wsjt1.f fsubs1.f fsubs.f astro.f astropak.f resample.c ptt.c wrapkarn.c fivehz.f90

1
g1fftw.bat Normal file
View File

@ -0,0 +1 @@
f2py.py -c --quiet --opt="/traceback /fast" asd1.o -lwinmm -lpa -lfftw3single -m Audio --"fcompiler=compaqv" only: ftn_init audio_init spec getfile azdist0 astro0 : Audio.f90 fsubs1.f xfft.f xffta.f four2a.f fsubs.f astropak.f jtaudio.c ptt.c fivehz.f90 -lfftw3single

1
g2 Executable file
View File

@ -0,0 +1 @@
python /home/joe/installer_6a2/Installer/Makespec.py --tk --onefile wsjt.py

1
g2.bat Normal file
View File

@ -0,0 +1 @@
c:\python23\installer\makespec.py --icon wsjt.ico --tk --onefile wsjt.py

2
g3 Executable file
View File

@ -0,0 +1,2 @@
python /home/joe/installer_6a2/Installer/Build.py wsjt.spec
mv wsjt wsjt6

2
g3.bat Normal file
View File

@ -0,0 +1,2 @@
c:\python23\installer\Build.py wsjt.spec
mv wsjt.exe WSJT6.EXE

4
g99 Executable file
View File

@ -0,0 +1,4 @@
g0
g1
g2
g3

4
g99.bat Normal file
View File

@ -0,0 +1,4 @@
call g0.bat
call g1.bat
call g2.bat
call g3.bat

24
gasdev.f Normal file
View File

@ -0,0 +1,24 @@
FUNCTION gasdev(idum)
INTEGER idum
REAL gasdev
CU USES ran1
INTEGER iset
REAL fac,gset,rsq,v1,v2,ran1
SAVE iset,gset
DATA iset/0/
if (iset.eq.0) then
1 v1=2.*ran1(idum)-1.
v2=2.*ran1(idum)-1.
rsq=v1**2+v2**2
if(rsq.ge.1..or.rsq.eq.0.)goto 1
fac=sqrt(-2.*log(rsq)/rsq)
gset=v1*fac
gasdev=v2*fac
iset=1
else
gasdev=gset
iset=0
endif
return
END
C (C) Copr. 1986-92 Numerical Recipes Software *(t9,12.

36
gcom1.f90 Normal file
View File

@ -0,0 +1,36 @@
parameter(NRxMax=2048*1024)
parameter(NTxMax=150*11025)
real*8 Tsec !Present time
real*8 tbuf
real*8 rxdelay
real*8 txdelay
real*8 samfacin
real*8 samfacout
integer*2 y1 !Rx audio samples (ring buffer)
integer*2 y2 !WWVB or 1 PPS signal
integer iwrite !Pointer to ring buffer
integer*2 iwave !Tx data
integer nwave !Length of Tx data
integer TxOK !OK to transmit?
integer TxFirst !Transmit first?
integer Receiving !Actually receiving?
integer Transmitting !Actually transmitting?
integer TRPeriod !Tx or Rx period in seconds
integer level !S-meter level, 0-100
integer mute !True means "don't transmit"
integer ndsec !Dsec in units of 0.1 s
integer newdat !True if waterfall should scroll
integer mfsample !Measured sample rate, input
integer mfsample2 !Measured sample rate, output
character*8 cversion !Program version
common/gcom1/Tbuf(1024),ntrbuf(1024),Tsec,rxdelay,txdelay, &
samfacin,samfacout,y1(NRxMax),y2(NRxMax), &
nmax,iwrite,iread,iwave(NTXMAX),nwave,TxOK,Receiving,Transmitting, &
TxFirst,TRPeriod,ibuf,ibuf0,ave,rms,ngo,level,mute,newdat,ndsec, &
ndevin,ndevout,nx,mfsample,mfsample2,ns0, &
cversion
!### volatile /gcom1/

22
gcom2.f90 Normal file
View File

@ -0,0 +1,22 @@
integer*2 d2a,d2b,b
integer shok,sendingsh
integer dftolerance
logical LDecoded,rxdone
character mycall*12,hisgrid*6
character hiscall*12,txmsg*28,sending*28,mode*6,utcdate*12
character*24 fname0,fnamea,fnameb,decodedfile
character*80 AppDir,filetokilla,filetokillb
common/gcom2/ps0(431),psavg(450),s2(64,3100),ccf(-5:540), &
green(500),ngreen,dgain,iter,ndecoding,ndecoding0,mousebutton, &
ndecdone,npingtime,ierr,lauto,mantx,nrestart,ntr,nmsg,nsave, &
dftolerance,LDecoded,rxdone,monitoring,nzap,nsavecum,minsigdb, &
nclearave,nfreeze,nafc,nmode,mode65,nclip,ndebug,nblank,nport, &
mousedf,neme,nsked,naggressive,ntx2,nslim2,nagain,nsavelast, &
shok,sendingsh,d2a(661500),d2b(661500),b(60000),jza,jzb,ntime, &
idinterval,msmax,lenappdir,ndiskdat,nlines,nflat,ntxreq,ntxnow, &
ndepth,nspecial,ndf,ss1(-224:224),ss2(-224:224), &
mycall,hiscall,hisgrid,txmsg,sending,mode,fname0,fnamea, &
fnameb,decodedfile,AppDir,filetokilla,filetokillb,utcdate
!### volatile /gcom2/

7
gcom3.f90 Normal file
View File

@ -0,0 +1,7 @@
integer*2 nfmt2,nchan2,nbitsam2,nbytesam2
character*4 ariff,awave,afmt,adata
common/gcom3/ariff,nchunk,awave,afmt,lenfmt,nfmt2,nchan2,nsamrate, &
nbytesec,nbytesam2,nbitsam2,adata,ndata
!### volatile /gcom3/

7
gcom4.f90 Normal file
View File

@ -0,0 +1,7 @@
integer*2 d2c
character filename*24
character addpfx*4
common/gcom4/addpfx,d2c(661500),jzc,filename
!### volatile /gcom4/

83
gen65.f Normal file
View File

@ -0,0 +1,83 @@
subroutine gen65(message,mode65,samfac,iwave,nwave,sendingsh,
+ msgsent)
C Encodes a JT65 message into a wavefile.
parameter (NMAX=60*11025) !Max length of wave file
character*22 message !Message to be generated
character*22 msgsent !Message as it will be received
character*3 cok !' ' or 'OOO'
character*6 c1,c2
real*8 t,dt,phi,f,f0,dfgen,dphi,twopi,samfac,tsymbol
integer*2 iwave(NMAX) !Generated wave file
integer dgen(12)
integer sent(63)
integer sendingsh
common/c1c2/c1,c2
include 'prcom.h'
data twopi/6.283185307d0/
save
if(abs(pr(1)).ne.1.0) call setup65
call chkmsg(message,cok,nspecial,flip)
if(nspecial.eq.0) then
call packmsg(message,dgen) !Pack message into 72 bits
sendingsh=0
if(iand(dgen(10),8).ne.0) sendingsh=-1 !Plain text flag
call rs_encode(dgen,sent)
call interleave63(sent,1) !Apply interleaving
call graycode(sent,63,1) !Apply Gray code
tsymbol=4096.d0/11025.d0
nsym=126 !Symbols per transmission
else
tsymbol=16384.d0/11025.d0
nsym=32
sendingsh=1 !Flag for shorthand message
endif
C Set up necessary constants
dt=1.0/(samfac*11025.0)
f0=118*11025.d0/1024
dfgen=mode65*11025.0/4096.0
xn=0.
t=0.d0
phi=0.d0
k=0
j0=0
ndata=(nsym*11025.d0*samfac*tsymbol)/2
ndata=2*ndata
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
iwave(i)=32767.0*sin(phi)
enddo
do j=1,5512 !Put another 0.5 sec of silence at end
i=i+1
iwave(i)=0
enddo
nwave=i
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
return
end

49
gen6m.f Normal file
View File

@ -0,0 +1,49 @@
subroutine gen6m(msg,samfac,iwave,nwave)
C Encodes a message into a wavefile for transmitting JT6M signals.
parameter (NMAX=21504) !NMAX=28*512*3/2: number of waveform samples
character*28 msg !Message to be generated
real*8 samfac
real*4 x(NMAX) !Data for wavefile
integer*2 iwave(NMAX) !Generated wave file
integer*4 imsg(28)
do i=27,1,-1 !Get message length
if(msg(i:i).ne.' ') go to 10
enddo
i=1
10 nmsg=i+1
if(mod(nmsg,2).eq.1) nmsg=nmsg+1 !Make it even
nwave=nmsg*512*3/2
do m=1,nmsg !Get character code numbers
ic=m
n=ichar(msg(ic:ic))
C Calculate i in range 0-42:
if(n.ge.ichar('0') .and. n.le.ichar('9')) i=n-ichar('0')
if(msg(ic:ic).eq.'.') i=10
if(msg(ic:ic).eq.',') i=11
if(msg(ic:ic).eq.' ') i=12
if(msg(ic:ic).eq.'/') i=13
if(msg(ic:ic).eq.'#') i=14
if(msg(ic:ic).eq.'?') i=15
if(msg(ic:ic).eq.'$') i=16
if(n.ge.ichar('a') .and. n.le.ichar('z')) i=n-ichar('a')+17
if(n.ge.ichar('A') .and. n.le.ichar('Z')) i=n-ichar('A')+17
imsg(m)=i
enddo
k=1
do i=1,nmsg,2
call gentone(x(k),-1,k) !Generate a sync tone
call gentone(x(k),imsg(i),k) !First character
call gentone(x(k),imsg(i+1),k) !Second character
enddo
do i=1,nwave
iwave(i)=nint(32767.0*x(i))
enddo
return
end

80
gencw.f Normal file
View File

@ -0,0 +1,80 @@
subroutine gencw(msg,wpm,freqcw,samfac,TRPeriod,iwave,nwave)
parameter (NMAX=150*11025)
character msg*22,word12*22,word3*22
integer*2 iwave(NMAX)
integer TRPeriod
integer*1 idat(5000),idat1(460),idat2(200),i1
real*8 dt,t,twopi,pha,dpha,tdit,samfac
data twopi/6.283185307d0/
nwords=0
do i=2,22
if(msg(i-1:i).eq.' ') go to 10
if(msg(i:i).eq.' ') then
nwords=nwords+1
j=j0
j0=i+1
endif
enddo
10 ntype=1 !Call1+Call2, CQ+Call
word12=msg
if(nwords.eq.3) then
word3=msg(j:j0-1)
word12(j-1:)=' '
ntype=3 !BC+RO, BC+RRR, BC+73
if(word3.eq.'OOO') ntype=2 !BC+OOO
endif
tdit=1.2d0/wpm !Key-down dit time, seconds
call morse(word12,idat1,nmax1) !Encode part 1 of msg
t1=tdit*nmax1 !Time for part1, once
nrpt1=TRPeriod/t1 !Repetitions of part 1
if(ntype.eq.2) nrpt1=0.75*TRPeriod/t1
if(ntype.eq.3) nrpt1=1
t1=nrpt1*t1 !Total time for part 1
nrpt2=0
t2=0.
if(ntype.ge.2) then
call morse(word3,idat2,nmax2) !Encode part 2
t2=tdit*nmax2 !Time for part 2, once
nrpt2=(TRPeriod-t1)/t2 !Repetitions of part 2
t2=nrpt2*t2 !Total time for part 2
endif
j=0
do n=1,nrpt1
do i=1,nmax1
j=j+1
idat(j)=idat1(i)
enddo
enddo
do n=1,nrpt2
do i=1,nmax2
j=j+1
idat(j)=idat2(i)
enddo
enddo
dt=1.d0/(11025.d0*samfac)
nwave=j*tdit/dt
pha=0.
dpha=twopi*freqcw*dt
t=0.
s=0.
u=wpm/(11025*0.03)
do i=1,nwave
t=t+dt
pha=pha+dpha
j=t/tdit + 1
! iwave(i)=0
! if(idat(j).ne.0) iwave(i)=nint(32767.d0*sin(pha))
s=s + u*(idat(j)-s)
iwave(i)=nint(s*32767.d0*sin(pha))
enddo
return
end
include 'gencwid.f'

39
gencwid.f Normal file
View File

@ -0,0 +1,39 @@
subroutine gencwid(msg,wpm,freqcw,samfac,iwave,nwave)
parameter (NMAX=10*11025)
character msg*22,msg2*22
integer*2 iwave(NMAX)
integer*1 idat(460)
real*8 dt,t,twopi,pha,dpha,tdit,samfac
data twopi/6.283185307d0/
do i=1,22
if(msg(i:i).eq.' ') go to 10
enddo
10 iz=i-1
msg2=msg(1:iz)//' '
call morse(msg2,idat,ndits) !Encode part 1 of msg
tdit=1.2d0/wpm !Key-down dit time, seconds
dt=1.d0/(11025.d0*samfac)
nwave=ndits*tdit/dt
k=0
pha=0.
dpha=twopi*freqcw*dt
t=0.d0
s=0.
u=wpm/(11025*0.03)
do i=1,nwave
t=t+dt
pha=pha+dpha
j=t/tdit + 1
! iwave(k)=0
! if(idat(j).ne.0) iwave(i)=nint(32767.d0*sin(pha))
s=s + u*(idat(j)-s)
iwave(i)=nint(s*32767.d0*sin(pha))
enddo
return
end

13
gentone.f Normal file
View File

@ -0,0 +1,13 @@
subroutine gentone(x,n,k)
real*4 x(512)
dt=1.0/11025.0
f=(n+51)*11025.0/512.0
do i=1,512
x(i)=sin(6.2831853*i*dt*f)
enddo
k=k+512
return
end

17
geocentric.f Normal file
View File

@ -0,0 +1,17 @@
subroutine geocentric(alat,elev,hlt,erad)
implicit real*8 (a-h,o-z)
C IAU 1976 flattening f, equatorial radius a
f = 1.d0/298.257d0
a = 6378140.d0
c = 1.d0/sqrt(1.d0 + (-2.d0 + f)*f*sin(alat)*sin(alat))
arcf = (a*c + elev)*cos(alat)
arsf = (a*(1.d0 - f)*(1.d0 - f)*c + elev)*sin(alat)
hlt = datan2(arsf,arcf)
erad = sqrt(arcf*arcf + arsf*arsf)
erad = 0.001d0*erad
return
end

39
getpfx1.f Normal file
View File

@ -0,0 +1,39 @@
subroutine getpfx1(callsign,k)
character callsign*12
character*4 c
include 'pfx.f'
iz=index(callsign,' ') - 1
islash=index(callsign(1:iz),'/')
k=0
c=' '
if(islash.gt.0 .and. (islash.le.4 .or. (islash.eq.5 .and.
+ iz.ge.8))) then
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
else if(islash.gt.5 .or. (islash.eq.5 .and. iz.eq.6)) then
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 continue
if(islash.ne.0 .and.k.eq.0) k=-1
c print*,iz,islash,k,' ',c
return
end

24
getpfx2.f Normal file
View File

@ -0,0 +1,24 @@
subroutine getpfx2(k0,callsign)
character callsign*12
include 'pfx.f'
character addpfx*4
common/gcom4/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.411) 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=4
callsign=addpfx(1:iz)//'/'//callsign
endif
return
end

35
getsnr.f Normal file
View File

@ -0,0 +1,35 @@
subroutine getsnr(x,nz,snr)
real x(nz)
smax=-1.e30
do i=1,nz
if(x(i).gt.smax) then
ipk=i
smax=x(i)
endif
s=s+x(i)
enddo
s=0.
ns=0
do i=1,nz
if(abs(i-ipk).ge.3) then
s=s+x(i)
ns=ns+1
endif
enddo
ave=s/ns
sq=0.
do i=1,nz
if(abs(i-ipk).ge.3) then
sq=sq+(x(i)-ave)**2
ns=ns+1
endif
enddo
rms=sqrt(sq/(nz-2))
snr=(smax-ave)/rms
return
end

92
glpr Normal file
View File

@ -0,0 +1,92 @@
lpr astro.f
lpr Audio.f90
lpr avemsg65.f
lpr avemsg6m.f
lpr avesp2.f
lpr azdist.f
lpr bzap.f
lpr chkmsg.f
lpr coord.f
lpr db.f
lpr dcoord.f
lpr decode65.f
lpr decode6m.f
lpr deep65.f
lpr deg2grid.f
lpr demod64a.f
lpr detect.f
lpr dot.f
lpr encode65.f
lpr extract.f
lpr fivehz.f90
lpr flat1.f
lpr flat2.f
lpr flatten.f
lpr four2a.f
lpr fsubs1.f
lpr fsubs.f
lpr ftsky.f
lpr gasdev.f
lpr gen65.f
lpr gen6m.f
lpr gencw.f
lpr gentone.f
lpr geocentric.f
lpr geodist.f
lpr getpfx1.f
lpr getpfx2.f
lpr getsnr.f
lpr graycode.f
lpr grid2deg.f
lpr grid2k.f
lpr igray.f
lpr indexx.f
lpr interleave63.f
lpr jtaudio.c
lpr k2grid.f
lpr limit.f
lpr longx.f
lpr lpf1.f
lpr moon2.f
lpr MoonDop.f
lpr morse.f
lpr mtdecode.f
lpr nchar.f
lpr packcall.f
lpr packgrid.f
lpr packmsg.f
lpr packtext.f
lpr pctile.f
lpr peakup.f
lpr ping.f
lpr ps.f
lpr ptt.c
lpr ran1.f
lpr resample.c
lpr s2shape.f
lpr set.f
lpr setup65.f
lpr short65.f
lpr slope.f
lpr smooth.f
lpr sort.f
lpr spec2d65.f
lpr spec2d.f
lpr spec441.f
lpr stdecode.f
lpr sun.f
lpr sync65.f
lpr sync.f
lpr syncf0.f
lpr syncf1.f
lpr synct.f
lpr toxyz.f
lpr unpackcall.f
lpr unpackgrid.f
lpr unpackmsg.f
lpr unpacktext.f
lpr wrapkarn.c
lpr wsjt1.f
lpr wsjt65.f
lpr xcor.f
lpr xfft.f

1
go Executable file
View File

@ -0,0 +1 @@
g95 -o JT65code JT65code_all.f wrapkarn.o init_rs.o encode_rs.o decode_rs.o

5
go.bat Normal file
View File

@ -0,0 +1,5 @@
cl /c /DBIGSYM=1 /Foinit_rs.obj init_rs.c
cl /c /DBIGSYM=1 /Foencode_rs.obj encode_rs.c
cl /c /DBIGSYM=1 /Ox /Zd /Fodecode_rs.obj decode_rs.c
cl /c /DWIN32=1 wrapkarn.c
df /exe:JT65code.exe JT65code_all.f /link wrapkarn.obj init_rs.obj encode_rs.obj decode_rs.obj

1
go.py Normal file
View File

@ -0,0 +1 @@
import wsjt

10
graycode.f 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

28
grid2deg.f Normal file
View File

@ -0,0 +1,28 @@
subroutine grid2deg(grid,dlong,dlat)
C Converts Maidenhead grid locator to degrees of West longitude
C and North latitude.
character*6 grid
character*1 g1,g2,g3,g4,g5,g6
if(grid(5:5).eq.' ') grid(5:6)='mm'
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
c print*,nlong,n20d,xminlong,dlong
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
c print*,nlat,xminlat,dlat
return
end

12
grid2k.f 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

18
igray.f Normal file
View File

@ -0,0 +1,18 @@
FUNCTION igray(n,is)
INTEGER igray,is,n
INTEGER idiv,ish
if (is.ge.0) then
igray=ieor(n,n/2)
else
ish=-1
igray=n
1 continue
idiv=ishft(igray,ish)
igray=ieor(igray,idiv)
if(idiv.le.1.or.ish.eq.-16)return
ish=ish+ish
goto 1
endif
return
END
C (C) Copr. 1986-92 Numerical Recipes Software *(t9,12.

79
indexx.f Normal file
View File

@ -0,0 +1,79 @@
SUBROUTINE indexx(n,arr,indx)
INTEGER n,indx(n),M,NSTACK
REAL arr(n)
PARAMETER (M=7,NSTACK=50)
INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
REAL a
do 11 j=1,n
indx(j)=j
11 continue
jstack=0
l=1
ir=n
1 if(ir-l.lt.M)then
do 13 j=l+1,ir
indxt=indx(j)
a=arr(indxt)
do 12 i=j-1,1,-1
if(arr(indx(i)).le.a)goto 2
indx(i+1)=indx(i)
12 continue
i=0
2 indx(i+1)=indxt
13 continue
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)pause '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
C (C) Copr. 1986-92 Numerical Recipes Software *(t9,12.

126
init_rs.c Normal file
View File

@ -0,0 +1,126 @@
/* Initialize a RS codec
*
* Copyright 2002 Phil Karn, KA9Q
* May be used under the terms of the GNU General Public License (GPL)
*/
#include <stdlib.h>
#ifdef CCSDS
#include "ccsds.h"
#elif defined(BIGSYM)
#include "int.h"
#else
#include "char.h"
#endif
#define NULL ((void *)0)
void FREE_RS(void *p){
struct rs *rs = (struct rs *)p;
free(rs->alpha_to);
free(rs->index_of);
free(rs->genpoly);
free(rs);
}
/* Initialize a Reed-Solomon codec
* symsize = symbol size, bits (1-8)
* gfpoly = Field generator polynomial coefficients
* fcr = first root of RS code generator polynomial, index form
* prim = primitive element to generate polynomial roots
* nroots = RS code generator polynomial degree (number of roots)
* pad = padding bytes at front of shortened block
*/
void *INIT_RS(int symsize,int gfpoly,int fcr,int prim,
int nroots,int pad){
struct rs *rs;
int i, j, sr,root,iprim;
/* Check parameter ranges */
if(symsize < 0 || symsize > 8*sizeof(DTYPE))
return NULL; /* Need version with ints rather than chars */
if(fcr < 0 || fcr >= (1<<symsize))
return NULL;
if(prim <= 0 || prim >= (1<<symsize))
return NULL;
if(nroots < 0 || nroots >= (1<<symsize))
return NULL; /* Can't have more roots than symbol values! */
if(pad < 0 || pad >= ((1<<symsize) -1 - nroots))
return NULL; /* Too much padding */
rs = (struct rs *)calloc(1,sizeof(struct rs));
rs->mm = symsize;
rs->nn = (1<<symsize)-1;
rs->pad = pad;
rs->alpha_to = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->alpha_to == NULL){
free(rs);
return NULL;
}
rs->index_of = (DTYPE *)malloc(sizeof(DTYPE)*(rs->nn+1));
if(rs->index_of == NULL){
free(rs->alpha_to);
free(rs);
return NULL;
}
/* Generate Galois field lookup tables */
rs->index_of[0] = A0; /* log(zero) = -inf */
rs->alpha_to[A0] = 0; /* alpha**-inf = 0 */
sr = 1;
for(i=0;i<rs->nn;i++){
rs->index_of[sr] = i;
rs->alpha_to[i] = sr;
sr <<= 1;
if(sr & (1<<symsize))
sr ^= gfpoly;
sr &= rs->nn;
}
if(sr != 1){
/* field generator polynomial is not primitive! */
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
/* Form RS code generator polynomial from its roots */
rs->genpoly = (DTYPE *)malloc(sizeof(DTYPE)*(nroots+1));
if(rs->genpoly == NULL){
free(rs->alpha_to);
free(rs->index_of);
free(rs);
return NULL;
}
rs->fcr = fcr;
rs->prim = prim;
rs->nroots = nroots;
/* Find prim-th root of 1, used in decoding */
for(iprim=1;(iprim % prim) != 0;iprim += rs->nn)
;
rs->iprim = iprim / prim;
rs->genpoly[0] = 1;
for (i = 0,root=fcr*prim; i < nroots; i++,root += prim) {
rs->genpoly[i+1] = 1;
/* Multiply rs->genpoly[] by @**(root + x) */
for (j = i; j > 0; j--){
if (rs->genpoly[j] != 0)
rs->genpoly[j] = rs->genpoly[j-1] ^ rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[j]] + root)];
else
rs->genpoly[j] = rs->genpoly[j-1];
}
/* rs->genpoly[0] can never be zero */
rs->genpoly[0] = rs->alpha_to[modnn(rs,rs->index_of[rs->genpoly[0]] + root)];
}
/* convert rs->genpoly[] to index form for quicker encoding */
for (i = 0; i <= nroots; i++)
rs->genpoly[i] = rs->index_of[rs->genpoly[i]];
return rs;
}

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