mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2026-06-04 23:14:57 -04:00
Rename library directory
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@2635 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
@@ -0,0 +1,74 @@
|
||||
# Makefile for MinGW on Windows
|
||||
CC = gcc
|
||||
FC = g95
|
||||
|
||||
FFLAGS = -O2 -fbounds-check -Wall -Wno-precision-loss -fno-second-underscore
|
||||
CFLAGS = -I. -fbounds-check -mno-stack-arg-probe
|
||||
|
||||
# Default rules
|
||||
%.o: %.c
|
||||
${CC} ${CFLAGS} -c $<
|
||||
%.o: %.f
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.F
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.f90
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.F90
|
||||
${FC} ${FFLAGS} -c $<
|
||||
|
||||
all: libm65.a jt9sim.exe jt9.exe
|
||||
#all: libm65.a jt9.exe
|
||||
|
||||
OBJS1 = trimlist.o display.o getdphi.o pctile.o ccf65.o \
|
||||
decode1a.o sort.o filbig.o fil6521.o afc65b.o \
|
||||
twkfreq.o decode65b.o indexx.o ssort.o fchisq.o setup65.o \
|
||||
extract.o deep65.o ccf2.o demod64a.o chkhist.o graycode.o \
|
||||
interleave63.o unpackmsg.o encode65.o igray.o set.o unpackcall.o \
|
||||
unpackgrid.o grid2k.o unpacktext.o getpfx2.o packmsg.o \
|
||||
deg2grid.o packtext.o getpfx1.o packcall.o k2grid.o packgrid.o \
|
||||
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
|
||||
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o \
|
||||
astro.o tm2.o sun.o moondop.o coord.o tmoonsub.o \
|
||||
geocentric.o moon2.o toxyz.o dot.o dcoord.o f77_wisdom.o \
|
||||
gen65.o chkmsg.o ptt.o astrosub.o astro0.o recvpkt.o symspecx.o \
|
||||
iqcal.o iqfix.o timf2.o s3avg.o genjtms3.o analytic.o \
|
||||
db.o specjtms.o genmsk.o mskdf.o tweak1.o syncmsk.o \
|
||||
lenmsk.o decodemsk.o ping.o makepings.o alignmsg.o match.o \
|
||||
rtping.o jtmsk.o hipass.o setupmsk.o foldmsk.o genjt9.o \
|
||||
packbits.o unpackbits.o encode232.o interleave9.o entail.o \
|
||||
fano232.o spec9.o decode9.o
|
||||
|
||||
libm65.a: $(OBJS1)
|
||||
ar cr libm65.a $(OBJS1)
|
||||
ranlib libm65.a
|
||||
|
||||
OBJS3 = jt9sim.o gran.o
|
||||
jt9sim.exe: $(OBJS3) libm65.a
|
||||
$(FC) -o jt9sim.exe $(OBJS3) libm65.a
|
||||
|
||||
OBJS2 = jt9.o symspec.o timf2x.o timer.o sync9.o
|
||||
jt9.exe: $(OBJS2) libm65.a
|
||||
$(FC) -o jt9.exe $(OBJS2) libm65.a ../libfftw3f_win.a
|
||||
|
||||
INCPATH = -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/QtCore' \
|
||||
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include' \
|
||||
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/ActiveQt' \
|
||||
-I'release' -I'.' -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/mkspecs/win32-g++'
|
||||
ipcomm.o: ipcomm.cpp
|
||||
g++ -c $(INCPATH) ipcomm.cpp
|
||||
|
||||
sec_midn.o: sec_midn.f90
|
||||
$(FC) -c -fno-second-underscore sec_midn.f90
|
||||
|
||||
#symspec.o: ../symspec.f90
|
||||
# $(FC) -c $(FFLAGS) -o symspec.o ../symspec.f90
|
||||
|
||||
OBJS5 = t1.o
|
||||
t1.exe: $(OBJS5) libm65.a
|
||||
$(FC) -o t1.exe $(OBJS5) libm65.a ../libfftw3f_win.a
|
||||
|
||||
.PHONY : clean
|
||||
|
||||
clean:
|
||||
rm -f *.o libm65.a wsjtx.exe jt9sim.exe jt9.exe
|
||||
@@ -0,0 +1,96 @@
|
||||
CC = gcc
|
||||
FC = gfortran
|
||||
|
||||
FFLAGS = -O2 -fbounds-check -Wall
|
||||
# For ptt_unix:
|
||||
CFLAGS = -I. -fbounds-check -DHAVE_STDLIB_H=1 -DHAVE_STDIO_H=1 \
|
||||
-DHAVE_FCNTL_H=1 -DHAVE_SYS_IOCTL_H=1
|
||||
|
||||
# Default rules
|
||||
%.o: %.c
|
||||
${CC} ${CFLAGS} -c $<
|
||||
%.o: %.f
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.F
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.f90
|
||||
${FC} ${FFLAGS} -c $<
|
||||
%.o: %.F90
|
||||
${FC} ${FFLAGS} -c $<
|
||||
|
||||
all: libm65.a m65
|
||||
|
||||
OBJS1 = trimlist.o display.o getdphi.o pctile.o ccf65.o \
|
||||
decode1a.o sort.o filbig.o fil6521.o afc65b.o \
|
||||
twkfreq.o decode65b.o indexx.o ssort.o fchisq.o setup65.o \
|
||||
extract.o deep65.o ccf2.o demod64a.o chkhist.o graycode.o \
|
||||
interleave63.o unpackmsg.o encode65.o igray.o set.o unpackcall.o \
|
||||
unpackgrid.o grid2k.o unpacktext.o getpfx2.o packmsg.o \
|
||||
deg2grid.o packtext.o getpfx1.o packcall.o k2grid.o packgrid.o \
|
||||
wrapkarn.o nchar.o init_rs.o encode_rs.o decode_rs.o \
|
||||
four2a.o rfile3a.o grid2deg.o pfxdump.o dpol.o \
|
||||
astro.o tm2.o sun.o moondop.o coord.o tmoonsub.o \
|
||||
geocentric.o moon2.o toxyz.o dot.o dcoord.o f77_wisdom.o \
|
||||
gen65.o chkmsg.o ptt_unix.o astrosub.o astro0.o recvpkt.o \
|
||||
symspec.o iqcal.o iqfix.o timf2.o s3avg.o
|
||||
|
||||
libm65.a: $(OBJS1)
|
||||
ar cr libm65.a $(OBJS1)
|
||||
ranlib libm65.a
|
||||
|
||||
OBJS3 = m65.o m65a.o map65a.o symspec.o decode0.o ftninit.o ftnquit.o \
|
||||
timer.o ipcomm.o sec_midn.o cutil.o
|
||||
|
||||
m65: $(OBJS3) libm65.a
|
||||
g++ -o m65 $(OBJS3) libm65.a -lfftw3f -lQtCore -lfftw3f -lgfortran
|
||||
|
||||
OBJS2 = m65a.o ipcomm.o sec_midn.o cutil.o decode0.o map65a.o \
|
||||
timer.o ftninit.o ftnquit.o
|
||||
LIBS2 = -lQtCore -lfftw3f -lgfortran
|
||||
|
||||
m65a: $(OBJS2) libm65.a
|
||||
g++ -o m65a $(OBJS2) libm65.a -lQtCore -lfftw3f -lgfortran
|
||||
|
||||
OBJS6 = t3.o ipcomm.o
|
||||
LIBS2 = -lQtCore -lgfortran
|
||||
|
||||
t3: $(OBJS6)
|
||||
g++ -o t3 $(OBJS6) $(LIBS2)
|
||||
|
||||
t3:
|
||||
|
||||
INCPATH = -I. -I'/usr/include/qt4' -I'/usr/include/qt4/QtCore'
|
||||
|
||||
ipcomm.o: ipcomm.cpp
|
||||
g++ -c $(INCPATH) ipcomm.cpp
|
||||
|
||||
m65a.o: m65a.F90
|
||||
$(FC) -c -fno-second-underscore -DUNIX m65a.F90
|
||||
|
||||
extract.o: extract.F
|
||||
$(FC) -c -fno-second-underscore -DUNIX extract.F
|
||||
|
||||
sec_midn.o: sec_midn.f90
|
||||
$(FC) -c -fno-second-underscore sec_midn.f90
|
||||
|
||||
OBJS4 = tastro.o astro0.o libm65.a
|
||||
tastro: $(OBJS4)
|
||||
$(FC) $(FFLAGS) -o tastro $(OBJS4) libm65.a
|
||||
|
||||
OBJS5 = t1.o timer.o libm65.a
|
||||
t1: $(OBJS5)
|
||||
$(FC) $(FFLAGS) -o t1 $(OBJS5) libm65.a
|
||||
|
||||
init_rs.o: init_rs.c
|
||||
$(CC) -c -DBIGSYM=1 -o init_rs.o init_rs.c
|
||||
|
||||
encode_rs.o: encode_rs.c
|
||||
$(CC) -c -DBIGSYM=1 -o encode_rs.o encode_rs.c
|
||||
|
||||
decode_rs.o: decode_rs.c
|
||||
$(CC) -c -DBIGSYM=1 -o decode_rs.o decode_rs.c
|
||||
|
||||
.PHONY : clean
|
||||
|
||||
clean:
|
||||
rm -f *.o libm65.a m65 m65a
|
||||
@@ -0,0 +1,25 @@
|
||||
subroutine analytic(d,npts,nfft,s,c)
|
||||
|
||||
! Convert real data to analytic signal
|
||||
|
||||
parameter (NFFTMAX=128*1024)
|
||||
real d(npts)
|
||||
real s(npts)
|
||||
complex c(NFFTMAX)
|
||||
|
||||
nh=nfft/2
|
||||
fac=2.0/nfft
|
||||
c(1:npts)=fac*d(1:npts)
|
||||
c(npts+1:nfft)=0.
|
||||
call four2a(c,nfft,1,-1,1) !Forward c2c FFT
|
||||
|
||||
do i=1,nh
|
||||
s(i)=real(c(i))**2 + aimag(c(i))**2
|
||||
enddo
|
||||
|
||||
c(1)=0.5*c(1)
|
||||
c(nh+2:nfft)=0.
|
||||
call four2a(c,nfft,1,1,1) !Inverse c2c FFT
|
||||
|
||||
return
|
||||
end subroutine analytic
|
||||
@@ -0,0 +1,256 @@
|
||||
-12.8 1.000 -9.966 1.000000 0.000000
|
||||
-12.7 1.000 -9.966 1.000000 0.000000
|
||||
-12.6 1.000 -9.966 1.000000 0.000000
|
||||
-12.5 1.000 -9.966 1.000000 0.000000
|
||||
-12.4 1.000 -9.966 1.000000 0.000000
|
||||
-12.3 1.000 -9.966 1.000000 0.000000
|
||||
-12.2 1.000 -9.966 1.000000 0.000000
|
||||
-12.1 1.000 -9.966 1.000000 0.000000
|
||||
-12.0 1.000 -9.966 1.000000 0.000000
|
||||
-11.9 1.000 -9.966 1.000000 0.000000
|
||||
-11.8 1.000 -9.966 1.000000 0.000000
|
||||
-11.7 1.000 -9.966 1.000000 0.000000
|
||||
-11.6 1.000 -9.966 1.000000 0.000000
|
||||
-11.5 1.000 -9.966 1.000000 0.000000
|
||||
-11.4 1.000 -9.966 1.000000 0.000000
|
||||
-11.3 1.000 -9.966 1.000000 0.000000
|
||||
-11.2 1.000 -9.966 1.000000 0.000000
|
||||
-11.1 1.000 -9.966 1.000000 0.000000
|
||||
-11.0 1.000 -9.966 1.000000 0.000000
|
||||
-10.9 1.000 -9.966 1.000000 0.000000
|
||||
-10.8 1.000 -9.966 1.000000 0.000000
|
||||
-10.7 1.000 -9.966 1.000000 0.000000
|
||||
-10.6 1.000 -9.966 1.000000 0.000000
|
||||
-10.5 1.000 -9.966 1.000000 0.000000
|
||||
-10.4 1.000 -9.966 1.000000 0.000000
|
||||
-10.3 1.000 -9.966 1.000000 0.000000
|
||||
-10.2 1.000 -9.966 1.000000 0.000000
|
||||
-10.1 1.000 -9.966 1.000000 0.000000
|
||||
-10.0 1.000 -9.966 1.000000 0.000000
|
||||
-9.9 1.000 -9.966 1.000000 0.000000
|
||||
-9.8 1.000 -9.966 1.000000 0.000000
|
||||
-9.7 1.000 -9.966 1.000000 0.000000
|
||||
-9.6 1.000 -9.966 1.000000 0.000000
|
||||
-9.5 1.000 -9.966 1.000000 0.000000
|
||||
-9.4 1.000 -9.966 1.000000 0.000000
|
||||
-9.3 1.000 -9.966 1.000000 0.000000
|
||||
-9.2 1.000 -9.966 1.000000 0.000000
|
||||
-9.1 1.000 -9.966 1.000000 0.000000
|
||||
-9.0 1.000 -9.966 1.000000 0.000000
|
||||
-8.9 1.000 -9.966 1.000000 0.000000
|
||||
-8.8 1.000 -9.966 1.000000 0.000000
|
||||
-8.7 1.000 -9.966 1.000000 0.000000
|
||||
-8.6 1.000 -9.966 1.000000 0.000000
|
||||
-8.5 1.000 -9.966 1.000000 0.000000
|
||||
-8.4 1.000 -9.966 1.000000 0.000000
|
||||
-8.3 1.000 -9.966 1.000000 0.000000
|
||||
-8.2 1.000 -9.966 1.000000 0.000000
|
||||
-8.1 1.000 -9.966 1.000000 0.000000
|
||||
-8.0 1.000 -9.966 1.000000 0.000000
|
||||
-7.9 1.000 -9.966 1.000000 0.000000
|
||||
-7.8 1.000 -9.966 1.000000 0.000000
|
||||
-7.7 1.000 -9.966 1.000000 0.000000
|
||||
-7.6 1.000 -9.966 1.000000 0.000000
|
||||
-7.5 1.000 -9.966 1.000000 0.000000
|
||||
-7.4 1.000 -9.966 1.000000 0.000000
|
||||
-7.3 1.000 -9.966 1.000000 0.000000
|
||||
-7.2 1.000 -9.966 1.000000 0.000000
|
||||
-7.1 1.000 -9.966 1.000000 0.000000
|
||||
-7.0 1.000 -9.966 1.000000 0.000000
|
||||
-6.9 1.000 -9.966 1.000000 0.000000
|
||||
-6.8 1.000 -9.966 1.000000 0.000000
|
||||
-6.7 1.000 -9.966 1.000000 0.000000
|
||||
-6.6 1.000 -9.966 1.000000 0.000000
|
||||
-6.5 1.000 -9.966 1.000000 0.000000
|
||||
-6.4 1.000 -9.966 1.000000 0.000000
|
||||
-6.3 1.000 -9.966 1.000000 0.000000
|
||||
-6.2 1.000 -9.966 1.000000 0.000000
|
||||
-6.1 1.000 -9.966 1.000000 0.000000
|
||||
-6.0 1.000 -9.966 1.000000 0.000000
|
||||
-5.9 1.000 -9.966 1.000000 0.000000
|
||||
-5.8 1.000 -9.966 1.000000 0.000000
|
||||
-5.7 1.000 -9.966 1.000000 0.000000
|
||||
-5.6 1.000 -9.966 1.000000 0.000000
|
||||
-5.5 1.000 -9.966 1.000000 0.000000
|
||||
-5.4 1.000 -9.966 1.000000 0.000000
|
||||
-5.3 1.000 -9.966 1.000000 0.000000
|
||||
-5.2 1.000 -9.966 1.000000 0.000000
|
||||
-5.1 1.000 -9.966 1.000000 0.000000
|
||||
-5.0 1.000 -9.966 1.000000 0.000000
|
||||
-4.9 1.000 -9.966 1.000000 0.000000
|
||||
-4.8 1.000 -9.966 1.000000 0.000000
|
||||
-4.7 1.000 -9.966 1.000000 0.000000
|
||||
-4.6 1.000 -9.966 1.000000 0.000000
|
||||
-4.5 1.000 -9.966 1.000000 0.000000
|
||||
-4.4 1.000 -9.966 1.000000 0.000000
|
||||
-4.3 1.000 -9.966 1.000000 0.000000
|
||||
-4.2 1.000 -9.966 1.000000 0.000000
|
||||
-4.1 1.000 -9.966 1.000000 0.000000
|
||||
-4.0 1.000 -9.966 1.000000 0.000000
|
||||
-3.9 1.000 -9.966 1.000000 0.000000
|
||||
-3.8 1.000 -9.966 1.000000 0.000000
|
||||
-3.7 1.000 -9.966 1.000000 0.000000
|
||||
-3.6 1.000 -9.966 1.000000 0.000000
|
||||
-3.5 1.000 -9.966 1.000000 0.000000
|
||||
-3.4 1.000 -9.966 1.000000 0.000000
|
||||
-3.3 1.000 -9.966 1.000000 0.000000
|
||||
-3.2 1.000 -9.966 1.000000 0.000000
|
||||
-3.1 1.000 -9.966 1.000000 0.000000
|
||||
-3.0 1.000 -9.966 1.000000 0.000000
|
||||
-2.9 1.000 -9.966 1.000000 0.000000
|
||||
-2.8 1.000 -9.966 0.999955 0.000045
|
||||
-2.7 1.000 -9.966 0.999968 0.000032
|
||||
-2.6 1.000 -9.966 0.999909 0.000091
|
||||
-2.5 1.000 -9.966 0.999983 0.000017
|
||||
-2.4 1.000 -9.966 0.999937 0.000063
|
||||
-2.3 1.000 -9.966 0.999914 0.000086
|
||||
-2.2 1.000 -9.966 0.999813 0.000187
|
||||
-2.1 1.000 -9.966 0.999775 0.000225
|
||||
-2.0 1.000 -9.966 0.999671 0.000329
|
||||
-1.9 0.999 -9.966 0.999531 0.000469
|
||||
-1.8 0.999 -9.308 0.999211 0.000789
|
||||
-1.7 0.998 -8.893 0.998948 0.001052
|
||||
-1.6 0.998 -8.191 0.998290 0.001710
|
||||
-1.5 0.996 -7.655 0.997519 0.002481
|
||||
-1.4 0.994 -7.037 0.996192 0.003808
|
||||
-1.3 0.992 -6.513 0.994525 0.005475
|
||||
-1.2 0.988 -5.931 0.991804 0.008196
|
||||
-1.1 0.982 -5.359 0.987816 0.012184
|
||||
-1.0 0.974 -4.789 0.981916 0.018084
|
||||
-0.9 0.961 -4.217 0.973110 0.026890
|
||||
-0.8 0.942 -3.672 0.960785 0.039215
|
||||
-0.7 0.915 -3.123 0.942613 0.057387
|
||||
-0.6 0.874 -2.582 0.916477 0.083523
|
||||
-0.5 0.816 -2.062 0.880296 0.119704
|
||||
-0.4 0.734 -1.573 0.831905 0.168095
|
||||
-0.3 0.619 -1.109 0.768168 0.231832
|
||||
-0.2 0.465 -0.690 0.690103 0.309897
|
||||
-0.1 0.260 -0.317 0.598759 0.401241
|
||||
0.0 0.000 0.000 0.500000 0.500000
|
||||
0.1 -0.317 0.260 0.401241 0.598759
|
||||
0.2 -0.690 0.465 0.309897 0.690103
|
||||
0.3 -1.109 0.619 0.231832 0.768168
|
||||
0.4 -1.573 0.734 0.168095 0.831905
|
||||
0.5 -2.062 0.816 0.119704 0.880296
|
||||
0.6 -2.582 0.874 0.083523 0.916477
|
||||
0.7 -3.123 0.915 0.057387 0.942613
|
||||
0.8 -3.672 0.942 0.039215 0.960785
|
||||
0.9 -4.217 0.961 0.026890 0.973110
|
||||
1.0 -4.789 0.974 0.018084 0.981916
|
||||
1.1 -5.359 0.982 0.012184 0.987816
|
||||
1.2 -5.931 0.988 0.008196 0.991804
|
||||
1.3 -6.513 0.992 0.005475 0.994525
|
||||
1.4 -7.037 0.994 0.003808 0.996192
|
||||
1.5 -7.655 0.996 0.002481 0.997519
|
||||
1.6 -8.191 0.998 0.001710 0.998290
|
||||
1.7 -8.893 0.998 0.001052 0.998948
|
||||
1.8 -9.308 0.999 0.000789 0.999211
|
||||
1.9 -9.966 0.999 0.000469 0.999531
|
||||
2.0 -9.966 1.000 0.000329 0.999671
|
||||
2.1 -9.966 1.000 0.000225 0.999775
|
||||
2.2 -9.966 1.000 0.000187 0.999813
|
||||
2.3 -9.966 1.000 0.000086 0.999914
|
||||
2.4 -9.966 1.000 0.000063 0.999937
|
||||
2.5 -9.966 1.000 0.000017 0.999983
|
||||
2.6 -9.966 1.000 0.000091 0.999909
|
||||
2.7 -9.966 1.000 0.000032 0.999968
|
||||
2.8 -9.966 1.000 0.000045 0.999955
|
||||
2.9 -9.966 1.000 0.000000 1.000000
|
||||
3.0 -9.966 1.000 0.000000 1.000000
|
||||
3.1 -9.966 1.000 0.000000 1.000000
|
||||
3.2 -9.966 1.000 0.000000 1.000000
|
||||
3.3 -9.966 1.000 0.000000 1.000000
|
||||
3.4 -9.966 1.000 0.000000 1.000000
|
||||
3.5 -9.966 1.000 0.000000 1.000000
|
||||
3.6 -9.966 1.000 0.000000 1.000000
|
||||
3.7 -9.966 1.000 0.000000 1.000000
|
||||
3.8 -9.966 1.000 0.000000 1.000000
|
||||
3.9 -9.966 1.000 0.000000 1.000000
|
||||
4.0 -9.966 1.000 0.000000 1.000000
|
||||
4.1 -9.966 1.000 0.000000 1.000000
|
||||
4.2 -9.966 1.000 0.000000 1.000000
|
||||
4.3 -9.966 1.000 0.000000 1.000000
|
||||
4.4 -9.966 1.000 0.000000 1.000000
|
||||
4.5 -9.966 1.000 0.000000 1.000000
|
||||
4.6 -9.966 1.000 0.000000 1.000000
|
||||
4.7 -9.966 1.000 0.000000 1.000000
|
||||
4.8 -9.966 1.000 0.000000 1.000000
|
||||
4.9 -9.966 1.000 0.000000 1.000000
|
||||
5.0 -9.966 1.000 0.000000 1.000000
|
||||
5.1 -9.966 1.000 0.000000 1.000000
|
||||
5.2 -9.966 1.000 0.000000 1.000000
|
||||
5.3 -9.966 1.000 0.000000 1.000000
|
||||
5.4 -9.966 1.000 0.000000 1.000000
|
||||
5.5 -9.966 1.000 0.000000 1.000000
|
||||
5.6 -9.966 1.000 0.000000 1.000000
|
||||
5.7 -9.966 1.000 0.000000 1.000000
|
||||
5.8 -9.966 1.000 0.000000 1.000000
|
||||
5.9 -9.966 1.000 0.000000 1.000000
|
||||
6.0 -9.966 1.000 0.000000 1.000000
|
||||
6.1 -9.966 1.000 0.000000 1.000000
|
||||
6.2 -9.966 1.000 0.000000 1.000000
|
||||
6.3 -9.966 1.000 0.000000 1.000000
|
||||
6.4 -9.966 1.000 0.000000 1.000000
|
||||
6.5 -9.966 1.000 0.000000 1.000000
|
||||
6.6 -9.966 1.000 0.000000 1.000000
|
||||
6.7 -9.966 1.000 0.000000 1.000000
|
||||
6.8 -9.966 1.000 0.000000 1.000000
|
||||
6.9 -9.966 1.000 0.000000 1.000000
|
||||
7.0 -9.966 1.000 0.000000 1.000000
|
||||
7.1 -9.966 1.000 0.000000 1.000000
|
||||
7.2 -9.966 1.000 0.000000 1.000000
|
||||
7.3 -9.966 1.000 0.000000 1.000000
|
||||
7.4 -9.966 1.000 0.000000 1.000000
|
||||
7.5 -9.966 1.000 0.000000 1.000000
|
||||
7.6 -9.966 1.000 0.000000 1.000000
|
||||
7.7 -9.966 1.000 0.000000 1.000000
|
||||
7.8 -9.966 1.000 0.000000 1.000000
|
||||
7.9 -9.966 1.000 0.000000 1.000000
|
||||
8.0 -9.966 1.000 0.000000 1.000000
|
||||
8.1 -9.966 1.000 0.000000 1.000000
|
||||
8.2 -9.966 1.000 0.000000 1.000000
|
||||
8.3 -9.966 1.000 0.000000 1.000000
|
||||
8.4 -9.966 1.000 0.000000 1.000000
|
||||
8.5 -9.966 1.000 0.000000 1.000000
|
||||
8.6 -9.966 1.000 0.000000 1.000000
|
||||
8.7 -9.966 1.000 0.000000 1.000000
|
||||
8.8 -9.966 1.000 0.000000 1.000000
|
||||
8.9 -9.966 1.000 0.000000 1.000000
|
||||
9.0 -9.966 1.000 0.000000 1.000000
|
||||
9.1 -9.966 1.000 0.000000 1.000000
|
||||
9.2 -9.966 1.000 0.000000 1.000000
|
||||
9.3 -9.966 1.000 0.000000 1.000000
|
||||
9.4 -9.966 1.000 0.000000 1.000000
|
||||
9.5 -9.966 1.000 0.000000 1.000000
|
||||
9.6 -9.966 1.000 0.000000 1.000000
|
||||
9.7 -9.966 1.000 0.000000 1.000000
|
||||
9.8 -9.966 1.000 0.000000 1.000000
|
||||
9.9 -9.966 1.000 0.000000 1.000000
|
||||
10.0 -9.966 1.000 0.000000 1.000000
|
||||
10.1 -9.966 1.000 0.000000 1.000000
|
||||
10.2 -9.966 1.000 0.000000 1.000000
|
||||
10.3 -9.966 1.000 0.000000 1.000000
|
||||
10.4 -9.966 1.000 0.000000 1.000000
|
||||
10.5 -9.966 1.000 0.000000 1.000000
|
||||
10.6 -9.966 1.000 0.000000 1.000000
|
||||
10.7 -9.966 1.000 0.000000 1.000000
|
||||
10.8 -9.966 1.000 0.000000 1.000000
|
||||
10.9 -9.966 1.000 0.000000 1.000000
|
||||
11.0 -9.966 1.000 0.000000 1.000000
|
||||
11.1 -9.966 1.000 0.000000 1.000000
|
||||
11.2 -9.966 1.000 0.000000 1.000000
|
||||
11.3 -9.966 1.000 0.000000 1.000000
|
||||
11.4 -9.966 1.000 0.000000 1.000000
|
||||
11.5 -9.966 1.000 0.000000 1.000000
|
||||
11.6 -9.966 1.000 0.000000 1.000000
|
||||
11.7 -9.966 1.000 0.000000 1.000000
|
||||
11.8 -9.966 1.000 0.000000 1.000000
|
||||
11.9 -9.966 1.000 0.000000 1.000000
|
||||
12.0 -9.966 1.000 0.000000 1.000000
|
||||
12.1 -9.966 1.000 0.000000 1.000000
|
||||
12.2 -9.966 1.000 0.000000 1.000000
|
||||
12.3 -9.966 1.000 0.000000 1.000000
|
||||
12.4 -9.966 1.000 0.000000 1.000000
|
||||
12.5 -9.966 1.000 0.000000 1.000000
|
||||
12.6 -9.966 1.000 0.000000 1.000000
|
||||
12.7 -9.966 1.000 0.000000 1.000000
|
||||
@@ -0,0 +1,38 @@
|
||||
! Layland-Lushbaugh polynomials for a K=32, r=1/2 convolutional code,
|
||||
! and 8-bit parity lookup table.
|
||||
|
||||
data npoly1/-221228207/,npoly2/-463389625/
|
||||
integer*1 partab(0:255)
|
||||
data partab/ &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
0, 1, 1, 0, 1, 0, 0, 1, &
|
||||
1, 0, 0, 1, 0, 1, 1, 0/
|
||||
+93
@@ -0,0 +1,93 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <unistd.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
// #include <sys/times.h>
|
||||
// #include <time.h>
|
||||
// #include <sys/time.h>
|
||||
#include "sleep.h"
|
||||
#include "timeval.h"
|
||||
|
||||
/* FORTRAN: fd = close(filedes) */
|
||||
int close_(int *filedes)
|
||||
{
|
||||
return(close(*filedes));
|
||||
}
|
||||
/* FORTRAN: fd = open(filnam,mode) */
|
||||
int open_(char filnam[], int *mode)
|
||||
{
|
||||
return(open(filnam,*mode));
|
||||
}
|
||||
/* FORTRAN: fd = creat(filnam,mode) */
|
||||
int creat_(char filnam[],int *mode)
|
||||
{
|
||||
return(creat(filnam,*mode));
|
||||
}
|
||||
/* FORTRAN: nread = read(fd,buf,n) */
|
||||
int read_(int *fd, char buf[], int *n)
|
||||
{
|
||||
return(read(*fd,buf,*n));
|
||||
}
|
||||
/* FORTRAN: nwrt = write(fd,buf,n) */
|
||||
int write_(int *fd, char buf[], int *n)
|
||||
{
|
||||
return(write(*fd,buf,*n));
|
||||
}
|
||||
/* FORTRAN: ns = lseek(fd,offset,origin) */
|
||||
int lseek_(int *fd,int *offset, int *origin)
|
||||
{
|
||||
return(lseek(*fd,*offset,*origin));
|
||||
}
|
||||
/* times(2) */
|
||||
//int times_(struct tms *buf)
|
||||
//{
|
||||
// return (times(buf));
|
||||
//}
|
||||
/* ioperm(2) */
|
||||
//ioperm_(from,num,turn_on)
|
||||
//unsigned long *from,*num,*turn_on;
|
||||
//{
|
||||
// return (ioperm(*from,*num,*turn_on));
|
||||
// return (i386_get_ioperm(*from,*num,*turn_on));
|
||||
//}
|
||||
|
||||
/* usleep(3) */
|
||||
void usleep_(unsigned long *microsec)
|
||||
{
|
||||
usleep(*microsec);
|
||||
}
|
||||
|
||||
/* returns random numbers between 0 and 32767 to FORTRAN program */
|
||||
int iran_(int *arg)
|
||||
{
|
||||
return (rand());
|
||||
}
|
||||
|
||||
int exit_(int *n)
|
||||
{
|
||||
printf("\n\n");
|
||||
exit(*n);
|
||||
}
|
||||
|
||||
/*
|
||||
struct tm *
|
||||
gmtime_r_(const time_t *clock, struct tm *result)
|
||||
{
|
||||
gmtime_r(clock, result);
|
||||
}
|
||||
*/
|
||||
|
||||
time_t time_(void)
|
||||
{
|
||||
return time(0);
|
||||
}
|
||||
|
||||
/* hrtime() */
|
||||
double hrtime_(void)
|
||||
{
|
||||
struct timeval tv;
|
||||
gettimeofday(&tv,NULL);
|
||||
return(tv.tv_sec+1.e-6*tv.tv_usec);
|
||||
}
|
||||
@@ -0,0 +1,5 @@
|
||||
real function db(x)
|
||||
db=-99.0
|
||||
if(x.gt.1.259e-10) db=10.0*log10(x)
|
||||
return
|
||||
end function db
|
||||
@@ -0,0 +1,64 @@
|
||||
subroutine decode0(dd,ss,savg,nstandalone)
|
||||
|
||||
parameter (NSMAX=60*96000)
|
||||
parameter (NFFT=32768)
|
||||
|
||||
real*4 dd(4,NSMAX),ss(4,322,NFFT),savg(4,NFFT)
|
||||
real*8 fcenter
|
||||
integer hist(0:32768)
|
||||
character mycall*12,hiscall*12,mygrid*6,hisgrid*6,datetime*20
|
||||
character mycall0*12,hiscall0*12,hisgrid0*6
|
||||
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
|
||||
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
|
||||
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
|
||||
mycall,mygrid,hiscall,hisgrid,datetime
|
||||
common/tracer/ limtrace,lu
|
||||
data neme0/-99/,mcall3b/1/
|
||||
save
|
||||
|
||||
call timer('decode0 ',0)
|
||||
|
||||
if(newdat.ne.0) then
|
||||
nz=52*96000
|
||||
hist=0
|
||||
do i=1,nz
|
||||
j1=min(abs(dd(1,i)),32768.0)
|
||||
hist(j1)=hist(j1)+1
|
||||
j2=min(abs(dd(2,i)),32768.0)
|
||||
hist(j2)=hist(j2)+1
|
||||
j3=min(abs(dd(3,i)),32768.0)
|
||||
hist(j3)=hist(j3)+1
|
||||
j4=min(abs(dd(4,i)),32768.0)
|
||||
hist(j4)=hist(j4)+1
|
||||
enddo
|
||||
m=0
|
||||
do i=0,32768
|
||||
m=m+hist(i)
|
||||
if(m.ge.2*nz) go to 10
|
||||
enddo
|
||||
10 rmsdd=1.5*i
|
||||
endif
|
||||
nhsym=279
|
||||
ndphi=0
|
||||
if(iand(nrxlog,8).ne.0) ndphi=1
|
||||
|
||||
if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0 .or. &
|
||||
hisgrid.ne.hisgrid0 .or. mcall3.ne.0 .or. neme.ne.neme0) mcall3b=1
|
||||
|
||||
mycall0=mycall
|
||||
hiscall0=hiscall
|
||||
hisgrid0=hisgrid
|
||||
neme0=neme
|
||||
|
||||
call timer('map65a ',0)
|
||||
call map65a(dd,ss,savg,newdat,nutc,fcenter,ntol,idphi,nfa,nfb, &
|
||||
mousedf,mousefqso,nagain,ndecdone,ndiskdat,nfshift,ndphi, &
|
||||
nfcal,nkeep,mcall3b,nsave,nxant,rmsdd,mycall,mygrid, &
|
||||
neme,ndepth,hiscall,hisgrid,nhsym,nfsample,nxpol,mode65)
|
||||
|
||||
call timer('map65a ',1)
|
||||
call timer('decode0 ',1)
|
||||
if(nstandalone.eq.0) call timer('decode0 ',101)
|
||||
|
||||
return
|
||||
end subroutine decode0
|
||||
@@ -0,0 +1,54 @@
|
||||
subroutine decode9(i1SoftSymbols,msg)
|
||||
|
||||
! Decoder for JT9
|
||||
! Input: i1SoftSymbols(207) - Single-bit soft symbols
|
||||
! Output: msg - decoded message (blank if erasure)
|
||||
|
||||
character*22 msg
|
||||
integer*4 i4DecodedBytes(9)
|
||||
integer*4 i4Decoded6BitWords(12)
|
||||
integer*1 i1DecodedBytes(13) !72 bits and zero tail as 8-bit bytes
|
||||
integer*1 i1SoftSymbols(207)
|
||||
integer*1 i1DecodedBits(72)
|
||||
|
||||
integer*1 i1
|
||||
logical first
|
||||
integer*4 mettab(0:255,0:1)
|
||||
equivalence (i1,i4)
|
||||
data first/.true./
|
||||
save
|
||||
|
||||
if(first) then
|
||||
! Get the metric table
|
||||
bias=0.37 !To be optimized, in decoder program
|
||||
scale=10 ! ... ditto ...
|
||||
open(19,file='met8.21',status='old')
|
||||
do i=0,255
|
||||
read(19,*) x00,x0,x1
|
||||
mettab(i,0)=nint(scale*(x0-bias))
|
||||
mettab(i,1)=nint(scale*(x1-bias)) !### Check range, etc. ###
|
||||
enddo
|
||||
close(19)
|
||||
first=.false.
|
||||
endif
|
||||
|
||||
msg=' '
|
||||
nbits=72
|
||||
ndelta=17
|
||||
limit=10000
|
||||
call fano232(i1SoftSymbols,nbits+31,mettab,ndelta,limit,i1DecodedBytes, &
|
||||
ncycles,metric,ierr,maxmetric,maxnp)
|
||||
|
||||
if(ncycles.lt.(nbits*limit)) then
|
||||
nbytes=(nbits+7)/8
|
||||
do i=1,nbytes
|
||||
n=i1DecodedBytes(i)
|
||||
i4DecodedBytes(i)=iand(n,255)
|
||||
enddo
|
||||
call unpackbits(i4DecodedBytes,nbytes,8,i1DecodedBits)
|
||||
call packbits(i1DecodedBits,12,6,i4Decoded6BitWords)
|
||||
call unpackmsg(i4Decoded6BitWords,msg) !Unpack decoded msg
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine decode9
|
||||
+263
@@ -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(®[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;
|
||||
}
|
||||
@@ -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
|
||||
@@ -0,0 +1,33 @@
|
||||
subroutine encode232(dat,nsym,symbol)
|
||||
|
||||
! Convolutional encoder for a K=32, r=1/2 code.
|
||||
|
||||
integer*1 dat(13) !User data, packed 8 bits per byte
|
||||
integer*1 symbol(500) !Channel symbols, one bit per byte
|
||||
integer*1 i1
|
||||
include 'conv232.f90'
|
||||
|
||||
nstate=0
|
||||
k=0
|
||||
do j=1,nsym
|
||||
do i=7,0,-1
|
||||
i1=dat(j)
|
||||
i4=i1
|
||||
if (i4.lt.0) i4=i4+256
|
||||
nstate=ior(ishft(nstate,1),iand(ishft(i4,-i),1))
|
||||
n=iand(nstate,npoly1)
|
||||
n=ieor(n,ishft(n,-16))
|
||||
k=k+1
|
||||
symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255))
|
||||
n=iand(nstate,npoly2)
|
||||
n=ieor(n,ishft(n,-16))
|
||||
k=k+1
|
||||
symbol(k)=partab(iand(ieor(n,ishft(n,-8)),255))
|
||||
if(k.ge.nsym) go to 100
|
||||
enddo
|
||||
enddo
|
||||
|
||||
100 continue
|
||||
|
||||
return
|
||||
end subroutine encode232
|
||||
@@ -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;
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,30 @@
|
||||
subroutine entail(dgen,data0)
|
||||
|
||||
! Move 72-bit packed data from 6-bit to 8-bit symbols and add a zero tail.
|
||||
integer dgen(13)
|
||||
integer*1 data0(13)
|
||||
|
||||
i4=0
|
||||
k=0
|
||||
m=0
|
||||
do i=1,12
|
||||
n=dgen(i)
|
||||
do j=1,6
|
||||
k=k+1
|
||||
i4=i4+i4+iand(1,ishft(n,j-6))
|
||||
i4=iand(i4,255)
|
||||
if(k.eq.8) then
|
||||
m=m+1
|
||||
if(i4.gt.127) i4=i4-256
|
||||
data0(m)=i4
|
||||
k=0
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
do m=10,13
|
||||
data0(m)=0
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine entail
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
subroutine write_char(c, iunit)
|
||||
character c
|
||||
integer iunit
|
||||
write(iunit,1000) c
|
||||
1000 format(a,$)
|
||||
end
|
||||
|
||||
subroutine export_wisdom_to_file(iunit)
|
||||
integer iunit
|
||||
external write_char
|
||||
c call dfftw_export_wisdom(write_char, iunit)
|
||||
call sfftw_export_wisdom(write_char, iunit)
|
||||
end
|
||||
|
||||
subroutine read_char(ic, iunit)
|
||||
integer ic
|
||||
integer iunit
|
||||
character*256 buf
|
||||
save buf
|
||||
integer ibuf
|
||||
data ibuf/257/
|
||||
save ibuf
|
||||
if (ibuf .lt. 257) then
|
||||
ic = ichar(buf(ibuf:ibuf))
|
||||
ibuf = ibuf + 1
|
||||
return
|
||||
endif
|
||||
read(iunit,1000,end=10) buf
|
||||
1000 format(a256)
|
||||
ic = ichar(buf(1:1))
|
||||
ibuf = 2
|
||||
return
|
||||
10 ic = -1
|
||||
ibuf = 257
|
||||
rewind iunit
|
||||
return
|
||||
end
|
||||
|
||||
subroutine import_wisdom_from_file(isuccess, iunit)
|
||||
integer isuccess
|
||||
integer iunit
|
||||
external read_char
|
||||
c call dfftw_import_wisdom(isuccess, read_char, iunit)
|
||||
call sfftw_import_wisdom(isuccess, read_char, iunit)
|
||||
end
|
||||
+164
@@ -0,0 +1,164 @@
|
||||
subroutine fano232(symbol,nbits,mettab,ndelta,maxcycles,dat, &
|
||||
ncycles,metric,ierr,maxmetric,maxnp)
|
||||
|
||||
! Sequential decoder for K=32, r=1/2 convolutional code using
|
||||
! the Fano algorithm. Translated from C routine for same purpose
|
||||
! written by Phil Karn, KA9Q.
|
||||
|
||||
parameter (MAXBITS=103)
|
||||
parameter (MAXDAT=(MAXBITS+7)/8)
|
||||
integer*1 symbol(0:2*MAXBITS-1)
|
||||
integer*1 dat(MAXDAT) !Decoded user data, 8 bits per byte
|
||||
integer mettab(0:255,0:1) !Metric table
|
||||
|
||||
! These were the "node" structure in Karn's C code:
|
||||
integer nstate(0:MAXBITS-1) !Encoder state of next node
|
||||
integer gamma(0:MAXBITS-1) !Cumulative metric to this node
|
||||
integer metrics(0:3,0:MAXBITS-1) !Metrics indexed by all possible Tx syms
|
||||
integer tm(0:1,0:MAXBITS-1) !Sorted metrics for current hypotheses
|
||||
integer ii(0:MAXBITS-1) !Current branch being tested
|
||||
|
||||
logical noback
|
||||
include 'conv232.f90'
|
||||
|
||||
maxmetric=-9999999
|
||||
maxnp=-9999999
|
||||
ntail=nbits-31
|
||||
|
||||
! Compute all possible branch metrics for each symbol pair.
|
||||
! This is the only place we actually look at the raw input symbols
|
||||
i4a=0
|
||||
i4b=0
|
||||
do np=0,nbits-1
|
||||
j=2*np
|
||||
i4a=symbol(j)
|
||||
i4b=symbol(j+1)
|
||||
if (i4a.lt.0) i4a=i4a+256
|
||||
if (i4b.lt.0) i4b=i4b+256
|
||||
metrics(0,np) = mettab(i4a,0) + mettab(i4b,0)
|
||||
metrics(1,np) = mettab(i4a,0) + mettab(i4b,1)
|
||||
metrics(2,np) = mettab(i4a,1) + mettab(i4b,0)
|
||||
metrics(3,np) = mettab(i4a,1) + mettab(i4b,1)
|
||||
enddo
|
||||
|
||||
np=0
|
||||
nstate(np)=0
|
||||
|
||||
! Compute and sort branch metrics from the root node
|
||||
n=iand(nstate(np),npoly1)
|
||||
n=ieor(n,ishft(n,-16))
|
||||
lsym=partab(iand(ieor(n,ishft(n,-8)),255))
|
||||
n=iand(nstate(np),npoly2)
|
||||
n=ieor(n,ishft(n,-16))
|
||||
lsym=lsym+lsym+partab(iand(ieor(n,ishft(n,-8)),255))
|
||||
m0=metrics(lsym,np)
|
||||
m1=metrics(ieor(3,lsym),np)
|
||||
if(m0.gt.m1) then
|
||||
tm(0,np)=m0 !0-branch has better metric
|
||||
tm(1,np)=m1
|
||||
else
|
||||
tm(0,np)=m1 !1-branch is better
|
||||
tm(1,np)=m0
|
||||
nstate(np)=nstate(np) + 1 !Set low bit
|
||||
endif
|
||||
|
||||
! Start with best branch
|
||||
ii(np)=0
|
||||
gamma(np)=0
|
||||
nt=0
|
||||
|
||||
! Start the Fano decoder
|
||||
do i=1,nbits*maxcycles
|
||||
! Look forward
|
||||
ngamma=gamma(np) + tm(ii(np),np)
|
||||
if(ngamma.ge.nt) then
|
||||
|
||||
! Node is acceptable. If first time visiting this node, tighten threshold:
|
||||
if(gamma(np).lt.(nt+ndelta)) nt=nt + ndelta * ((ngamma-nt)/ndelta)
|
||||
|
||||
! Move forward
|
||||
gamma(np+1)=ngamma
|
||||
nstate(np+1)=ishft(nstate(np),1)
|
||||
np=np+1
|
||||
! if(ngamma.gt.maxmetric) then
|
||||
if(np.gt.maxnp) then
|
||||
maxmetric=ngamma
|
||||
maxnp=np
|
||||
endif
|
||||
if(np.eq.nbits-1) go to 100 !We're done!
|
||||
|
||||
n=iand(nstate(np),npoly1)
|
||||
n=ieor(n,ishft(n,-16))
|
||||
lsym=partab(iand(ieor(n,ishft(n,-8)),255))
|
||||
n=iand(nstate(np),npoly2)
|
||||
n=ieor(n,ishft(n,-16))
|
||||
lsym=lsym+lsym+partab(iand(ieor(n,ishft(n,-8)),255))
|
||||
|
||||
if(np.ge.ntail) then
|
||||
tm(0,np)=metrics(lsym,np) !We're in the tail, all zeros
|
||||
else
|
||||
m0=metrics(lsym,np)
|
||||
m1=metrics(ieor(3,lsym),np)
|
||||
if(m0.gt.m1) then
|
||||
tm(0,np)=m0 !0-branch has better metric
|
||||
tm(1,np)=m1
|
||||
else
|
||||
tm(0,np)=m1 !1-branch is better
|
||||
tm(1,np)=m0
|
||||
nstate(np)=nstate(np) + 1 !Set low bit
|
||||
endif
|
||||
endif
|
||||
|
||||
ii(np)=0 !Start with best branch
|
||||
go to 99
|
||||
endif
|
||||
|
||||
! Threshold violated, can't go forward
|
||||
10 noback=.false.
|
||||
if(np.eq.0) noback=.true.
|
||||
if(np.gt.0) then
|
||||
if(gamma(np-1).lt.nt) noback=.true.
|
||||
endif
|
||||
|
||||
if(noback) then
|
||||
! Can't back up, either. Relax threshold and look forward again
|
||||
! to a better branch.
|
||||
nt=nt-ndelta
|
||||
if(ii(np).ne.0) then
|
||||
ii(np)=0
|
||||
nstate(np)=ieor(nstate(np),1)
|
||||
endif
|
||||
go to 99
|
||||
endif
|
||||
|
||||
! Back up
|
||||
np=np-1
|
||||
if(np.lt.ntail .and. ii(np).ne.1) then
|
||||
! Search the next best branch
|
||||
ii(np)=ii(np)+1
|
||||
nstate(np)=ieor(nstate(np),1)
|
||||
go to 99
|
||||
endif
|
||||
go to 10
|
||||
99 continue
|
||||
enddo
|
||||
i=nbits*maxcycles
|
||||
|
||||
100 metric=gamma(np) !Final path metric
|
||||
|
||||
! Copy decoded data to user's buffer
|
||||
nbytes=(nbits+7)/8
|
||||
np=7
|
||||
do j=1,nbytes-1
|
||||
i4a=nstate(np)
|
||||
dat(j)=i4a
|
||||
np=np+8
|
||||
enddo
|
||||
dat(nbytes)=0
|
||||
|
||||
ncycles=i+1
|
||||
ierr=0
|
||||
if(i.ge.maxcycles*nbits) ierr=-1
|
||||
|
||||
return
|
||||
end subroutine fano232
|
||||
+64
@@ -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)
|
||||
@@ -0,0 +1,64 @@
|
||||
12000 61 250 750 0.2 50, mix at 1500
|
||||
|
||||
|
||||
-0.000000000000 0.001944450121
|
||||
-0.000668730681 0.000668730681
|
||||
-0.000974850191 -0.000000000000
|
||||
-0.000581679123 -0.000581679123
|
||||
0.000000000000 -0.000439648787
|
||||
-0.000148911451 0.000148911451
|
||||
-0.001140891736 -0.000000000000
|
||||
-0.001653102965 -0.001653102965
|
||||
0.000000000000 -0.003749915818
|
||||
0.003740834397 -0.003740834397
|
||||
0.006834087490 0.000000000000
|
||||
0.005812808655 0.005812808655
|
||||
-0.000000000000 0.009262713933
|
||||
-0.006900370427 0.006900370427
|
||||
-0.009503248519 -0.000000000000
|
||||
-0.005874581677 -0.005874581677
|
||||
0.000000000000 -0.006017530719
|
||||
0.001785268072 -0.001785268072
|
||||
-0.002214736448 -0.000000000000
|
||||
-0.005777038427 -0.005777038427
|
||||
0.000000000000 -0.015228682747
|
||||
0.016402831440 -0.016402831440
|
||||
0.031806920774 0.000000000000
|
||||
0.028800401613 0.028800401613
|
||||
-0.000000000000 0.049589395998
|
||||
-0.041000303659 0.041000303659
|
||||
-0.065514139214 -0.000000000000
|
||||
-0.050781544715 -0.050781544715
|
||||
0.000000000000 -0.076562341482
|
||||
0.056225821996 -0.056225821996
|
||||
0.080516569816 0.000000000000
|
||||
0.056225821996 0.056225821996
|
||||
-0.000000000000 0.076562341482
|
||||
-0.050781544715 0.050781544715
|
||||
-0.065514139214 -0.000000000000
|
||||
-0.041000303659 -0.041000303659
|
||||
0.000000000000 -0.049589395998
|
||||
0.028800401613 -0.028800401613
|
||||
0.031806920774 0.000000000000
|
||||
0.016402831440 0.016402831440
|
||||
-0.000000000000 0.015228682747
|
||||
-0.005777038427 0.005777038427
|
||||
-0.002214736448 -0.000000000000
|
||||
0.001785268072 0.001785268072
|
||||
-0.000000000000 0.006017530719
|
||||
-0.005874581677 0.005874581677
|
||||
-0.009503248519 -0.000000000000
|
||||
-0.006900370427 -0.006900370427
|
||||
0.000000000000 -0.009262713933
|
||||
0.005812808655 -0.005812808655
|
||||
0.006834087490 0.000000000000
|
||||
0.003740834397 0.003740834397
|
||||
-0.000000000000 0.003749915818
|
||||
-0.001653102965 0.001653102965
|
||||
-0.001140891736 -0.000000000000
|
||||
-0.000148911451 -0.000148911451
|
||||
-0.000000000000 0.000439648787
|
||||
-0.000581679123 0.000581679123
|
||||
-0.000974850191 -0.000000000000
|
||||
-0.000668730681 -0.000668730681
|
||||
0.000000000000 -0.001944450121
|
||||
@@ -0,0 +1,90 @@
|
||||
subroutine four2a(a,nfft,ndim,isign,iform)
|
||||
|
||||
! IFORM = 1, 0 or -1, as data is
|
||||
! complex, real, or the first half of a complex array. Transform
|
||||
! values are returned in array DATA. They are complex, real, or
|
||||
! the first half of a complex array, as IFORM = 1, -1 or 0.
|
||||
|
||||
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
|
||||
! by ... will be returned in the same array, now considered to
|
||||
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
|
||||
! IFORM = 0 or -1, N(1) must be even, and enough room must be
|
||||
! reserved. The missing values may be obtained by complex conjugation.
|
||||
|
||||
! The reverse transformation of a half complex array dimensioned
|
||||
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
|
||||
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
|
||||
! The transform will be real and returned to the input array.
|
||||
|
||||
parameter (NPMAX=100)
|
||||
parameter (NSMALL=16384)
|
||||
complex a(nfft)
|
||||
complex aa(NSMALL)
|
||||
integer nn(NPMAX),ns(NPMAX),nf(NPMAX),nl(NPMAX)
|
||||
integer*8 plan(NPMAX) !Actually should be i*8, but no matter
|
||||
! data nplan/0/,npatience/1/
|
||||
data nplan/0/,npatience/0/
|
||||
include 'fftw3.f'
|
||||
save plan,nplan,nn,ns,nf,nl
|
||||
|
||||
if(nfft.lt.0) go to 999
|
||||
|
||||
nloc=loc(a)
|
||||
do i=1,nplan
|
||||
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
|
||||
iform.eq.nf(i) .and. nloc.eq.nl(i)) go to 10
|
||||
enddo
|
||||
if(nplan.ge.NPMAX) stop 'Too many FFTW plans requested.'
|
||||
nplan=nplan+1
|
||||
i=nplan
|
||||
nn(i)=nfft
|
||||
ns(i)=isign
|
||||
nf(i)=iform
|
||||
nl(i)=nloc
|
||||
|
||||
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
|
||||
! FFTW_PATIENT, FFTW_EXHAUSTIVE
|
||||
nflags=FFTW_ESTIMATE
|
||||
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
|
||||
if(npatience.eq.2) nflags=FFTW_MEASURE
|
||||
if(npatience.eq.3) nflags=FFTW_PATIENT
|
||||
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
|
||||
|
||||
if(nfft.le.NSMALL) then
|
||||
jz=nfft
|
||||
if(iform.eq.0) jz=nfft/2
|
||||
do j=1,jz
|
||||
aa(j)=a(j)
|
||||
enddo
|
||||
endif
|
||||
if(isign.eq.-1 .and. iform.eq.1) then
|
||||
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
|
||||
else if(isign.eq.1 .and. iform.eq.1) then
|
||||
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
|
||||
else if(isign.eq.-1 .and. iform.eq.0) then
|
||||
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
|
||||
else if(isign.eq.1 .and. iform.eq.-1) then
|
||||
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
|
||||
else
|
||||
stop 'Unsupported request in four2a'
|
||||
endif
|
||||
i=nplan
|
||||
if(nfft.le.NSMALL) then
|
||||
jz=nfft
|
||||
if(iform.eq.0) jz=nfft/2
|
||||
do j=1,jz
|
||||
a(j)=aa(j)
|
||||
enddo
|
||||
endif
|
||||
|
||||
10 continue
|
||||
call sfftw_execute(plan(i))
|
||||
return
|
||||
|
||||
999 do i=1,nplan
|
||||
! The test is only to silence a compiler warning:
|
||||
if(ndim.ne.-999) call sfftw_destroy_plan(plan(i))
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine four2a
|
||||
@@ -0,0 +1,63 @@
|
||||
! Fortran logical units used in WSJT6
|
||||
!
|
||||
! 10 binary input data, *.tf2 files
|
||||
! 11 prefixes.txt
|
||||
! 12 timer.out
|
||||
! 13 map65.log
|
||||
! 14
|
||||
! 15
|
||||
! 16
|
||||
! 17 saved *.tf2 files
|
||||
! 18 test file to be transmitted (wsjtgen.f90)
|
||||
! 19 livecq.txt
|
||||
! 20
|
||||
! 21 map65_rx.log
|
||||
! 22 kvasd.dat
|
||||
! 23 CALL3.TXT
|
||||
! 24
|
||||
! 25
|
||||
! 26 tmp26.txt
|
||||
! 27
|
||||
! 28 fftw_wisdom.dat
|
||||
!------------------------------------------------ ftn_init
|
||||
subroutine ftninit(appd)
|
||||
|
||||
character*(*) appd
|
||||
character cjunk*1,firstline*30
|
||||
character addpfx*8
|
||||
integer junk(256)
|
||||
common/pfxcom/addpfx
|
||||
|
||||
addpfx=' '
|
||||
call pfxdump(appd//'/prefixes.txt')
|
||||
open(12,file=appd//'/timer.out',status='unknown',err=920)
|
||||
open(13,file=appd//'/map65.log',status='unknown')
|
||||
open(19,file=appd//'/livecq.txt',status='unknown')
|
||||
open(21,file=appd//'/map65_rx.log',status='unknown',access='append',err=950)
|
||||
open(22,file=appd//'/kvasd.dat',access='direct',recl=1024,status='unknown')
|
||||
read(22,rec=2,err=12) junk
|
||||
go to 18
|
||||
12 junk=0
|
||||
write(22,rec=1) junk
|
||||
write(22,rec=2) junk
|
||||
|
||||
18 open(26,file=appd//'/tmp26.txt',status='unknown')
|
||||
|
||||
! Import FFTW wisdom, if available:
|
||||
open(28,file=appd//'/fftwf_wisdom.dat',status='old',err=30)
|
||||
read(28,1000,err=30,end=30) firstline
|
||||
1000 format(a30)
|
||||
rewind 28
|
||||
call import_wisdom_from_file(isuccess,28)
|
||||
close(28)
|
||||
if(isuccess.ne.0) write(13,1010) firstline
|
||||
1010 format('Imported FFTW wisdom: ',a30)
|
||||
|
||||
30 return
|
||||
|
||||
920 write(0,*) '!Error opening timer.out'
|
||||
stop
|
||||
950 write(0,*) '!Error opening ALL65.TXT'
|
||||
stop
|
||||
|
||||
end subroutine ftninit
|
||||
@@ -0,0 +1,9 @@
|
||||
subroutine ftnquit
|
||||
|
||||
! Destroy the FFTW plans
|
||||
call four2a(a,-1,1,1,1)
|
||||
call filbig(id,-1,f0,newdat,nfsample,c4a,c4b,n4)
|
||||
stop
|
||||
|
||||
return
|
||||
end subroutine ftnquit
|
||||
@@ -0,0 +1,96 @@
|
||||
subroutine genjt8(message,iwave,nwave,nbit,msgsent)
|
||||
|
||||
! Generate a JT8 wavefile.
|
||||
|
||||
parameter (NMAX=60*12000) !Max length of wave file
|
||||
character*24 message !Message to be generated
|
||||
character*24 msgsent !Message as it will be received
|
||||
character cmode*5
|
||||
real*8 t,dt,phi,f,f0,dfgen,dphi,twopi,tsymbol
|
||||
integer*2 iwave(NMAX) !Generated wave file
|
||||
integer iu(3)
|
||||
integer gsym(372) !372 is needed for JT8 mode
|
||||
integer sent(144)
|
||||
integer ic8(8)
|
||||
data ic8/3,6,2,4,5,0,7,1/
|
||||
data nsps/4096/
|
||||
data twopi/6.283185307d0/
|
||||
save
|
||||
|
||||
cmode='JT8' !### temp ? ###
|
||||
call srcenc(cmode,message,nbit,iu)
|
||||
! In JT8 mode, message length is always nbit=78
|
||||
if(nbit.ne.78) then
|
||||
print*,'genjt8, nbit=',nbit
|
||||
stop
|
||||
endif
|
||||
|
||||
! Apply FEC and do the channel encoding
|
||||
call chenc(cmode,nbit,iu,gsym)
|
||||
|
||||
! Remove source encoding, recover the human-readable message.
|
||||
call srcdec(cmode,nbit,iu,msgsent)
|
||||
|
||||
! Insert 8x8 Costas array at beginning and end of array sent().
|
||||
sent(1:8)=ic8
|
||||
sent(135:142)=ic8
|
||||
! Insert two symbols after each Costas array to specify message length.
|
||||
if(nbit.eq.30) then
|
||||
sent(9)=2
|
||||
sent(10)=2
|
||||
sent(143)=2
|
||||
sent(144)=2
|
||||
else if(nbit.eq.48) then
|
||||
sent(9)=3
|
||||
sent(10)=3
|
||||
sent(143)=3
|
||||
sent(144)=3
|
||||
else
|
||||
sent(9)=6
|
||||
sent(10)=6
|
||||
sent(143)=6
|
||||
sent(144)=6
|
||||
endif
|
||||
|
||||
! Insert the 3-bit data symbols
|
||||
sent(11:134)=gsym(1:124)
|
||||
|
||||
! Use the four free symbols in 30-bit mode
|
||||
if(nbit.eq.30) then
|
||||
sent(121)=sent(20)
|
||||
sent(122)=sent(45)
|
||||
sent(123)=sent(70)
|
||||
sent(124)=sent(95)
|
||||
endif
|
||||
|
||||
! Set up necessary constants
|
||||
nsym=144
|
||||
tsymbol=nsps/12000.d0
|
||||
dt=1.d0/12000.d0
|
||||
f0=1270.46d0
|
||||
dfgen=12000.d0/nsps
|
||||
t=0.d0
|
||||
phi=0.d0
|
||||
k=0
|
||||
j0=0
|
||||
ndata=(nsym*12000.d0*tsymbol)/2
|
||||
ndata=2*ndata
|
||||
do i=1,ndata
|
||||
t=t+dt
|
||||
j=int(t/tsymbol) + 1 !Symbol number, 1-nsym
|
||||
if(j.ne.j0) then
|
||||
f=f0
|
||||
k=k+1
|
||||
if(k.le.144) f=f0+(sent(k))*dfgen !### Fix need for this ###
|
||||
dphi=twopi*dt*f
|
||||
j0=j
|
||||
endif
|
||||
phi=phi+dphi
|
||||
iwave(i)=32767.0*sin(phi)
|
||||
enddo
|
||||
|
||||
iwave(ndata+1:)=0
|
||||
nwave=ndata+6000 !0.5 s buffer before CW ID
|
||||
|
||||
return
|
||||
end subroutine genjt8
|
||||
@@ -0,0 +1,51 @@
|
||||
subroutine genjt9(message,minutes,msgsent,d6)
|
||||
|
||||
! Encodes a JT9 message and returns msgsent, the message as it will
|
||||
! be decoded, and an integer array d6(85) of 9-FSK tone values
|
||||
! in the range 0-8.
|
||||
|
||||
character*22 message !Message to be generated
|
||||
character*22 msgsent !Message as it will be received
|
||||
|
||||
integer*4 d0(13) !72-bit message as 6-bit words
|
||||
integer*1 d1(13) !72 bits and zero tail as 8-bit bytes
|
||||
integer*1 d2(207) !Encoded information-carrying bits
|
||||
integer*1 d3(207) !Bits from d2, after interleaving
|
||||
integer*4 d4(69) !Symbols from d3, values 0-7
|
||||
integer*4 d5(69) !Gray-coded symbols, values 0-7
|
||||
integer*4 d6(85) !Channel symbols including sync, values 0-8
|
||||
|
||||
integer isync(85) !Sync vector
|
||||
data isync/ &
|
||||
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,1,0,0,0,0, &
|
||||
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0, &
|
||||
0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0, &
|
||||
0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0, &
|
||||
1,0,0,0,1/
|
||||
save
|
||||
|
||||
call packmsg(message,d0) !Pack message into 12 6-bit bytes
|
||||
call unpackmsg(d0,msgsent) !Unpack d0 to get msgsent
|
||||
call entail(d0,d1) !Add tail, convert to 8-bit bytes
|
||||
nsym2=206
|
||||
call encode232(d1,nsym2,d2) !Convolutional code, K=32, r=1/2
|
||||
call interleave9(d2,1,d3) !Interleave the single bits
|
||||
call packbits(d3,nsym2,3,d4) !Pack 3-bit groups into words
|
||||
|
||||
! d5=d4
|
||||
! print*,d5
|
||||
call graycode(d4,69,1,d5) !Apply Gray code
|
||||
|
||||
! Insert sync symbols (ntone=0) and add 1 to the data-tone numbers.
|
||||
j=0
|
||||
do i=1,85
|
||||
if(isync(i).eq.1) then
|
||||
d6(i)=0
|
||||
else
|
||||
j=j+1
|
||||
d6(i)=d5(j)+1
|
||||
endif
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine genjt9
|
||||
@@ -0,0 +1,70 @@
|
||||
subroutine genjtms3a(chansym,nsym,iwave,nwave)
|
||||
|
||||
integer*1 chansym(nsym)
|
||||
integer*2 iwave(30*48000)
|
||||
real x(0:6191),x2(0:6191)
|
||||
complex c(0:3096),c2(0:6191) !Could be 0:3096 ???
|
||||
equivalence (x,c),(x2,c2)
|
||||
|
||||
do j=1,nsym !Define the baseband signal
|
||||
i0=24*(j-1) !24 samples per symbol
|
||||
x(i0:i0+23)=2*chansym(j)-1
|
||||
enddo
|
||||
|
||||
nfft=24*nsym
|
||||
fac=1.0/nfft
|
||||
x(0:nfft-1)=fac*x(0:nfft-1)
|
||||
call four2a(x,nfft,1,-1,0) !Forward r2c FFT
|
||||
|
||||
! Apply lowpass filter
|
||||
fc=1200.0
|
||||
bw=200.0
|
||||
df=48000.0/nfft
|
||||
nh=nfft/2
|
||||
c2=0.
|
||||
ib=2000.0/df
|
||||
|
||||
do i=0,ib
|
||||
f=i*df
|
||||
g=1.0
|
||||
if(f.gt.fc) then
|
||||
xx=(f-fc)/bw
|
||||
g=exp(-xx*xx)
|
||||
endif
|
||||
c2(i)=g*c(i)
|
||||
enddo
|
||||
|
||||
call four2a(c2,nfft,1,1,-1) !Inverse c2r FFT
|
||||
|
||||
nf0=nint(1500.0/df)
|
||||
f0=nf0*df
|
||||
twopi=8.0*atan(1.0)
|
||||
dphi=twopi*f0/48000.0
|
||||
phi=0.
|
||||
peak=0.
|
||||
sq=0.
|
||||
do i=0,nfft-1
|
||||
phi=phi+dphi
|
||||
if(phi.gt.twopi) phi=phi-twopi
|
||||
y=cos(phi)
|
||||
x2(i)=y*x2(i)
|
||||
sq=sq + x2(i)**2
|
||||
if(abs(x2(i)).gt.peak) peak=abs(x2(i))
|
||||
enddo
|
||||
rms=sqrt(sq/nfft)
|
||||
! print*,rms,peak,peak/rms
|
||||
|
||||
fac=32767.0/peak
|
||||
do i=0,nfft-1
|
||||
iwave(i+1)=fac*x2(i)
|
||||
enddo
|
||||
nwave=30*48000
|
||||
nrpt=nwave/nfft
|
||||
do n=2,nrpt
|
||||
ib=n*nfft
|
||||
ia=ib-nfft+1
|
||||
iwave(ia:ib)=iwave(1:nfft)
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine genjtms3a
|
||||
+104
@@ -0,0 +1,104 @@
|
||||
!subroutine genms(msg28,samfac,iwave,cwave,isrch,nwave)
|
||||
subroutine genmsk(msg28,iwave,nwave)
|
||||
|
||||
! Generate a JTMS wavefile.
|
||||
|
||||
parameter (NMAX=30*48000) !Max length of wave file
|
||||
integer*2 iwave(NMAX) !Generated wave file
|
||||
complex cwave(NMAX) !Alternative for searchms
|
||||
character*28 msg28 !User message
|
||||
character*29 msg
|
||||
character cc*64
|
||||
integer sent(203)
|
||||
real*8 dt,phi,f,f0,dfgen,dphi,twopi,foffset,samfac
|
||||
integer np(9)
|
||||
data np/5,7,9,11,13,17,19,23,29/ !Permissible message lengths
|
||||
! 1 2 3 4 5 6
|
||||
! 0123456789012345678901234567890123456789012345678901234567890123
|
||||
data cc/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ./?- _ @'/
|
||||
|
||||
!###
|
||||
samfac=1.d0
|
||||
isrch=0
|
||||
!###
|
||||
|
||||
msg=msg28//' ' !Extend to 29 characters
|
||||
do i=28,1,-1 !Find user's message length
|
||||
if(msg(i:i).ne.' ') go to 1
|
||||
enddo
|
||||
1 iz=i+1 !Add one for space at EOM
|
||||
msglen=iz
|
||||
if(isrch.ne.0) go to 3
|
||||
do i=1,9
|
||||
if(np(i).ge.iz) go to 2
|
||||
enddo
|
||||
i=8
|
||||
2 msglen=np(i)
|
||||
|
||||
! Convert message to a bit sequence, 7 bits per character (6 + odd parity)
|
||||
! Use odd parity because then code 44 (from a 0-63 range) is the 7-bit
|
||||
! Barker code.
|
||||
3 sent=0
|
||||
k=0
|
||||
do j=1,msglen
|
||||
if(msg(j:j).eq.' ') then
|
||||
i=1 + 44
|
||||
go to 5
|
||||
else
|
||||
do i=1,64
|
||||
if(msg(j:j).eq.cc(i:i)) go to 5
|
||||
enddo
|
||||
endif
|
||||
5 m=0
|
||||
do n=5,0,-1 !Each character gets 6 bits
|
||||
k=k+1
|
||||
sent(k)=iand(1,ishft(i-1,-n))
|
||||
m=m+sent(k)
|
||||
enddo
|
||||
k=k+1
|
||||
sent(k) = 1 - iand(m,1) !Insert odd parity bit
|
||||
enddo
|
||||
nsym=k
|
||||
|
||||
! Set up necessary constants
|
||||
twopi=8.d0*atan(1.d0)
|
||||
nsps=24
|
||||
dt=1.d0/(samfac*48000.d0)
|
||||
f0=48000.d0/nsps
|
||||
dfgen=0.5d0*f0
|
||||
foffset=1500.d0 - f0
|
||||
t=0.d0
|
||||
k=0
|
||||
phi=0.d0
|
||||
nrpt=NMAX/(nsym*nsps)
|
||||
if(isrch.ne.0) nrpt=1
|
||||
|
||||
do irpt=1,nrpt
|
||||
do j=1,nsym
|
||||
if(sent(j).eq.1) then
|
||||
f=f0 + 0.5d0*dfgen + foffset
|
||||
else
|
||||
f=f0 - 0.5d0*dfgen + foffset
|
||||
endif
|
||||
dphi=twopi*f*dt
|
||||
do i=1,nsps
|
||||
k=k+1
|
||||
phi=phi+dphi
|
||||
if(isrch.eq.0) then
|
||||
iwave(k)=nint(32767.0*sin(phi))
|
||||
else
|
||||
cwave(k)=cmplx(cos(phi),sin(phi))
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if(isrch.eq.0) iwave(k+1:)=0
|
||||
nwave=k
|
||||
|
||||
! call makepings(iwave,nwave)
|
||||
! write(71) iwave
|
||||
! call flush(71)
|
||||
|
||||
return
|
||||
end subroutine genmsk
|
||||
@@ -0,0 +1,96 @@
|
||||
subroutine getpfx1(callsign,k,nv2)
|
||||
|
||||
character*12 callsign0,callsign,lof,rof
|
||||
character*8 c
|
||||
character addpfx*8,tpfx*4,tsfx*3
|
||||
logical ispfx,issfx,invalid
|
||||
common/pfxcom/addpfx
|
||||
include 'pfx.f'
|
||||
|
||||
callsign0=callsign
|
||||
nv2=0
|
||||
iz=index(callsign,' ') - 1
|
||||
if(iz.lt.0) iz=12
|
||||
islash=index(callsign(1:iz),'/')
|
||||
k=0
|
||||
c=' '
|
||||
if(islash.gt.0 .and. islash.le.(iz-4)) then
|
||||
! Add-on prefix
|
||||
c=callsign(1:islash-1)
|
||||
callsign=callsign(islash+1:iz)
|
||||
do i=1,NZ
|
||||
if(pfx(i)(1:4).eq.c) then
|
||||
k=i
|
||||
go to 10
|
||||
endif
|
||||
enddo
|
||||
if(addpfx.eq.c) then
|
||||
k=449
|
||||
go to 10
|
||||
endif
|
||||
|
||||
else if(islash.eq.(iz-1)) then
|
||||
! Add-on suffix
|
||||
c=callsign(islash+1:iz)
|
||||
callsign=callsign(1:islash-1)
|
||||
do i=1,NZ2
|
||||
if(sfx(i).eq.c(1:1)) then
|
||||
k=400+i
|
||||
go to 10
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
10 if(islash.ne.0 .and.k.eq.0) then
|
||||
! Original JT65 would force this compound callsign to be treated as
|
||||
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
|
||||
! The task here is to compute the proper value of k.
|
||||
lof=callsign0(:islash-1)
|
||||
rof=callsign0(islash+1:)
|
||||
llof=len_trim(lof)
|
||||
lrof=len_trim(rof)
|
||||
ispfx=(llof.gt.0 .and. llof.le.4)
|
||||
issfx=(lrof.gt.0 .and. lrof.le.3)
|
||||
invalid=.not.(ispfx.or.issfx)
|
||||
if(ispfx.and.issfx) then
|
||||
if(llof.lt.3) issfx=.false.
|
||||
if(lrof.lt.3) ispfx=.false.
|
||||
if(ispfx.and.issfx) then
|
||||
i=ichar(callsign0(islash-1:islash-1))
|
||||
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
|
||||
issfx=.false.
|
||||
else
|
||||
ispfx=.false.
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
if(invalid) then
|
||||
k=-1
|
||||
else
|
||||
if(ispfx) then
|
||||
tpfx=lof
|
||||
k=nchar(tpfx(1:1))
|
||||
k=37*k + nchar(tpfx(2:2))
|
||||
k=37*k + nchar(tpfx(3:3))
|
||||
k=37*k + nchar(tpfx(4:4))
|
||||
nv2=1
|
||||
i=index(callsign0,'/')
|
||||
callsign=callsign0(:i-1)
|
||||
callsign=callsign0(i+1:)
|
||||
endif
|
||||
if(issfx) then
|
||||
tsfx=rof
|
||||
k=nchar(tsfx(1:1))
|
||||
k=37*k + nchar(tsfx(2:2))
|
||||
k=37*k + nchar(tsfx(3:3))
|
||||
nv2=2
|
||||
i=index(callsign0,'/')
|
||||
callsign=callsign0(:i-1)
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
@@ -0,0 +1,24 @@
|
||||
subroutine getpfx2(k0,callsign)
|
||||
|
||||
character callsign*12
|
||||
include 'pfx.f'
|
||||
character addpfx*8
|
||||
common/pfxcom/addpfx
|
||||
|
||||
k=k0
|
||||
if(k.gt.450) k=k-450
|
||||
if(k.ge.1 .and. k.le.NZ) then
|
||||
iz=index(pfx(k),' ') - 1
|
||||
callsign=pfx(k)(1:iz)//'/'//callsign
|
||||
else if(k.ge.401 .and. k.le.400+NZ2) then
|
||||
iz=index(callsign,' ') - 1
|
||||
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
||||
else if(k.eq.449) then
|
||||
iz=index(addpfx,' ') - 1
|
||||
if(iz.lt.1) iz=8
|
||||
callsign=addpfx(1:iz)//'/'//callsign
|
||||
endif
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
+28
@@ -0,0 +1,28 @@
|
||||
#include <stdlib.h>
|
||||
#include <math.h>
|
||||
|
||||
/* Generate gaussian random float with mean=0 and std_dev=1 */
|
||||
float gran_()
|
||||
{
|
||||
float fac,rsq,v1,v2;
|
||||
static float gset;
|
||||
static int iset;
|
||||
|
||||
if(iset){
|
||||
/* Already got one */
|
||||
iset = 0;
|
||||
return gset;
|
||||
}
|
||||
/* Generate two evenly distributed numbers between -1 and +1
|
||||
* that are inside the unit circle
|
||||
*/
|
||||
do {
|
||||
v1 = 2.0 * (float)rand() / RAND_MAX - 1;
|
||||
v2 = 2.0 * (float)rand() / RAND_MAX - 1;
|
||||
rsq = v1*v1 + v2*v2;
|
||||
} while(rsq >= 1.0 || rsq == 0.0);
|
||||
fac = sqrt(-2.0*log(rsq)/rsq);
|
||||
gset = v1*fac;
|
||||
iset++;
|
||||
return v2*fac;
|
||||
}
|
||||
@@ -0,0 +1,9 @@
|
||||
subroutine graycode(ia,n,idir,ib)
|
||||
|
||||
integer ia(n),ib(n)
|
||||
do i=1,n
|
||||
ib(i)=igray(ia(i),idir)
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine graycode
|
||||
@@ -0,0 +1,38 @@
|
||||
subroutine grid2deg(grid0,dlong,dlat)
|
||||
|
||||
C Converts Maidenhead grid locator to degrees of West longitude
|
||||
C and North latitude.
|
||||
|
||||
character*6 grid0,grid
|
||||
character*1 g1,g2,g3,g4,g5,g6
|
||||
|
||||
grid=grid0
|
||||
i=ichar(grid(5:5))
|
||||
if(grid(5:5).eq.' ' .or. i.le.64 .or. i.ge.128) grid(5:6)='mm'
|
||||
|
||||
if(grid(1:1).ge.'a' .and. grid(1:1).le.'z') grid(1:1)=
|
||||
+ char(ichar(grid(1:1))+ichar('A')-ichar('a'))
|
||||
if(grid(2:2).ge.'a' .and. grid(2:2).le.'z') grid(2:2)=
|
||||
+ char(ichar(grid(2:2))+ichar('A')-ichar('a'))
|
||||
if(grid(5:5).ge.'A' .and. grid(5:5).le.'Z') grid(5:5)=
|
||||
+ char(ichar(grid(5:5))-ichar('A')+ichar('a'))
|
||||
if(grid(6:6).ge.'A' .and. grid(6:6).le.'Z') grid(6:6)=
|
||||
+ char(ichar(grid(6:6))-ichar('A')+ichar('a'))
|
||||
|
||||
g1=grid(1:1)
|
||||
g2=grid(2:2)
|
||||
g3=grid(3:3)
|
||||
g4=grid(4:4)
|
||||
g5=grid(5:5)
|
||||
g6=grid(6:6)
|
||||
|
||||
nlong = 180 - 20*(ichar(g1)-ichar('A'))
|
||||
n20d = 2*(ichar(g3)-ichar('0'))
|
||||
xminlong = 5*(ichar(g5)-ichar('a')+0.5)
|
||||
dlong = nlong - n20d - xminlong/60.0
|
||||
nlat = -90+10*(ichar(g2)-ichar('A')) + ichar(g4)-ichar('0')
|
||||
xminlat = 2.5*(ichar(g6)-ichar('a')+0.5)
|
||||
dlat = nlat + xminlat/60.0
|
||||
|
||||
return
|
||||
end
|
||||
@@ -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
@@ -0,0 +1,18 @@
|
||||
int igray_(int *n0, int *idir)
|
||||
{
|
||||
int n;
|
||||
unsigned long sh;
|
||||
unsigned long nn;
|
||||
n=*n0;
|
||||
|
||||
if(*idir>0) return (n ^ (n >> 1));
|
||||
|
||||
sh = 1;
|
||||
nn = (n >> sh);
|
||||
while (nn > 0) {
|
||||
n ^= nn;
|
||||
sh <<= 1;
|
||||
nn = (n >> sh);
|
||||
}
|
||||
return (n);
|
||||
}
|
||||
@@ -0,0 +1,19 @@
|
||||
subroutine indexx(n,arr,indx)
|
||||
|
||||
parameter (NMAX=3000)
|
||||
integer indx(n)
|
||||
real arr(n)
|
||||
real brr(NMAX)
|
||||
if(n.gt.NMAX) then
|
||||
print*,'n=',n,' too big in indexx.'
|
||||
stop
|
||||
endif
|
||||
do i=1,n
|
||||
brr(i)=arr(i)
|
||||
indx(i)=i
|
||||
enddo
|
||||
call ssort(brr,indx,n,2)
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
+126
@@ -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;
|
||||
}
|
||||
@@ -0,0 +1,57 @@
|
||||
/* Include file to configure the RS codec for integer symbols
|
||||
*
|
||||
* Copyright 2002, Phil Karn, KA9Q
|
||||
* May be used under the terms of the GNU General Public License (GPL)
|
||||
*/
|
||||
#define DTYPE int
|
||||
|
||||
/* Reed-Solomon codec control block */
|
||||
struct rs {
|
||||
int mm; /* Bits per symbol */
|
||||
int nn; /* Symbols per block (= (1<<mm)-1) */
|
||||
DTYPE *alpha_to; /* log lookup table */
|
||||
DTYPE *index_of; /* Antilog lookup table */
|
||||
DTYPE *genpoly; /* Generator polynomial */
|
||||
int nroots; /* Number of generator roots = number of parity symbols */
|
||||
int fcr; /* First consecutive root, index form */
|
||||
int prim; /* Primitive element, index form */
|
||||
int iprim; /* prim-th root of 1, index form */
|
||||
int pad; /* Padding bytes in shortened block */
|
||||
};
|
||||
|
||||
static int modnn(struct rs *rs,int x){
|
||||
while (x >= rs->nn) {
|
||||
x -= rs->nn;
|
||||
x = (x >> rs->mm) + (x & rs->nn);
|
||||
}
|
||||
return x;
|
||||
}
|
||||
#define MODNN(x) modnn(rs,x)
|
||||
|
||||
#define MM (rs->mm)
|
||||
#define NN (rs->nn)
|
||||
#define ALPHA_TO (rs->alpha_to)
|
||||
#define INDEX_OF (rs->index_of)
|
||||
#define GENPOLY (rs->genpoly)
|
||||
//#define NROOTS (rs->nroots)
|
||||
#define NROOTS (51)
|
||||
#define FCR (rs->fcr)
|
||||
#define PRIM (rs->prim)
|
||||
#define IPRIM (rs->iprim)
|
||||
#define PAD (rs->pad)
|
||||
#define A0 (NN)
|
||||
|
||||
#define ENCODE_RS encode_rs_int
|
||||
#define DECODE_RS decode_rs_int
|
||||
#define INIT_RS init_rs_int
|
||||
#define FREE_RS free_rs_int
|
||||
|
||||
void ENCODE_RS(void *p,DTYPE *data,DTYPE *parity);
|
||||
int DECODE_RS(void *p,DTYPE *data,int *eras_pos,int no_eras);
|
||||
void *INIT_RS(int symsize,int gfpoly,int fcr,
|
||||
int prim,int nroots,int pad);
|
||||
void FREE_RS(void *p);
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,17 @@
|
||||
subroutine interleave8(idat,jdat)
|
||||
|
||||
integer idat(66),jdat(66)
|
||||
integer ii(66),jj(66)
|
||||
data ii/ &
|
||||
64,32,16,48, 8,40,24,56, 4,36,20,52,12,44,28,60, 2,66,34,18, &
|
||||
50,10,42,26,58, 6,38,22,54,14,46,30,62, 1,65,33,17,49, 9,41, &
|
||||
25,57, 5,37,21,53,13,45,29,61, 3,35,19,51,11,43,27,59, 7,39, &
|
||||
23,55,15,47,31,63/
|
||||
data jj/ &
|
||||
34,17,51, 9,43,26,59, 5,39,22,55,13,47,30,63, 3,37,20,53,11, &
|
||||
45,28,61, 7,41,24,57,15,49,32,65, 2,36,19,52,10,44,27,60, 6, &
|
||||
40,23,56,14,48,31,64, 4,38,21,54,12,46,29,62, 8,42,25,58,16, &
|
||||
50,33,66, 1,35,18/
|
||||
|
||||
return
|
||||
end subroutine interleave8
|
||||
@@ -0,0 +1,39 @@
|
||||
subroutine interleave9(ia,ndir,ib)
|
||||
integer*1 ia(0:205),ib(0:205)
|
||||
integer j0(0:205)
|
||||
logical first
|
||||
data first/.true./
|
||||
save first,j0 !Save not working, or j0 overwritten ???
|
||||
|
||||
if(first) then
|
||||
k=-1
|
||||
do i=0,255
|
||||
m=i
|
||||
n=iand(m,1)
|
||||
n=2*n + iand(m/2,1)
|
||||
n=2*n + iand(m/4,1)
|
||||
n=2*n + iand(m/8,1)
|
||||
n=2*n + iand(m/16,1)
|
||||
n=2*n + iand(m/32,1)
|
||||
n=2*n + iand(m/64,1)
|
||||
n=2*n + iand(m/128,1)
|
||||
if(n.le.205) then
|
||||
k=k+1
|
||||
j0(k)=n
|
||||
endif
|
||||
enddo
|
||||
! first=.false.
|
||||
endif
|
||||
|
||||
if(ndir.gt.0) then
|
||||
do i=0,205
|
||||
ib(j0(i))=ia(i)
|
||||
enddo
|
||||
else
|
||||
do i=0,205
|
||||
ib(i)=ia(j0(i))
|
||||
enddo
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine interleave9
|
||||
@@ -0,0 +1,34 @@
|
||||
#include <QDebug>
|
||||
#include <qsharedmemory.h>
|
||||
#include <QSystemSemaphore>
|
||||
|
||||
QSharedMemory mem_m65("mem_m65");
|
||||
QSystemSemaphore sem_m65("sem_m65", 1, QSystemSemaphore::Open);
|
||||
|
||||
extern "C" {
|
||||
bool attach_m65_();
|
||||
bool create_m65_(int nsize);
|
||||
bool detach_m65_();
|
||||
bool lock_m65_();
|
||||
bool unlock_m65_();
|
||||
char* address_m65_();
|
||||
int size_m65_();
|
||||
|
||||
bool acquire_m65_();
|
||||
bool release_m65_();
|
||||
|
||||
extern struct {
|
||||
char c[10];
|
||||
} m65com_;
|
||||
}
|
||||
|
||||
bool attach_m65_() {return mem_m65.attach();}
|
||||
bool create_m65_(int nsize) {return mem_m65.create(nsize);}
|
||||
bool detach_m65_() {return mem_m65.detach();}
|
||||
bool lock_m65_() {return mem_m65.lock();}
|
||||
bool unlock_m65_() {return mem_m65.unlock();}
|
||||
char* address_m65_() {return (char*)mem_m65.constData();}
|
||||
int size_m65_() {return (int)mem_m65.size();}
|
||||
|
||||
bool acquire_m65_() {return sem_m65.acquire();}
|
||||
bool release_m65_() {return sem_m65.release();}
|
||||
+129
@@ -0,0 +1,129 @@
|
||||
program jt9
|
||||
|
||||
! Decoder for JT9. Can run stand-alone, reading data from *.wav files;
|
||||
! or as the back end of wsjt-x, with data placed in a shared memory region.
|
||||
|
||||
! NB: For unknown reason, ***MUST*** be compiled by g95 with -O0 !!!
|
||||
|
||||
character*80 arg,infile
|
||||
parameter (NMAX=1800*12000) !Total sample intervals per 30 minutes
|
||||
parameter (NDMAX=1800*1500) !Sample intervals at 1500 Hz rate
|
||||
parameter (NSMAX=22000) !Max length of saved spectra
|
||||
integer*4 ihdr(11)
|
||||
real*4 s(NSMAX)
|
||||
logical*1 lstrong(0:1023)
|
||||
integer*1 i1SoftSymbols(207)
|
||||
character*22 msg
|
||||
integer*2 id2
|
||||
complex c0
|
||||
common/jt8com/id2(NMAX),ss(184,NSMAX),savg(NSMAX),c0(NDMAX), &
|
||||
nutc,npts8,junk(20)
|
||||
common/tracer/limtrace,lu
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.lt.1) then
|
||||
print*,'Usage: jt9 TRperiod file1 [file2 ...]'
|
||||
print*,' Reads data from *.wav files.'
|
||||
print*,''
|
||||
print*,' jt9 -s'
|
||||
print*,' Gets data from shared memory region.'
|
||||
go to 999
|
||||
endif
|
||||
call getarg(1,arg)
|
||||
if(arg(1:2).eq.'-s') then
|
||||
! call jt9a
|
||||
! call ftnquit
|
||||
go to 999
|
||||
endif
|
||||
read(arg,*) ntrperiod
|
||||
|
||||
ifile1=2
|
||||
limtrace=0
|
||||
lu=12
|
||||
call timer('jt9 ',0) !###
|
||||
|
||||
nfa=1000
|
||||
nfb=2000
|
||||
ntol=500
|
||||
mousedf=0
|
||||
mousefqso=1500
|
||||
newdat=1
|
||||
nb=0
|
||||
nbslider=100
|
||||
|
||||
! call ftninit('.')
|
||||
|
||||
do ifile=ifile1,nargs
|
||||
call getarg(ifile,infile)
|
||||
open(10,file=infile,access='stream',status='old',err=998)
|
||||
read(10) ihdr
|
||||
i1=index(infile,'.wav')
|
||||
read(infile(i1-4:i1-1),*,err=1) nutc0
|
||||
go to 2
|
||||
1 nutc0=0
|
||||
2 nsps=0
|
||||
if(ntrperiod.eq.1) nsps=6912
|
||||
if(ntrperiod.eq.2) nsps=15360
|
||||
if(ntrperiod.eq.5) nsps=40960
|
||||
if(ntrperiod.eq.10) nsps=82944
|
||||
if(ntrperiod.eq.30) nsps=252000
|
||||
if(nsps.eq.0) stop 'Error: bad TRprtiod'
|
||||
|
||||
kstep=nsps/2
|
||||
tstep=kstep/12000.0
|
||||
k=0
|
||||
nhsym0=-999
|
||||
npts=(60*ntrperiod-6)*12000
|
||||
call timer('read_wav',0)
|
||||
read(10) id2(1:npts)
|
||||
call timer('read_wav',1)
|
||||
|
||||
! do i=1,npts
|
||||
! id2(i)=100.0*sin(6.283185307*1046.875*i/12000.0)
|
||||
! enddo
|
||||
|
||||
! if(ifile.eq.ifile1) call timer('jt9 ',0)
|
||||
do iblk=1,npts/kstep
|
||||
k=iblk*kstep
|
||||
nhsym=(k-2048)/kstep
|
||||
if(nhsym.ge.1 .and. nhsym.ne.nhsym0) then
|
||||
! Emit signal readyForFFT
|
||||
call timer('symspec ',0)
|
||||
call symspecx(k,ntrperiod,nsps,ndiskdat,nb,nbslider,pxdb, &
|
||||
s,f0a,df3,ihsym,nzap,slimit,lstrong)
|
||||
call timer('symspec ',1)
|
||||
nhsym0=nhsym
|
||||
if(ihsym.ge.184) go to 10
|
||||
endif
|
||||
enddo
|
||||
|
||||
10 continue
|
||||
|
||||
do i=0,512
|
||||
if(lstrong(i)) print*,'Strong signal at ',12000.0*i/1024.0
|
||||
enddo
|
||||
|
||||
nz=1000.0/df3
|
||||
do i=1,nz
|
||||
freq=f0a + (i-1)*df3
|
||||
write(78,3001) i,freq,savg(i)
|
||||
3001 format(i8,2f12.3)
|
||||
enddo
|
||||
|
||||
nutc=nutc0
|
||||
nstandalone=1
|
||||
call sync9(ss,tstep,f0a,df3,lagpk,fpk)
|
||||
call spec9(c0,npts8,nsps,f0a,lagpk,fpk,i1SoftSymbols)
|
||||
call decode9(i1SoftSymbols,msg)
|
||||
print*,msg
|
||||
enddo
|
||||
|
||||
call timer('jt9 ',1)
|
||||
call timer('jt9 ',101)
|
||||
! call ftnquit
|
||||
go to 999
|
||||
|
||||
998 print*,'Cannot open file:'
|
||||
print*,infile
|
||||
|
||||
999 end program jt9
|
||||
@@ -0,0 +1,97 @@
|
||||
subroutine m65a
|
||||
|
||||
! NB: this interface block is required by g95, but must be omitted
|
||||
! for gfortran. (????)
|
||||
|
||||
#ifndef UNIX
|
||||
interface
|
||||
function address_m65()
|
||||
end function address_m65
|
||||
end interface
|
||||
#endif
|
||||
|
||||
integer*1 attach_m65,lock_m65,unlock_m65
|
||||
integer size_m65
|
||||
integer*1, pointer :: address_m65,p_m65
|
||||
character*80 cwd
|
||||
logical fileExists
|
||||
common/tracer/limtrace,lu
|
||||
|
||||
call getcwd(cwd)
|
||||
call ftninit(trim(cwd))
|
||||
limtrace=0
|
||||
lu=12
|
||||
i1=attach_m65()
|
||||
|
||||
10 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
|
||||
if(fileExists) then
|
||||
call sleep_msec(100)
|
||||
go to 10
|
||||
endif
|
||||
|
||||
inquire(file=trim(cwd)//'/.quit',exist=fileExists)
|
||||
if(fileExists) then
|
||||
call ftnquit
|
||||
i=detach_m65()
|
||||
go to 999
|
||||
endif
|
||||
|
||||
nbytes=size_m65()
|
||||
if(nbytes.le.0) then
|
||||
print*,'m65a: Shared memory mem_m65 does not exist.'
|
||||
print*,'Program m65a should be started automatically from within map65.'
|
||||
go to 999
|
||||
endif
|
||||
p_m65=>address_m65()
|
||||
call m65b(p_m65,nbytes)
|
||||
|
||||
write(*,1010)
|
||||
1010 format('<m65aFinished>')
|
||||
flush(6)
|
||||
|
||||
100 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
|
||||
if(fileExists) go to 10
|
||||
call sleep_msec(100)
|
||||
go to 100
|
||||
|
||||
999 return
|
||||
end subroutine m65a
|
||||
|
||||
subroutine m65b(m65com,nbytes)
|
||||
integer*1 m65com(0:nbytes-1)
|
||||
kss=4*4*60*96000
|
||||
ksavg=kss+4*4*322*32768
|
||||
kfcenter=ksavg+4*4*32768
|
||||
call m65c(m65com(0),m65com(kss),m65com(ksavg),m65com(kfcenter))
|
||||
return
|
||||
end subroutine m65b
|
||||
|
||||
subroutine m65c(dd,ss,savg,nparams0)
|
||||
integer*1 detach_m65
|
||||
real*4 dd(4,5760000),ss(4,322,32768),savg(4,32768)
|
||||
real*8 fcenter
|
||||
integer nparams0(37),nparams(37)
|
||||
character*12 mycall,hiscall
|
||||
character*6 mygrid,hisgrid
|
||||
character*20 datetime
|
||||
common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, &
|
||||
ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, &
|
||||
mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,mode65, &
|
||||
mycall,mygrid,hiscall,hisgrid,datetime
|
||||
equivalence (nparams,fcenter)
|
||||
|
||||
nparams=nparams0 !Copy parameters into common/npar/
|
||||
npatience=1
|
||||
if(iand(nrxlog,1).ne.0) then
|
||||
write(21,1000) datetime(:17)
|
||||
1000 format(/'UTC Date: 'a17/78('-'))
|
||||
flush(21)
|
||||
endif
|
||||
if(iand(nrxlog,2).ne.0) rewind 21
|
||||
if(iand(nrxlog,4).ne.0) rewind 26
|
||||
|
||||
nstandalone=0
|
||||
if(sum(nparams).ne.0) call decode0(dd,ss,savg,nstandalone)
|
||||
|
||||
return
|
||||
end subroutine m65c
|
||||
+157
@@ -0,0 +1,157 @@
|
||||
program jt9sim
|
||||
|
||||
! Generate simulated data for testing of WSJT-X
|
||||
|
||||
parameter (NMAX=1800*12000)
|
||||
integer ihdr(11)
|
||||
integer*2 iwave !Generated waveform (no noise)
|
||||
real*8 f0,f,dt,twopi,phi,dphi,baud,fspan
|
||||
character msg*22,msg0*22,message*22,msgsent*22,arg*8,fname*11
|
||||
|
||||
integer*4 itone(85) !Channel symbols (values 0-8)
|
||||
integer*4 i4DataSymNoGray(69) !Data Symbols, values 0-7
|
||||
integer*1 i1ScrambledBits(207) !Hard-decision demodulated bits, interleaved
|
||||
integer*1 i1Bits(207) !Encoded information-carrying bits
|
||||
integer*1 i1SoftSymbols(207)
|
||||
integer*1 i1
|
||||
equivalence (i1,i4)
|
||||
|
||||
integer isync(85) !Sync vector
|
||||
data isync/ &
|
||||
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,1,0,0,0,0, &
|
||||
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0, &
|
||||
0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0, &
|
||||
0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0, &
|
||||
1,0,0,0,1/
|
||||
common/acom/dat(NMAX),iwave(NMAX)
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.ne.6) then
|
||||
print*,'Usage: jt9sim "message" fspan nsigs minutes SNR nfiles'
|
||||
print*,'Example: "CQ K1ABC FN42" 200 20 2 -28 1'
|
||||
print*,' '
|
||||
print*,'Enter message = "" to use entries in msgs.txt.'
|
||||
print*,'Enter SNR = 0 to generate a range of SNRs.'
|
||||
go to 999
|
||||
endif
|
||||
|
||||
call getarg(1,msg0)
|
||||
message=msg0 !Transmitted message
|
||||
call getarg(2,arg)
|
||||
read(arg,*) fspan !Total freq range (Hz)
|
||||
call getarg(3,arg)
|
||||
read(arg,*) nsigs !Number of signals in each file
|
||||
call getarg(4,arg)
|
||||
read(arg,*) minutes !Length of file (1 2 5 10 30 minutes)
|
||||
call getarg(5,arg)
|
||||
read(arg,*) snrdb !S/N in dB (2500 hz reference BW)
|
||||
call getarg(6,arg)
|
||||
read(arg,*) nfiles !Number of files
|
||||
|
||||
rmsdb=25.
|
||||
rms=10.0**(0.05*rmsdb)
|
||||
f0=1500.d0 !Center frequency (MHz)
|
||||
fsample=12000.d0 !Sample rate (Hz)
|
||||
dt=1.d0/fsample !Sample interval (s)
|
||||
twopi=8.d0*atan(1.d0)
|
||||
npts=12000*(60*minutes-6)
|
||||
nsps=0
|
||||
if(minutes.eq.1) nsps=6912
|
||||
if(minutes.eq.2) nsps=15360
|
||||
if(minutes.eq.5) nsps=40960
|
||||
if(minutes.eq.10) nsps=82944
|
||||
if(minutes.eq.30) nsps=252000
|
||||
if(nsps.eq.0) stop 'Bad value for minutes.'
|
||||
ihdr=0 !Temporary ###
|
||||
|
||||
open(12,file='msgs.txt',status='old')
|
||||
|
||||
write(*,1000)
|
||||
1000 format('File N freq S/N Message'/ &
|
||||
'---------------------------------------------------')
|
||||
|
||||
do ifile=1,nfiles
|
||||
nmin=(ifile-1)*2*minutes
|
||||
ihr=nmin/60
|
||||
imin=mod(nmin,60)
|
||||
write(fname,1002) ihr,imin !Create the output filenames
|
||||
1002 format('000000_',2i2.2)
|
||||
open(10,file=fname//'.wav',access='stream',status='unknown')
|
||||
|
||||
if(snrdb.lt.90) then
|
||||
do i=1,npts
|
||||
dat(i)=gran()
|
||||
enddo
|
||||
else
|
||||
dat(1:npts)=0.
|
||||
endif
|
||||
|
||||
if(msg0.ne.' ') then
|
||||
call genjt9(message,minutes,msgsent,itone)
|
||||
endif
|
||||
|
||||
rewind 12
|
||||
do isig=1,nsigs
|
||||
|
||||
if(msg0.eq.' ') then
|
||||
read(12,1004) message
|
||||
1004 format(a22)
|
||||
call genjt9(message,minutes,msgsent,itone)
|
||||
endif
|
||||
|
||||
f=f0
|
||||
if(nsigs.gt.1) f=f0 - 0.5d0*fspan + fspan*(isig-1.d0)/(nsigs-1.d0)
|
||||
snrdbx=snrdb
|
||||
! if(snrdb.ge.-1.0) snrdbx=-15.0 - 15.0*(isig-1.0)/nsigs
|
||||
sig=sqrt(2500.0/6000.0) * 10.0**(0.05*snrdbx)
|
||||
write(*,1020) ifile,isig,f,snrdbx,msgsent
|
||||
1020 format(i3,i4,f10.3,f7.1,2x,a22)
|
||||
|
||||
phi=0.
|
||||
baud=12000.0/nsps
|
||||
k=12000 !Start at t = 1 s
|
||||
do isym=1,85
|
||||
freq=f + itone(isym)*baud
|
||||
dphi=twopi*freq*dt
|
||||
do i=1,nsps
|
||||
phi=phi + dphi
|
||||
if(phi.lt.-twopi) phi=phi+twopi
|
||||
if(phi.gt.twopi) phi=phi-twopi
|
||||
xphi=phi
|
||||
k=k+1
|
||||
dat(k)=dat(k) + sig*sin(xphi) !Use lookup table for i*2 sin(x) ?
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i=1,npts
|
||||
iwave(i)=nint(rms*dat(i))
|
||||
enddo
|
||||
|
||||
write(10) ihdr,iwave(1:npts)
|
||||
close(10)
|
||||
|
||||
! We're done! Now decode the data symbols from itone, as a test.
|
||||
j=0
|
||||
do i=1,85
|
||||
if(isync(i).eq.1) cycle
|
||||
j=j+1
|
||||
i4DataSymNoGray(j)=igray(itone(i)-1,-1)
|
||||
enddo
|
||||
call unpackbits(i4DataSymNoGray,69,3,i1ScrambledBits)
|
||||
call interleave9(i1ScrambledBits,-1,i1Bits)
|
||||
|
||||
do i=1,206
|
||||
i4=-10
|
||||
if(i1Bits(i).eq.1) i4=10
|
||||
i4=i4+128
|
||||
i1SoftSymbols(i)=i1
|
||||
enddo
|
||||
|
||||
call decode9(i1SoftSymbols,msg)
|
||||
|
||||
if(msg.ne.msg0) print*,'Decode error: ',msg0,' ',msg
|
||||
|
||||
enddo
|
||||
|
||||
999 end program jt9sim
|
||||
@@ -0,0 +1,12 @@
|
||||
subroutine k2grid(k,grid)
|
||||
character grid*6
|
||||
|
||||
nlong=2*mod((k-1)/5,90)-179
|
||||
if(k.gt.450) nlong=nlong+180
|
||||
nlat=mod(k-1,5)+ 85
|
||||
dlat=nlat
|
||||
dlong=nlong
|
||||
call deg2grid(dlong,dlat,grid)
|
||||
|
||||
return
|
||||
end
|
||||
+256
@@ -0,0 +1,256 @@
|
||||
-25.6 1.000 -9.966 1.000000 0.000000
|
||||
-25.4 1.000 -9.966 1.000000 0.000000
|
||||
-25.2 1.000 -9.966 1.000000 0.000000
|
||||
-25.0 1.000 -9.966 1.000000 0.000000
|
||||
-24.8 1.000 -9.966 1.000000 0.000000
|
||||
-24.6 1.000 -9.966 1.000000 0.000000
|
||||
-24.4 1.000 -9.966 1.000000 0.000000
|
||||
-24.2 1.000 -9.966 1.000000 0.000000
|
||||
-24.0 1.000 -9.966 1.000000 0.000000
|
||||
-23.8 1.000 -9.966 1.000000 0.000000
|
||||
-23.6 1.000 -9.966 1.000000 0.000000
|
||||
-23.4 1.000 -9.966 1.000000 0.000000
|
||||
-23.2 1.000 -9.966 1.000000 0.000000
|
||||
-23.0 1.000 -9.966 1.000000 0.000000
|
||||
-22.8 1.000 -9.966 1.000000 0.000000
|
||||
-22.6 1.000 -9.966 1.000000 0.000000
|
||||
-22.4 1.000 -9.966 1.000000 0.000000
|
||||
-22.2 1.000 -9.966 1.000000 0.000000
|
||||
-22.0 1.000 -9.966 1.000000 0.000000
|
||||
-21.8 1.000 -9.966 1.000000 0.000000
|
||||
-21.6 1.000 -9.966 1.000000 0.000000
|
||||
-21.4 1.000 -9.966 1.000000 0.000000
|
||||
-21.2 1.000 -9.966 1.000000 0.000000
|
||||
-21.0 1.000 -9.966 1.000000 0.000000
|
||||
-20.8 1.000 -9.966 1.000000 0.000000
|
||||
-20.6 1.000 -9.966 1.000000 0.000000
|
||||
-20.4 1.000 -9.966 1.000000 0.000000
|
||||
-20.2 1.000 -9.966 1.000000 0.000000
|
||||
-20.0 1.000 -9.966 1.000000 0.000000
|
||||
-19.8 1.000 -9.966 1.000000 0.000000
|
||||
-19.6 1.000 -9.966 1.000000 0.000000
|
||||
-19.4 1.000 -9.966 1.000000 0.000000
|
||||
-19.2 1.000 -9.966 1.000000 0.000000
|
||||
-19.0 1.000 -9.966 1.000000 0.000000
|
||||
-18.8 1.000 -9.966 1.000000 0.000000
|
||||
-18.6 1.000 -9.966 1.000000 0.000000
|
||||
-18.4 1.000 -9.966 1.000000 0.000000
|
||||
-18.2 1.000 -9.966 1.000000 0.000000
|
||||
-18.0 1.000 -9.966 1.000000 0.000000
|
||||
-17.8 1.000 -9.966 1.000000 0.000000
|
||||
-17.6 1.000 -9.966 1.000000 0.000000
|
||||
-17.4 1.000 -9.966 1.000000 0.000000
|
||||
-17.2 1.000 -9.966 1.000000 0.000000
|
||||
-17.0 1.000 -9.966 1.000000 0.000000
|
||||
-16.8 1.000 -9.966 1.000000 0.000000
|
||||
-16.6 1.000 -9.966 1.000000 0.000000
|
||||
-16.4 1.000 -9.966 1.000000 0.000000
|
||||
-16.2 1.000 -9.966 1.000000 0.000000
|
||||
-16.0 0.988 -5.858 0.991379 0.008621
|
||||
-15.8 1.000 -9.966 1.000000 0.000000
|
||||
-15.6 0.991 -6.313 0.993711 0.006289
|
||||
-15.4 0.993 -6.629 0.994950 0.005051
|
||||
-15.2 1.000 -9.966 1.000000 0.000000
|
||||
-15.0 0.995 -7.055 0.996241 0.003759
|
||||
-14.8 1.000 -9.966 1.000000 0.000000
|
||||
-14.6 0.991 -6.371 0.993958 0.006042
|
||||
-14.4 1.000 -9.966 1.000000 0.000000
|
||||
-14.2 0.991 -6.313 0.993711 0.006289
|
||||
-14.0 0.992 -6.426 0.994186 0.005814
|
||||
-13.8 0.991 -6.288 0.993600 0.006400
|
||||
-13.6 0.990 -6.113 0.992775 0.007225
|
||||
-13.4 0.990 -6.152 0.992968 0.007032
|
||||
-13.2 0.992 -6.534 0.994606 0.005394
|
||||
-13.0 0.996 -7.332 0.996898 0.003102
|
||||
-12.8 0.990 -6.184 0.993121 0.006879
|
||||
-12.6 0.994 -7.016 0.996136 0.003864
|
||||
-12.4 0.993 -6.658 0.995049 0.004950
|
||||
-12.2 0.991 -6.369 0.993953 0.006047
|
||||
-12.0 0.992 -6.559 0.994699 0.005301
|
||||
-11.8 0.989 -6.002 0.992197 0.007803
|
||||
-11.6 0.991 -6.304 0.993671 0.006329
|
||||
-11.4 0.987 -5.826 0.991188 0.008812
|
||||
-11.2 0.985 -5.632 0.989919 0.010081
|
||||
-11.0 0.989 -5.995 0.992162 0.007838
|
||||
-10.8 0.984 -5.544 0.989284 0.010717
|
||||
-10.6 0.983 -5.377 0.987966 0.012034
|
||||
-10.4 0.979 -5.108 0.985502 0.014498
|
||||
-10.2 0.977 -4.954 0.983869 0.016131
|
||||
-10.0 0.971 -4.652 0.980118 0.019882
|
||||
-9.8 0.975 -4.870 0.982896 0.017104
|
||||
-9.6 0.974 -4.822 0.982324 0.017676
|
||||
-9.4 0.970 -4.608 0.979490 0.020510
|
||||
-9.2 0.970 -4.623 0.979702 0.020298
|
||||
-9.0 0.970 -4.621 0.979679 0.020321
|
||||
-8.8 0.967 -4.472 0.977465 0.022535
|
||||
-8.6 0.962 -4.261 0.973915 0.026085
|
||||
-8.4 0.960 -4.186 0.972538 0.027462
|
||||
-8.2 0.957 -4.098 0.970806 0.029194
|
||||
-8.0 0.956 -4.062 0.970061 0.029939
|
||||
-7.8 0.953 -3.975 0.968209 0.031791
|
||||
-7.6 0.942 -3.677 0.960918 0.039082
|
||||
-7.4 0.946 -3.768 0.963301 0.036699
|
||||
-7.2 0.937 -3.550 0.957308 0.042692
|
||||
-7.0 0.933 -3.463 0.954652 0.045348
|
||||
-6.8 0.929 -3.377 0.951866 0.048134
|
||||
-6.6 0.920 -3.212 0.946042 0.053958
|
||||
-6.4 0.917 -3.164 0.944202 0.055798
|
||||
-6.2 0.911 -3.058 0.939981 0.060019
|
||||
-6.0 0.903 -2.939 0.934818 0.065182
|
||||
-5.8 0.895 -2.829 0.929642 0.070358
|
||||
-5.6 0.884 -2.690 0.922540 0.077459
|
||||
-5.4 0.877 -2.608 0.917972 0.082028
|
||||
-5.2 0.869 -2.531 0.913509 0.086491
|
||||
-5.0 0.858 -2.411 0.905967 0.094033
|
||||
-4.8 0.846 -2.301 0.898525 0.101475
|
||||
-4.6 0.834 -2.201 0.891269 0.108731
|
||||
-4.4 0.821 -2.096 0.883085 0.116915
|
||||
-4.2 0.806 -1.992 0.874340 0.125660
|
||||
-4.0 0.790 -1.882 0.864307 0.135693
|
||||
-3.8 0.775 -1.790 0.855445 0.144555
|
||||
-3.6 0.755 -1.678 0.843726 0.156274
|
||||
-3.4 0.737 -1.587 0.833538 0.166462
|
||||
-3.2 0.713 -1.473 0.819841 0.180159
|
||||
-3.0 0.691 -1.376 0.807345 0.192655
|
||||
-2.8 0.667 -1.280 0.794093 0.205907
|
||||
-2.6 0.640 -1.181 0.779404 0.220596
|
||||
-2.4 0.612 -1.084 0.764178 0.235822
|
||||
-2.2 0.581 -0.987 0.747708 0.252292
|
||||
-2.0 0.548 -0.895 0.731037 0.268963
|
||||
-1.8 0.510 -0.796 0.712035 0.287965
|
||||
-1.6 0.472 -0.706 0.693474 0.306526
|
||||
-1.4 0.425 -0.606 0.671514 0.328486
|
||||
-1.2 0.378 -0.514 0.649948 0.350053
|
||||
-1.0 0.328 -0.425 0.627452 0.372548
|
||||
-0.8 0.274 -0.338 0.604549 0.395451
|
||||
-0.6 0.212 -0.249 0.579151 0.420849
|
||||
-0.4 0.146 -0.163 0.553389 0.446611
|
||||
-0.2 0.075 -0.079 0.526648 0.473352
|
||||
0.0 0.000 0.000 0.500000 0.500000
|
||||
0.2 -0.079 0.075 0.473352 0.526648
|
||||
0.4 -0.163 0.146 0.446611 0.553389
|
||||
0.6 -0.249 0.212 0.420849 0.579151
|
||||
0.8 -0.338 0.274 0.395451 0.604549
|
||||
1.0 -0.425 0.328 0.372548 0.627452
|
||||
1.2 -0.514 0.378 0.350053 0.649948
|
||||
1.4 -0.606 0.425 0.328486 0.671514
|
||||
1.6 -0.706 0.472 0.306526 0.693474
|
||||
1.8 -0.796 0.510 0.287965 0.712035
|
||||
2.0 -0.895 0.548 0.268963 0.731037
|
||||
2.2 -0.987 0.581 0.252292 0.747708
|
||||
2.4 -1.084 0.612 0.235822 0.764178
|
||||
2.6 -1.181 0.640 0.220596 0.779404
|
||||
2.8 -1.280 0.667 0.205907 0.794093
|
||||
3.0 -1.376 0.691 0.192655 0.807345
|
||||
3.2 -1.473 0.713 0.180159 0.819841
|
||||
3.4 -1.587 0.737 0.166462 0.833538
|
||||
3.6 -1.678 0.755 0.156274 0.843726
|
||||
3.8 -1.790 0.775 0.144555 0.855445
|
||||
4.0 -1.882 0.790 0.135693 0.864307
|
||||
4.2 -1.992 0.806 0.125660 0.874340
|
||||
4.4 -2.096 0.821 0.116915 0.883085
|
||||
4.6 -2.201 0.834 0.108731 0.891269
|
||||
4.8 -2.301 0.846 0.101475 0.898525
|
||||
5.0 -2.411 0.858 0.094033 0.905967
|
||||
5.2 -2.531 0.869 0.086491 0.913509
|
||||
5.4 -2.608 0.877 0.082028 0.917972
|
||||
5.6 -2.690 0.884 0.077459 0.922540
|
||||
5.8 -2.829 0.895 0.070358 0.929642
|
||||
6.0 -2.939 0.903 0.065182 0.934818
|
||||
6.2 -3.058 0.911 0.060019 0.939981
|
||||
6.4 -3.164 0.917 0.055798 0.944202
|
||||
6.6 -3.212 0.920 0.053958 0.946042
|
||||
6.8 -3.377 0.929 0.048134 0.951866
|
||||
7.0 -3.463 0.933 0.045348 0.954652
|
||||
7.2 -3.550 0.937 0.042692 0.957308
|
||||
7.4 -3.768 0.946 0.036699 0.963301
|
||||
7.6 -3.677 0.942 0.039082 0.960918
|
||||
7.8 -3.975 0.953 0.031791 0.968210
|
||||
8.0 -4.062 0.956 0.029939 0.970061
|
||||
8.2 -4.098 0.957 0.029194 0.970806
|
||||
8.4 -4.186 0.960 0.027462 0.972538
|
||||
8.6 -4.261 0.962 0.026085 0.973915
|
||||
8.8 -4.472 0.967 0.022535 0.977465
|
||||
9.0 -4.621 0.970 0.020321 0.979679
|
||||
9.2 -4.623 0.970 0.020298 0.979702
|
||||
9.4 -4.608 0.970 0.020510 0.979490
|
||||
9.6 -4.822 0.974 0.017676 0.982324
|
||||
9.8 -4.870 0.975 0.017104 0.982896
|
||||
10.0 -4.652 0.971 0.019882 0.980118
|
||||
10.2 -4.954 0.977 0.016131 0.983869
|
||||
10.4 -5.108 0.979 0.014498 0.985502
|
||||
10.6 -5.377 0.983 0.012034 0.987966
|
||||
10.8 -5.544 0.984 0.010717 0.989284
|
||||
11.0 -5.995 0.989 0.007838 0.992162
|
||||
11.2 -5.632 0.985 0.010081 0.989919
|
||||
11.4 -5.826 0.987 0.008812 0.991188
|
||||
11.6 -6.304 0.991 0.006329 0.993671
|
||||
11.8 -6.002 0.989 0.007803 0.992197
|
||||
12.0 -6.559 0.992 0.005301 0.994699
|
||||
12.2 -6.369 0.991 0.006047 0.993953
|
||||
12.4 -6.658 0.993 0.004950 0.995049
|
||||
12.6 -7.016 0.994 0.003864 0.996136
|
||||
12.8 -6.184 0.990 0.006879 0.993121
|
||||
13.0 -7.332 0.996 0.003102 0.996898
|
||||
13.2 -6.534 0.992 0.005394 0.994606
|
||||
13.4 -6.152 0.990 0.007032 0.992968
|
||||
13.6 -6.113 0.990 0.007225 0.992775
|
||||
13.8 -6.288 0.991 0.006400 0.993600
|
||||
14.0 -6.426 0.992 0.005814 0.994186
|
||||
14.2 -6.313 0.991 0.006289 0.993711
|
||||
14.4 -9.966 1.000 0.000000 1.000000
|
||||
14.6 -6.371 0.991 0.006042 0.993958
|
||||
14.8 -9.966 1.000 0.000000 1.000000
|
||||
15.0 -7.055 0.995 0.003759 0.996241
|
||||
15.2 -9.966 1.000 0.000000 1.000000
|
||||
15.4 -6.629 0.993 0.005051 0.994949
|
||||
15.6 -6.313 0.991 0.006289 0.993711
|
||||
15.8 -9.966 1.000 0.000000 1.000000
|
||||
16.0 -5.858 0.988 0.008621 0.991379
|
||||
16.2 -9.966 1.000 0.000000 1.000000
|
||||
16.4 -9.966 1.000 0.000000 1.000000
|
||||
16.6 -9.966 1.000 0.000000 1.000000
|
||||
16.8 -9.966 1.000 0.000000 1.000000
|
||||
17.0 -9.966 1.000 0.000000 1.000000
|
||||
17.2 -9.966 1.000 0.000000 1.000000
|
||||
17.4 -9.966 1.000 0.000000 1.000000
|
||||
17.6 -9.966 1.000 0.000000 1.000000
|
||||
17.8 -9.966 1.000 0.000000 1.000000
|
||||
18.0 -9.966 1.000 0.000000 1.000000
|
||||
18.2 -9.966 1.000 0.000000 1.000000
|
||||
18.4 -9.966 1.000 0.000000 1.000000
|
||||
18.6 -9.966 1.000 0.000000 1.000000
|
||||
18.8 -9.966 1.000 0.000000 1.000000
|
||||
19.0 -9.966 1.000 0.000000 1.000000
|
||||
19.2 -9.966 1.000 0.000000 1.000000
|
||||
19.4 -9.966 1.000 0.000000 1.000000
|
||||
19.6 -9.966 1.000 0.000000 1.000000
|
||||
19.8 -9.966 1.000 0.000000 1.000000
|
||||
20.0 -9.966 1.000 0.000000 1.000000
|
||||
20.2 -9.966 1.000 0.000000 1.000000
|
||||
20.4 -9.966 1.000 0.000000 1.000000
|
||||
20.6 -9.966 1.000 0.000000 1.000000
|
||||
20.8 -9.966 1.000 0.000000 1.000000
|
||||
21.0 -9.966 1.000 0.000000 1.000000
|
||||
21.2 -9.966 1.000 0.000000 1.000000
|
||||
21.4 -9.966 1.000 0.000000 1.000000
|
||||
21.6 -9.966 1.000 0.000000 1.000000
|
||||
21.8 -9.966 1.000 0.000000 1.000000
|
||||
22.0 -9.966 1.000 0.000000 1.000000
|
||||
22.2 -9.966 1.000 0.000000 1.000000
|
||||
22.4 -9.966 1.000 0.000000 1.000000
|
||||
22.6 -9.966 1.000 0.000000 1.000000
|
||||
22.8 -9.966 1.000 0.000000 1.000000
|
||||
23.0 -9.966 1.000 0.000000 1.000000
|
||||
23.2 -9.966 1.000 0.000000 1.000000
|
||||
23.4 -9.966 1.000 0.000000 1.000000
|
||||
23.6 -9.966 1.000 0.000000 1.000000
|
||||
23.8 -9.966 1.000 0.000000 1.000000
|
||||
24.0 -9.966 1.000 0.000000 1.000000
|
||||
24.2 -9.966 1.000 0.000000 1.000000
|
||||
24.4 -9.966 1.000 0.000000 1.000000
|
||||
24.6 -9.966 1.000 0.000000 1.000000
|
||||
24.8 -9.966 1.000 0.000000 1.000000
|
||||
25.0 -9.966 1.000 0.000000 1.000000
|
||||
25.2 -9.966 1.000 0.000000 1.000000
|
||||
25.4 -9.966 1.000 0.000000 1.000000
|
||||
+37
@@ -0,0 +1,37 @@
|
||||
program ms3
|
||||
|
||||
! Starting code for a JTMS3 decoder.
|
||||
|
||||
character*80 infile
|
||||
integer hdr(11)
|
||||
integer*2 id
|
||||
common/mscom/id(1440000),s1(215,703),s2(215,703)
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.lt.1) then
|
||||
print*,'Usage: ms3 file1 [file2 ...]'
|
||||
print*,' Reads data from *.wav files.'
|
||||
go to 999
|
||||
endif
|
||||
|
||||
npts=30*48000
|
||||
kstep=4096
|
||||
|
||||
do ifile=1,nargs
|
||||
call getarg(ifile,infile)
|
||||
open(10,file=infile,access='stream',status='old',err=998)
|
||||
read(10) hdr
|
||||
read(10) id
|
||||
close(10)
|
||||
|
||||
do k=kstep,npts,kstep
|
||||
call specjtms(k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
go to 999
|
||||
|
||||
998 print*,'Cannot open file:'
|
||||
print*,infile
|
||||
|
||||
999 end program ms3
|
||||
+63
@@ -0,0 +1,63 @@
|
||||
program msk
|
||||
|
||||
! Program to test decoding routines for mode JTMSK.
|
||||
|
||||
parameter (NSMAX=30*48000)
|
||||
character*80 infile
|
||||
character*6 cfile6
|
||||
character*12 arg
|
||||
character*12 mycall
|
||||
real dat(NSMAX)
|
||||
real x(NSMAX)
|
||||
complex cx(0:NSMAX/2)
|
||||
integer hdr(11)
|
||||
integer*2 id
|
||||
common/mscom/id(NSMAX),s1(215,703),s2(215,703)
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.lt.2) then
|
||||
print*,'Usage: msk nslow snr'
|
||||
go to 999
|
||||
endif
|
||||
call getarg(1,arg)
|
||||
read(arg,*) nslow
|
||||
call getarg(2,arg)
|
||||
read(arg,*) snr
|
||||
|
||||
! Read simulated pings from a file
|
||||
open(71,file='dat.71',form='unformatted',status='old')
|
||||
read(71) id
|
||||
|
||||
cfile6='123400'
|
||||
npts=30*48000
|
||||
kstep=2048
|
||||
minsigdb=1
|
||||
mousedf=0
|
||||
ntol=200
|
||||
mycall='W8WN'
|
||||
|
||||
! Make some band-limited noise.
|
||||
call random_number(x)
|
||||
nfft=NSMAX
|
||||
call four2a(x,nfft,1,-1,0)
|
||||
df=48000.0/nfft
|
||||
ia=nint(300.0/df)
|
||||
ib=nint(2700.0/df)
|
||||
cx(:ia)=0.
|
||||
cx(ib:)=0.
|
||||
call four2a(cx,nfft,1,1,-1)
|
||||
x(1)=0.
|
||||
rms=sqrt(dot_product(x,x)/NSMAX)
|
||||
x=x/rms
|
||||
|
||||
sig=(10.0**(0.05*snr))/32768.0 !Scaled signal strength
|
||||
dat=sig*id + x !Add pings to noise
|
||||
|
||||
! This loop simulates being called from "datasink()" in program JTMSK.
|
||||
do iblk=1,npts/kstep
|
||||
k=iblk*kstep
|
||||
call rtping(dat,k,cfile6,MinSigdB,MouseDF,ntol,mycall)
|
||||
if(nslow.ne.0) call usleep(42000)
|
||||
enddo
|
||||
|
||||
999 end program msk
|
||||
@@ -0,0 +1,49 @@
|
||||
program msk
|
||||
|
||||
! Starting code for a JTMSK decoder.
|
||||
|
||||
parameter (NSMAX=30*48000)
|
||||
character*80 infile
|
||||
character*6 cfile6
|
||||
real dat(NSMAX)
|
||||
integer hdr(11)
|
||||
integer*2 id
|
||||
common/mscom/id(NSMAX),s1(215,703),s2(215,703)
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.lt.1) then
|
||||
print*,'Usage: msk file1 [file2 ...]'
|
||||
print*,' Reads data from *.wav files.'
|
||||
go to 999
|
||||
endif
|
||||
|
||||
npts=30*48000
|
||||
kstep=2048
|
||||
minsigdb=6
|
||||
mousedf=0
|
||||
ntol=200
|
||||
|
||||
do ifile=1,nargs
|
||||
call getarg(ifile,infile)
|
||||
open(10,file=infile,access='stream',status='old',err=998)
|
||||
read(10) hdr
|
||||
read(10) id
|
||||
close(10)
|
||||
hdr(1)=hdr(2)
|
||||
i1=index(infile,'.wav')
|
||||
cfile6=infile(i1-6:i1-1)
|
||||
dat=id
|
||||
|
||||
k=0
|
||||
do iblk=1,npts/kstep
|
||||
k=k+kstep
|
||||
call rtping(dat,k,cfile6,MinSigdB,MouseDF,ntol)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
go to 999
|
||||
|
||||
998 print*,'Cannot open file:'
|
||||
print*,infile
|
||||
|
||||
999 end program msk
|
||||
+23
@@ -0,0 +1,23 @@
|
||||
function nchar(c)
|
||||
|
||||
C Convert ascii number, letter, or space to 0-36 for callsign packing.
|
||||
|
||||
character c*1
|
||||
|
||||
n=0 !Silence compiler warning
|
||||
if(c.ge.'0' .and. c.le.'9') then
|
||||
n=ichar(c)-ichar('0')
|
||||
else if(c.ge.'A' .and. c.le.'Z') then
|
||||
n=ichar(c)-ichar('A') + 10
|
||||
else if(c.ge.'a' .and. c.le.'z') then
|
||||
n=ichar(c)-ichar('a') + 10
|
||||
else if(c.ge.' ') then
|
||||
n=36
|
||||
else
|
||||
Print*,'Invalid character in callsign ',c,' ',ichar(c)
|
||||
stop
|
||||
endif
|
||||
nchar=n
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,13 @@
|
||||
subroutine noisegen(d4,nmax)
|
||||
|
||||
real*4 d4(4,nmax)
|
||||
|
||||
do i=1,nmax
|
||||
d4(1,i)=gran()
|
||||
d4(2,i)=gran()
|
||||
d4(3,i)=gran()
|
||||
d4(4,i)=gran()
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine noisegen
|
||||
@@ -0,0 +1,21 @@
|
||||
subroutine packbits(dbits,nsymd,m0,sym)
|
||||
|
||||
! Pack 0s and 1s from dbits() into sym() with m0 bits per word.
|
||||
! NB: nsymd is the number of packed output words.
|
||||
|
||||
integer sym(nsymd)
|
||||
integer*1 dbits(*)
|
||||
|
||||
k=0
|
||||
do i=1,nsymd
|
||||
n=0
|
||||
do j=1,m0
|
||||
k=k+1
|
||||
m=dbits(k)
|
||||
n=ior(ishft(n,1),m)
|
||||
enddo
|
||||
sym(i)=n
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine packbits
|
||||
@@ -0,0 +1,79 @@
|
||||
subroutine packcall(callsign,ncall,text)
|
||||
|
||||
C Pack a valid callsign into a 28-bit integer.
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
character callsign*6,c*1,tmp*6
|
||||
logical text
|
||||
|
||||
text=.false.
|
||||
|
||||
C Work-around for Swaziland prefix:
|
||||
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
|
||||
|
||||
if(callsign(1:3).eq.'CQ ') then
|
||||
ncall=NBASE + 1
|
||||
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and.
|
||||
+ callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and.
|
||||
+ callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
|
||||
read(callsign(4:6),*) nfreq
|
||||
ncall=NBASE + 3 + nfreq
|
||||
endif
|
||||
return
|
||||
else if(callsign(1:4).eq.'QRZ ') then
|
||||
ncall=NBASE + 2
|
||||
return
|
||||
else if(callsign(1:3).eq.'DE ') then
|
||||
ncall=267796945
|
||||
return
|
||||
endif
|
||||
|
||||
tmp=' '
|
||||
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
|
||||
tmp=callsign
|
||||
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
|
||||
if(callsign(6:6).ne.' ') then
|
||||
text=.true.
|
||||
return
|
||||
endif
|
||||
tmp=' '//callsign(:5)
|
||||
else
|
||||
text=.true.
|
||||
return
|
||||
endif
|
||||
|
||||
do i=1,6
|
||||
c=tmp(i:i)
|
||||
if(c.ge.'a' .and. c.le.'z')
|
||||
+ tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
|
||||
enddo
|
||||
|
||||
n1=0
|
||||
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
|
||||
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
|
||||
n2=0
|
||||
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
|
||||
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
|
||||
n3=0
|
||||
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
|
||||
n4=0
|
||||
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
|
||||
n5=0
|
||||
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
|
||||
n6=0
|
||||
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
|
||||
|
||||
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
|
||||
text=.true.
|
||||
return
|
||||
endif
|
||||
|
||||
ncall=nchar(tmp(1:1))
|
||||
ncall=36*ncall+nchar(tmp(2:2))
|
||||
ncall=10*ncall+nchar(tmp(3:3))
|
||||
ncall=27*ncall+nchar(tmp(4:4))-10
|
||||
ncall=27*ncall+nchar(tmp(5:5))-10
|
||||
ncall=27*ncall+nchar(tmp(6:6))-10
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,64 @@
|
||||
subroutine packdxcc(c,ng,ldxcc)
|
||||
|
||||
character*3 c
|
||||
logical ldxcc
|
||||
|
||||
parameter (NZ=303)
|
||||
character*5 pfx(NZ)
|
||||
data pfx/
|
||||
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
|
||||
+ '3D2 ', '3DA ','3V ','3W ','3X ','3Y ',
|
||||
+ '4J ','4L ','4S ','4U1 ', '4W ',
|
||||
+ '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ',
|
||||
+ '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ',
|
||||
+ '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ',
|
||||
+ '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ',
|
||||
+ '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ',
|
||||
+ 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ',
|
||||
+ 'C3 ','C5 ','C6 ','C9 ','CE ','CE0 ',
|
||||
+ 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ',
|
||||
+ 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ',
|
||||
+ 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ',
|
||||
+ 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ',
|
||||
+ 'F ','FG ','FH ','FJ ','FK ', 'FM ','FO ',
|
||||
+ 'FP ','FR ',
|
||||
+ 'FT5 ', 'FW ','FY ','M ','MD ','MI ',
|
||||
+ 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ',
|
||||
+ 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0 ',
|
||||
+ 'HL ','HM ','HP ','HR ','HS ','HV ','HZ ',
|
||||
+ 'I ','IG9 ','IS ','IT9 ','J2 ','J3 ','J5 ','J6 ',
|
||||
+ 'J7 ','J8 ','JA ','JD ', 'JT ','JW ',
|
||||
+ 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ',
|
||||
+ 'KH4 ','KH5 ', 'KH6 ','KH7 ','KH8 ','KH9 ','KL ',
|
||||
+ 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ',
|
||||
+ 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ',
|
||||
+ 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ',
|
||||
+ 'PJ2 ','PJ7 ','PY ','PY0 ', 'PZ ','R1F ',
|
||||
+ 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ',
|
||||
+ 'ST ','SU ','SV ', 'SV5 ','SV9 ','T2 ','T30 ',
|
||||
+ 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ',
|
||||
+ 'TA1 ','TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ',
|
||||
+ 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ',
|
||||
+ 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ',
|
||||
+ 'V6 ','V7 ','V8 ','VE ','VK ','VK0 ', 'VK9 ',
|
||||
+ 'VP2 ',
|
||||
+ 'VP5 ','VP6 ', 'VP8 ',
|
||||
+ 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ',
|
||||
+ 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ',
|
||||
+ 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ',
|
||||
+ 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ',
|
||||
+ 'ZD9 ','ZF ','ZK1 ', 'ZK2 ','ZK3 ','ZL ','ZL7 ',
|
||||
+ 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 '/
|
||||
|
||||
ldxcc=.false.
|
||||
ng=0
|
||||
do i=1,NZ
|
||||
if(pfx(i)(1:3).eq.c) go to 10
|
||||
enddo
|
||||
go to 20
|
||||
|
||||
10 ng=180*180+61+i
|
||||
ldxcc=.true.
|
||||
|
||||
20 return
|
||||
end
|
||||
@@ -0,0 +1,47 @@
|
||||
subroutine packgrid(grid,ng,text)
|
||||
|
||||
parameter (NGBASE=180*180)
|
||||
character*4 grid
|
||||
logical text
|
||||
|
||||
text=.false.
|
||||
if(grid.eq.' ') go to 90 !Blank grid is OK
|
||||
|
||||
C Test for numerical signal report, etc.
|
||||
if(grid(1:1).eq.'-') then
|
||||
read(grid(2:3),*,err=1,end=1) n
|
||||
1 ng=NGBASE+1+n
|
||||
go to 100
|
||||
else if(grid(1:2).eq.'R-') then
|
||||
read(grid(3:4),*,err=2,end=2) n
|
||||
2 if(n.eq.0) go to 90
|
||||
ng=NGBASE+31+n
|
||||
go to 100
|
||||
else if(grid(1:2).eq.'RO') then
|
||||
ng=NGBASE+62
|
||||
go to 100
|
||||
else if(grid(1:3).eq.'RRR') then
|
||||
ng=NGBASE+63
|
||||
go to 100
|
||||
else if(grid(1:2).eq.'73') then
|
||||
ng=NGBASE+64
|
||||
go to 100
|
||||
endif
|
||||
|
||||
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
|
||||
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
|
||||
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
|
||||
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
|
||||
if(text) go to 100
|
||||
|
||||
call grid2deg(grid//'mm',dlong,dlat)
|
||||
long=dlong
|
||||
lat=dlat+ 90.0
|
||||
ng=((long+180)/2)*180 + lat
|
||||
go to 100
|
||||
|
||||
90 ng=NGBASE + 1
|
||||
|
||||
100 return
|
||||
end
|
||||
|
||||
+103
@@ -0,0 +1,103 @@
|
||||
subroutine packmsg(msg,dat)
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
parameter (NBASE2=262178562)
|
||||
character*22 msg
|
||||
integer dat(12)
|
||||
character*12 c1,c2,c2z
|
||||
character*4 c3
|
||||
character*6 grid6
|
||||
c character*3 dxcc !Where is DXCC implemented?
|
||||
logical text1,text2,text3
|
||||
|
||||
C Convert all letters to upper case
|
||||
do i=1,22
|
||||
if(msg(i:i).ge.'a' .and. msg(i:i).le.'z')
|
||||
+ msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a'))
|
||||
enddo
|
||||
|
||||
C See if it's a CQ message
|
||||
if(msg(1:3).eq.'CQ ') then
|
||||
i=3
|
||||
C ... and if so, does it have a reply frequency?
|
||||
if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and.
|
||||
+ msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and.
|
||||
+ msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
|
||||
go to 1
|
||||
endif
|
||||
|
||||
do i=1,22
|
||||
if(msg(i:i).eq.' ') go to 1 !Get 1st blank
|
||||
enddo
|
||||
go to 10 !Consider msg as plain text
|
||||
|
||||
1 ia=i
|
||||
c1=msg(1:ia-1)
|
||||
do i=ia+1,22
|
||||
if(msg(i:i).eq.' ') go to 2 !Get 2nd blank
|
||||
enddo
|
||||
go to 10 !Consider msg as plain text
|
||||
|
||||
2 ib=i
|
||||
c2=msg(ia+1:ib-1)
|
||||
|
||||
do i=ib+1,22
|
||||
if(msg(i:i).eq.' ') go to 3 !Get 3rd blank
|
||||
enddo
|
||||
go to 10 !Consider msg as plain text
|
||||
|
||||
3 ic=i
|
||||
c3=' '
|
||||
if(ic.ge.ib+1) c3=msg(ib+1:ic)
|
||||
if(c3.eq.'OOO ') c3=' ' !Strip out the OOO flag
|
||||
call getpfx1(c1,k1,junk)
|
||||
call packcall(c1,nc1,text1)
|
||||
c2z=c2
|
||||
call getpfx1(c2,k2,nv2)
|
||||
call packcall(c2,nc2,text2)
|
||||
if(nv2.eq.0) then
|
||||
if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
|
||||
if(k2.gt.0) k2=k2+450
|
||||
k=max(k1,k2)
|
||||
if(k.gt.0) then
|
||||
call k2grid(k,grid6)
|
||||
c3=grid6(:4)
|
||||
endif
|
||||
endif
|
||||
call packgrid(c3,ng,text3)
|
||||
if(nv2.eq.0 .and. (.not.text1) .and. (.not.text2) .and.
|
||||
+ (.not.text3)) go to 20
|
||||
if(nv2.gt.0) then
|
||||
if(nv2.eq.1) then
|
||||
if(c1(1:3).eq.'CQ ') nc1=262178563 + k2
|
||||
if(c1(1:4).eq.'QRZ ') nc1=264002072 + k2
|
||||
if(c1(1:3).eq.'DE ') nc1=265825581 + k2
|
||||
endif
|
||||
if(nv2.eq.2) then
|
||||
if(c1(1:3).eq.'CQ ') nc1=267649090 + k2
|
||||
if(c1(1:4).eq.'QRZ ') nc1=267698375 + k2
|
||||
if(c1(1:3).eq.'DE ') nc1=267747660 + k2
|
||||
endif
|
||||
go to 20
|
||||
endif
|
||||
|
||||
C The message will be treated as plain text.
|
||||
10 call packtext(msg,nc1,nc2,ng)
|
||||
ng=ng+32768
|
||||
|
||||
C Encode data into 6-bit words
|
||||
20 dat(1)=iand(ishft(nc1,-22),63) !6 bits
|
||||
dat(2)=iand(ishft(nc1,-16),63) !6 bits
|
||||
dat(3)=iand(ishft(nc1,-10),63) !6 bits
|
||||
dat(4)=iand(ishft(nc1, -4),63) !6 bits
|
||||
dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3) !4+2 bits
|
||||
dat(6)=iand(ishft(nc2,-20),63) !6 bits
|
||||
dat(7)=iand(ishft(nc2,-14),63) !6 bits
|
||||
dat(8)=iand(ishft(nc2, -8),63) !6 bits
|
||||
dat(9)=iand(ishft(nc2, -2),63) !6 bits
|
||||
dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
|
||||
dat(11)=iand(ishft(ng,-6),63)
|
||||
dat(12)=iand(ng,63)
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,47 @@
|
||||
subroutine packtext(msg,nc1,nc2,nc3)
|
||||
|
||||
parameter (MASK28=2**28 - 1)
|
||||
character*13 msg
|
||||
character*44 c
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
||||
|
||||
nc1=0
|
||||
nc2=0
|
||||
nc3=0
|
||||
|
||||
do i=1,5 !First 5 characters in nc1
|
||||
do j=1,44 !Get character code
|
||||
if(msg(i:i).eq.c(j:j)) go to 10
|
||||
enddo
|
||||
j=37
|
||||
10 j=j-1 !Codes should start at zero
|
||||
nc1=42*nc1 + j
|
||||
enddo
|
||||
|
||||
do i=6,10 !Characters 6-10 in nc2
|
||||
do j=1,44 !Get character code
|
||||
if(msg(i:i).eq.c(j:j)) go to 20
|
||||
enddo
|
||||
j=37
|
||||
20 j=j-1 !Codes should start at zero
|
||||
nc2=42*nc2 + j
|
||||
enddo
|
||||
|
||||
do i=11,13 !Characters 11-13 in nc3
|
||||
do j=1,44 !Get character code
|
||||
if(msg(i:i).eq.c(j:j)) go to 30
|
||||
enddo
|
||||
j=37
|
||||
30 j=j-1 !Codes should start at zero
|
||||
nc3=42*nc3 + j
|
||||
enddo
|
||||
|
||||
C We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
|
||||
nc1=nc1+nc1
|
||||
if(iand(nc3,32768).ne.0) nc1=nc1+1
|
||||
nc2=nc2+nc2
|
||||
if(iand(nc3,65536).ne.0) nc2=nc2+1
|
||||
nc3=iand(nc3,32767)
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,13 @@
|
||||
subroutine pctile(x,tmp,nmax,npct,xpct)
|
||||
real x(nmax),tmp(nmax)
|
||||
|
||||
do i=1,nmax
|
||||
tmp(i)=x(i)
|
||||
enddo
|
||||
call sort(nmax,tmp)
|
||||
j=nint(nmax*0.01*npct)
|
||||
if(j.lt.1) j=1
|
||||
xpct=tmp(j)
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,50 @@
|
||||
parameter (NZ=339) !Total number of prefixes
|
||||
parameter (NZ2=12) !Total number of suffixes
|
||||
character*1 sfx(NZ2)
|
||||
character*5 pfx(NZ)
|
||||
|
||||
data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/
|
||||
data pfx/
|
||||
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
|
||||
+ '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ',
|
||||
+ '3YB ','3YP ','4J ','4L ','4S ','4U1I ','4U1U ','4W ',
|
||||
+ '4X ','5A ','5B ','5H ','5N ','5R ','5T ','5U ',
|
||||
+ '5V ','5W ','5X ','5Z ','6W ','6Y ','7O ','7P ',
|
||||
+ '7Q ','7X ','8P ','8Q ','8R ','9A ','9G ','9H ',
|
||||
+ '9J ','9K ','9L ','9M2 ','9M6 ','9N ','9Q ','9U ',
|
||||
+ '9V ','9X ','9Y ','A2 ','A3 ','A4 ','A5 ','A6 ',
|
||||
+ 'A7 ','A9 ','AP ','BS7 ','BV ','BV9 ','BY ','C2 ',
|
||||
+ 'C3 ','C5 ','C6 ','C9 ','CE ','CE0X ','CE0Y ','CE0Z ',
|
||||
+ 'CE9 ','CM ','CN ','CP ','CT ','CT3 ','CU ','CX ',
|
||||
+ 'CY0 ','CY9 ','D2 ','D4 ','D6 ','DL ','DU ','E3 ',
|
||||
+ 'E4 ','EA ','EA6 ','EA8 ','EA9 ','EI ','EK ','EL ',
|
||||
+ 'EP ','ER ','ES ','ET ','EU ','EX ','EY ','EZ ',
|
||||
+ 'F ','FG ','FH ','FJ ','FK ','FKC ','FM ','FO ',
|
||||
+ 'FOA ','FOC ','FOM ','FP ','FR ','FRG ','FRJ ','FRT ',
|
||||
+ 'FT5W ','FT5X ','FT5Z ','FW ','FY ','M ','MD ','MI ',
|
||||
+ 'MJ ','MM ', 'MU ','MW ','H4 ','H40 ','HA ',
|
||||
+ 'HB ','HB0 ','HC ','HC8 ','HH ','HI ','HK ','HK0A ',
|
||||
+ 'HK0M ','HL ','HM ','HP ','HR ','HS ','HV ','HZ ',
|
||||
+ 'I ','IS ','IS0 ', 'J2 ','J3 ','J5 ','J6 ',
|
||||
+ 'J7 ','J8 ','JA ','JDM ','JDO ','JT ','JW ',
|
||||
+ 'JX ','JY ','K ','KG4 ','KH0 ','KH1 ','KH2 ','KH3 ',
|
||||
+ 'KH4 ','KH5 ','KH5K ','KH6 ','KH7 ','KH8 ','KH9 ','KL ',
|
||||
+ 'KP1 ','KP2 ','KP4 ','KP5 ','LA ','LU ','LX ','LY ',
|
||||
+ 'LZ ','OA ','OD ','OE ','OH ','OH0 ','OJ0 ','OK ',
|
||||
+ 'OM ','ON ','OX ','OY ','OZ ','P2 ','P4 ','PA ',
|
||||
+ 'PJ2 ','PJ7 ','PY ','PY0F ','PT0S ','PY0T ','PZ ','R1F ',
|
||||
+ 'R1M ','S0 ','S2 ','S5 ','S7 ','S9 ','SM ','SP ',
|
||||
+ 'ST ','SU ','SV ','SVA ','SV5 ','SV9 ','T2 ','T30 ',
|
||||
+ 'T31 ','T32 ','T33 ','T5 ','T7 ','T8 ','T9 ','TA ',
|
||||
+ 'TF ','TG ','TI ','TI9 ','TJ ','TK ','TL ',
|
||||
+ 'TN ','TR ','TT ','TU ','TY ','TZ ','UA ','UA2 ',
|
||||
+ 'UA9 ','UK ','UN ','UR ','V2 ','V3 ','V4 ','V5 ',
|
||||
+ 'V6 ','V7 ','V8 ','VE ','VK ','VK0H ','VK0M ','VK9C ',
|
||||
+ 'VK9L ','VK9M ','VK9N ','VK9W ','VK9X ','VP2E ','VP2M ','VP2V ',
|
||||
+ 'VP5 ','VP6 ','VP6D ','VP8 ','VP8G ','VP8H ','VP8O ','VP8S ',
|
||||
+ 'VP9 ','VQ9 ','VR ','VU ','VU4 ','VU7 ','XE ','XF4 ',
|
||||
+ 'XT ','XU ','XW ','XX9 ','XZ ','YA ','YB ','YI ',
|
||||
+ 'YJ ','YK ','YL ','YN ','YO ','YS ','YU ','YV ',
|
||||
+ 'YV0 ','Z2 ','Z3 ','ZA ','ZB ','ZC4 ','ZD7 ','ZD8 ',
|
||||
+ 'ZD9 ','ZF ','ZK1N ','ZK1S ','ZK2 ','ZK3 ','ZL ','ZL7 ',
|
||||
+ 'ZL8 ','ZL9 ','ZP ','ZS ','ZS8 ','KC4 ','E5 '/
|
||||
@@ -0,0 +1,13 @@
|
||||
subroutine pfxdump(fname)
|
||||
character*(*) fname
|
||||
include 'pfx.f'
|
||||
|
||||
open(11,file=fname,status='unknown')
|
||||
write(11,1001) sfx
|
||||
1001 format('Supported Suffixes:'/(11('/',a1,2x)))
|
||||
write(11,1002) pfx
|
||||
1002 format(/'Supported Add-On DXCC Prefixes:'/(15(a5,1x)))
|
||||
close(11)
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,42 @@
|
||||
#include <windows.h>
|
||||
#include <stdio.h>
|
||||
|
||||
int ptt_(int *nport, int *ntx, int *iptt)
|
||||
{
|
||||
static HANDLE hFile;
|
||||
static int open=0;
|
||||
char s[10];
|
||||
int i3,i4,i5,i6,i9,i00;
|
||||
|
||||
if(*nport==0) {
|
||||
*iptt=*ntx;
|
||||
return(0);
|
||||
}
|
||||
|
||||
if(*ntx && (!open)) {
|
||||
sprintf(s,"COM%d",*nport);
|
||||
hFile=CreateFile(TEXT(s),GENERIC_WRITE,0,NULL,OPEN_EXISTING,
|
||||
FILE_ATTRIBUTE_NORMAL,NULL);
|
||||
if(hFile==INVALID_HANDLE_VALUE) {
|
||||
// printf("PTT: Cannot open COM port %d.\n",*nport);
|
||||
return 1;
|
||||
}
|
||||
open=1;
|
||||
}
|
||||
|
||||
if(*ntx && open) {
|
||||
EscapeCommFunction(hFile,3);
|
||||
EscapeCommFunction(hFile,5);
|
||||
*iptt=1;
|
||||
}
|
||||
|
||||
else {
|
||||
EscapeCommFunction(hFile,4);
|
||||
EscapeCommFunction(hFile,6);
|
||||
EscapeCommFunction(hFile,9);
|
||||
i00=CloseHandle(hFile);
|
||||
*iptt=0;
|
||||
open=0;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
+391
@@ -0,0 +1,391 @@
|
||||
/*
|
||||
* WSJT is Copyright (c) 2001-2006 by Joseph H. Taylor, Jr., K1JT,
|
||||
* and is licensed under the GNU General Public License (GPL).
|
||||
*
|
||||
* Code used from cwdaemon for parallel port ptt only.
|
||||
*
|
||||
* cwdaemon - morse sounding daemon for the parallel or serial port
|
||||
* Copyright (C) 2002 -2005 Joop Stakenborg <pg4i@amsat.org>
|
||||
* and many authors, see the AUTHORS file.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU Library General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program; if not, write to the Free Software
|
||||
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
*/
|
||||
# if HAVE_STDIO_H
|
||||
# include <stdio.h>
|
||||
#endif
|
||||
#if STDC_HEADERS
|
||||
# include <stdlib.h>
|
||||
# include <stddef.h>
|
||||
#else
|
||||
# if HAVE_STDLIB_H
|
||||
# include <stdlib.h>
|
||||
# endif
|
||||
#endif
|
||||
#if HAVE_UNISTD_H
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
#if HAVE_SYS_IOCTL_H
|
||||
# include <sys/ioctl.h>
|
||||
#endif
|
||||
#if HAVE_FCNTL_H
|
||||
# include <fcntl.h>
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_LINUX_PPDEV_H
|
||||
# include <linux/ppdev.h>
|
||||
# include <linux/parport.h>
|
||||
#endif
|
||||
#ifdef HAVE_DEV_PPBUS_PPI_H
|
||||
# include <dev/ppbus/ppi.h>
|
||||
# include <dev/ppbus/ppbconf.h>
|
||||
#endif
|
||||
|
||||
int lp_reset (int fd);
|
||||
int lp_ptt (int fd, int onoff);
|
||||
|
||||
#ifdef HAVE_SYS_STAT_H
|
||||
# include <sys/stat.h>
|
||||
#endif
|
||||
#if (defined(__unix__) || defined(unix)) && !defined(USG)
|
||||
# include <sys/param.h>
|
||||
#endif
|
||||
|
||||
#include <string.h>
|
||||
/* parport functions */
|
||||
|
||||
int dev_is_parport(int fd);
|
||||
int ptt_parallel(int fd, int *ntx, int *iptt);
|
||||
int ptt_serial(int fd, int *ntx, int *iptt);
|
||||
|
||||
int fd=-1; /* Used for both serial and parallel */
|
||||
|
||||
/*
|
||||
* ptt_
|
||||
*
|
||||
* generic unix PTT routine called from Fortran
|
||||
*
|
||||
* Inputs
|
||||
* unused Unused, to satisfy old windows calling convention
|
||||
* ptt_port device name serial or parallel
|
||||
* ntx pointer to fortran command on or off
|
||||
* iptt pointer to fortran command status on or off
|
||||
* Returns - non 0 if error
|
||||
*/
|
||||
|
||||
/* Tiny state machine */
|
||||
#define STATE_PORT_CLOSED 0
|
||||
#define STATE_PORT_OPEN_PARALLEL 1
|
||||
#define STATE_PORT_OPEN_SERIAL 2
|
||||
|
||||
//int ptt_(int *unused, char *ptt_port, int *ntx, int *iptt)
|
||||
int ptt_(int *unused, int *ntx, int *iptt)
|
||||
{
|
||||
static int state=0;
|
||||
char *p;
|
||||
|
||||
// ### Temporary:
|
||||
char* ptt_port;
|
||||
if(*unused != -99) {
|
||||
*iptt=*ntx;
|
||||
return 0;
|
||||
}
|
||||
// ###
|
||||
|
||||
/* In the very unlikely event of a NULL pointer, just return.
|
||||
* Yes, I realise this should not be possible in WSJT.
|
||||
*/
|
||||
if (ptt_port == NULL) {
|
||||
*iptt = *ntx;
|
||||
return (0);
|
||||
}
|
||||
|
||||
switch (state) {
|
||||
case STATE_PORT_CLOSED:
|
||||
|
||||
/* Remove trailing ' ' */
|
||||
if ((p = strchr(ptt_port, ' ')) != NULL)
|
||||
*p = '\0';
|
||||
|
||||
/* If all that is left is a '\0' then also just return */
|
||||
if (*ptt_port == '\0') {
|
||||
*iptt = *ntx;
|
||||
return(0);
|
||||
}
|
||||
|
||||
if ((fd = open(ptt_port, O_RDWR|O_NONBLOCK)) < 0) {
|
||||
fprintf(stderr, "Can't open %s.\n", ptt_port);
|
||||
return (1);
|
||||
}
|
||||
|
||||
if (dev_is_parport(fd)) {
|
||||
state = STATE_PORT_OPEN_PARALLEL;
|
||||
lp_reset(fd);
|
||||
ptt_parallel(fd, ntx, iptt);
|
||||
} else {
|
||||
state = STATE_PORT_OPEN_SERIAL;
|
||||
ptt_serial(fd, ntx, iptt);
|
||||
}
|
||||
break;
|
||||
|
||||
case STATE_PORT_OPEN_PARALLEL:
|
||||
ptt_parallel(fd, ntx, iptt);
|
||||
break;
|
||||
|
||||
case STATE_PORT_OPEN_SERIAL:
|
||||
ptt_serial(fd, ntx, iptt);
|
||||
break;
|
||||
|
||||
default:
|
||||
close(fd);
|
||||
fd = -1;
|
||||
state = STATE_PORT_CLOSED;
|
||||
break;
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
/*
|
||||
* ptt_serial
|
||||
*
|
||||
* generic serial unix PTT routine called indirectly from Fortran
|
||||
*
|
||||
* fd - already opened file descriptor
|
||||
* ntx - pointer to fortran command on or off
|
||||
* iptt - pointer to fortran command status on or off
|
||||
*/
|
||||
|
||||
int
|
||||
ptt_serial(int fd, int *ntx, int *iptt)
|
||||
{
|
||||
int control = TIOCM_RTS | TIOCM_DTR;
|
||||
|
||||
if(*ntx) {
|
||||
ioctl(fd, TIOCMBIS, &control); /* Set DTR and RTS */
|
||||
*iptt = 1;
|
||||
} else {
|
||||
ioctl(fd, TIOCMBIC, &control);
|
||||
*iptt = 0;
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
|
||||
/* parport functions */
|
||||
|
||||
/*
|
||||
* dev_is_parport(fd):
|
||||
*
|
||||
* inputs - Already open fd
|
||||
* output - 1 if parallel port, 0 if not
|
||||
* side effects - Unfortunately, this is platform specific.
|
||||
*/
|
||||
|
||||
#if defined(HAVE_LINUX_PPDEV_H) /* Linux (ppdev) */
|
||||
|
||||
int
|
||||
dev_is_parport(int fd)
|
||||
{
|
||||
struct stat st;
|
||||
int m;
|
||||
|
||||
if ((fstat(fd, &st) == -1) ||
|
||||
((st.st_mode & S_IFMT) != S_IFCHR) ||
|
||||
(ioctl(fd, PPGETMODE, &m) == -1))
|
||||
return(0);
|
||||
|
||||
return(1);
|
||||
}
|
||||
|
||||
#elif defined(HAVE_DEV_PPBUS_PPI_H) /* FreeBSD (ppbus/ppi) */
|
||||
|
||||
int
|
||||
dev_is_parport(int fd)
|
||||
{
|
||||
struct stat st;
|
||||
unsigned char c;
|
||||
|
||||
if ((fstat(fd, &st) == -1) ||
|
||||
((st.st_mode & S_IFMT) != S_IFCHR) ||
|
||||
(ioctl(fd, PPISSTATUS, &c) == -1))
|
||||
return(0);
|
||||
|
||||
return(1);
|
||||
}
|
||||
|
||||
#else /* Fallback (nothing) */
|
||||
|
||||
int
|
||||
dev_is_parport(int fd)
|
||||
{
|
||||
return(0);
|
||||
}
|
||||
|
||||
#endif
|
||||
/* Linux wrapper around PPFCONTROL */
|
||||
#ifdef HAVE_LINUX_PPDEV_H
|
||||
static void
|
||||
parport_control (int fd, unsigned char controlbits, int values)
|
||||
{
|
||||
struct ppdev_frob_struct frob;
|
||||
frob.mask = controlbits;
|
||||
frob.val = values;
|
||||
|
||||
if (ioctl (fd, PPFCONTROL, &frob) == -1)
|
||||
{
|
||||
fprintf(stderr, "Parallel port PPFCONTROL");
|
||||
exit (1);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* FreeBSD wrapper around PPISCTRL */
|
||||
#ifdef HAVE_DEV_PPBUS_PPI_H
|
||||
static void
|
||||
parport_control (int fd, unsigned char controlbits, int values)
|
||||
{
|
||||
unsigned char val;
|
||||
|
||||
if (ioctl (fd, PPIGCTRL, &val) == -1)
|
||||
{
|
||||
fprintf(stderr, "Parallel port PPIGCTRL");
|
||||
exit (1);
|
||||
}
|
||||
|
||||
val &= ~controlbits;
|
||||
val |= values;
|
||||
|
||||
if (ioctl (fd, PPISCTRL, &val) == -1)
|
||||
{
|
||||
fprintf(stderr, "Parallel port PPISCTRL");
|
||||
exit (1);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Initialise a parallel port, given open fd */
|
||||
int
|
||||
lp_init (int fd)
|
||||
{
|
||||
#ifdef HAVE_LINUX_PPDEV_H
|
||||
int mode;
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_LINUX_PPDEV_H
|
||||
mode = PARPORT_MODE_PCSPP;
|
||||
|
||||
if (ioctl (fd, PPSETMODE, &mode) == -1)
|
||||
{
|
||||
fprintf(stderr, "Setting parallel port mode");
|
||||
close (fd);
|
||||
return(-1);
|
||||
}
|
||||
|
||||
if (ioctl (fd, PPEXCL, NULL) == -1)
|
||||
{
|
||||
fprintf(stderr, "Parallel port is already in use.\n");
|
||||
close (fd);
|
||||
return(-1);
|
||||
}
|
||||
if (ioctl (fd, PPCLAIM, NULL) == -1)
|
||||
{
|
||||
fprintf(stderr, "Claiming parallel port.\n");
|
||||
fprintf(stderr, "HINT: did you unload the lp kernel module?");
|
||||
close (fd);
|
||||
return(-1);
|
||||
}
|
||||
|
||||
/* Enable CW & PTT - /STROBE bit (pin 1) */
|
||||
parport_control (fd, PARPORT_CONTROL_STROBE, PARPORT_CONTROL_STROBE);
|
||||
#endif
|
||||
#ifdef HAVE_DEV_PPBUS_PPI_H
|
||||
parport_control (fd, STROBE, STROBE);
|
||||
#endif
|
||||
lp_reset (fd);
|
||||
return(0);
|
||||
}
|
||||
|
||||
/* release ppdev and close port */
|
||||
int
|
||||
lp_free (int fd)
|
||||
{
|
||||
#ifdef HAVE_LINUX_PPDEV_H
|
||||
lp_reset (fd);
|
||||
|
||||
/* Disable CW & PTT - /STROBE bit (pin 1) */
|
||||
parport_control (fd, PARPORT_CONTROL_STROBE, 0);
|
||||
|
||||
ioctl (fd, PPRELEASE);
|
||||
#endif
|
||||
#ifdef HAVE_DEV_PPBUS_PPI_H
|
||||
/* Disable CW & PTT - /STROBE bit (pin 1) */
|
||||
parport_control (fd, STROBE, 0);
|
||||
#endif
|
||||
close (fd);
|
||||
return(0);
|
||||
}
|
||||
|
||||
/* set to a known state */
|
||||
int
|
||||
lp_reset (int fd)
|
||||
{
|
||||
#if defined (HAVE_LINUX_PPDEV_H) || defined (HAVE_DEV_PPBUS_PPI_H)
|
||||
lp_ptt (fd, 0);
|
||||
#endif
|
||||
return(0);
|
||||
}
|
||||
|
||||
/* SSB PTT keying - /INIT bit (pin 16) (inverted) */
|
||||
int
|
||||
lp_ptt (int fd, int onoff)
|
||||
{
|
||||
#ifdef HAVE_LINUX_PPDEV_H
|
||||
if (onoff == 1)
|
||||
parport_control (fd, PARPORT_CONTROL_INIT,
|
||||
PARPORT_CONTROL_INIT);
|
||||
else
|
||||
parport_control (fd, PARPORT_CONTROL_INIT, 0);
|
||||
#endif
|
||||
#ifdef HAVE_DEV_PPBUS_PPI_H
|
||||
if (onoff == 1)
|
||||
parport_control (fd, nINIT,
|
||||
nINIT);
|
||||
else
|
||||
parport_control (fd, nINIT, 0);
|
||||
#endif
|
||||
return(0);
|
||||
}
|
||||
|
||||
/*
|
||||
* ptt_parallel
|
||||
*
|
||||
* generic parallel unix PTT routine called indirectly from Fortran
|
||||
*
|
||||
* fd - already opened file descriptor
|
||||
* ntx - pointer to fortran command on or off
|
||||
* iptt - pointer to fortran command status on or off
|
||||
*/
|
||||
|
||||
int
|
||||
ptt_parallel(int fd, int *ntx, int *iptt)
|
||||
{
|
||||
if(*ntx) {
|
||||
lp_ptt(fd, 1);
|
||||
*iptt=1;
|
||||
} else {
|
||||
lp_ptt(fd, 0);
|
||||
*iptt=0;
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
@@ -0,0 +1,35 @@
|
||||
/* User include file for the Reed-Solomon codec
|
||||
* Copyright 2002, Phil Karn KA9Q
|
||||
* May be used under the terms of the GNU General Public License (GPL)
|
||||
*/
|
||||
|
||||
/* General purpose RS codec, 8-bit symbols */
|
||||
void encode_rs_char(void *rs,unsigned char *data,unsigned char *parity);
|
||||
int decode_rs_char(void *rs,unsigned char *data,int *eras_pos,
|
||||
int no_eras);
|
||||
void *init_rs_char(int symsize,int gfpoly,
|
||||
int fcr,int prim,int nroots,
|
||||
int pad);
|
||||
void free_rs_char(void *rs);
|
||||
|
||||
/* General purpose RS codec, integer symbols */
|
||||
void encode_rs_int(void *rs,int *data,int *parity);
|
||||
int decode_rs_int(void *rs,int *data,int *eras_pos,int no_eras);
|
||||
void *init_rs_int(int symsize,int gfpoly,int fcr,
|
||||
int prim,int nroots,int pad);
|
||||
void free_rs_int(void *rs);
|
||||
|
||||
/* CCSDS standard (255,223) RS codec with conventional (*not* dual-basis)
|
||||
* symbol representation
|
||||
*/
|
||||
void encode_rs_8(unsigned char *data,unsigned char *parity,int pad);
|
||||
int decode_rs_8(unsigned char *data,int *eras_pos,int no_eras,int pad);
|
||||
|
||||
/* CCSDS standard (255,223) RS codec with dual-basis symbol representation */
|
||||
void encode_rs_ccsds(unsigned char *data,unsigned char *parity,int pad);
|
||||
int decode_rs_ccsds(unsigned char *data,int *eras_pos,int no_eras,int pad);
|
||||
|
||||
/* Tables to map from conventional->dual (Taltab) and
|
||||
* dual->conventional (Tal1tab) bases
|
||||
*/
|
||||
extern unsigned char Taltab[],Tal1tab[];
|
||||
@@ -0,0 +1,51 @@
|
||||
subroutine scr258(isync,idat,ndir,ichan)
|
||||
|
||||
integer*1 isync(43)
|
||||
integer*1 idat(215)
|
||||
integer*1 ichan(258)
|
||||
|
||||
integer indx(258)
|
||||
data indx/ &
|
||||
-1, 1, 129, 65, 193, 33, -2, 161, 97, 17, & ! 10
|
||||
145, 81, -3, 209, 49, 177, 113, 9, -4, 137, & ! 20
|
||||
73, 201, 41, 169, -5, 105, 25, 153, 89, 57, & ! 30
|
||||
-6, 185, 121, 5, 133, 69, -7, 197, 37, 165, & ! 40
|
||||
101, 21, -8, 149, 85, 213, 53, 181, -9, 117, & ! 50
|
||||
13, 141, 77, 205, -10, 45, 173, 109, 29, 157, & ! 60
|
||||
-11, 93, 61, 189, 125, 3, -12, 131, 67, 195, & ! 70
|
||||
35, 163, -13, 99, 19, 147, 83, 211, -14, 51, & ! 80
|
||||
179, 115, 11, 139, -15, 75, 203, 43, 171, 107, & ! 90
|
||||
-16, 27, 155, 91, 59, 187, -17, 123, 7, 135, & !100
|
||||
71, 199, -18, 39, 167, 103, 23, 151, -19, 87, & !110
|
||||
215, 55, 183, 119, -20, 15, 143, 79, 207, 47, & !120
|
||||
-21, 175, 111, 31, 159, 95, -22, 63, 191, 127, & !130
|
||||
2, 130, -23, 66, 194, 34, 162, 98, -24, 18, & !140
|
||||
146, 82, 210, 50, -25, 178, 114, 10, 138, 74, & !150
|
||||
-26, 202, 42, 170, 106, 26, -27, 154, 90, 58, & !160
|
||||
186, 122, -28, 6, 134, 70, 198, 38, -29, 166, & !170
|
||||
102, 22, 150, 86, -30, 214, 54, 182, 118, 14, & !180
|
||||
-31, 142, 78, 206, 46, 174, -32, 110, 30, 158, & !190
|
||||
94, 62, -33, 190, 126, 4, 132, 68, -34, 196, & !200
|
||||
36, 164, 100, 20, -35, 148, 84, 212, 52, 180, & !210
|
||||
-36, 116, 12, 140, 76, 204, -37, 44, 172, 108, & !220
|
||||
28, 156, -38, 92, 60, 188, 124, 8, -39, 136, & !230
|
||||
72, 200, 40, 168, -40, 104, 24, 152, 88, 56, & !240
|
||||
-41, 184, 120, 16, 144, 80, -42, 208, 48, 176, & !250
|
||||
112, 32, -43, 160, 96, 64, 192, 128/
|
||||
save
|
||||
|
||||
if(ndir.gt.0) then
|
||||
do i=1,258
|
||||
j=indx(i)
|
||||
if(j.lt.0) ichan(i)=isync(-j)
|
||||
if(j.gt.0) ichan(i)=idat(j)
|
||||
enddo
|
||||
else
|
||||
do i=1,258
|
||||
j=indx(i)
|
||||
if(j.lt.0) isync(-j)=ichan(i)
|
||||
if(j.gt.0) idat(j)=ichan(i)
|
||||
enddo
|
||||
endif
|
||||
|
||||
end subroutine scr258
|
||||
@@ -0,0 +1,11 @@
|
||||
real function sec_midn()
|
||||
sec_midn=secnds(0.0)
|
||||
return
|
||||
end function sec_midn
|
||||
|
||||
subroutine sleep_msec(n)
|
||||
|
||||
call usleep(1000*n)
|
||||
|
||||
return
|
||||
end subroutine sleep_msec
|
||||
@@ -0,0 +1,31 @@
|
||||
subroutine set(a,y,n)
|
||||
real y(n)
|
||||
do i=1,n
|
||||
y(i)=a
|
||||
enddo
|
||||
return
|
||||
end
|
||||
|
||||
subroutine move(x,y,n)
|
||||
real x(n),y(n)
|
||||
do i=1,n
|
||||
y(i)=x(i)
|
||||
enddo
|
||||
return
|
||||
end
|
||||
|
||||
subroutine zero(x,n)
|
||||
real x(n)
|
||||
do i=1,n
|
||||
x(i)=0.0
|
||||
enddo
|
||||
return
|
||||
end
|
||||
|
||||
subroutine add(a,b,c,n)
|
||||
real a(n),b(n),c(n)
|
||||
do i=1,n
|
||||
c(i)=a(i)+b(i)
|
||||
enddo
|
||||
return
|
||||
end
|
||||
+32
@@ -0,0 +1,32 @@
|
||||
/*
|
||||
* sleep.h 1.0 02/03/10
|
||||
*
|
||||
* Defines cross-platform sleep, usleep, etc.
|
||||
*
|
||||
* By Wu Yongwei
|
||||
*
|
||||
*/
|
||||
|
||||
#ifndef _SLEEP_H
|
||||
#define _SLEEP_H
|
||||
|
||||
#ifdef _WIN32
|
||||
# if defined(_NEED_SLEEP_ONLY) && (defined(_MSC_VER) || defined(__MINGW32__))
|
||||
# include <stdlib.h>
|
||||
# define sleep(t) _sleep((t) * 1000)
|
||||
# else
|
||||
# include <windows.h>
|
||||
# define sleep(t) Sleep((t) * 1000)
|
||||
# endif
|
||||
# ifndef _NEED_SLEEP_ONLY
|
||||
# define msleep(t) Sleep(t)
|
||||
# define usleep(t) Sleep((t) / 1000)
|
||||
# endif
|
||||
#else
|
||||
# include <unistd.h>
|
||||
# ifndef _NEED_SLEEP_ONLY
|
||||
# define msleep(t) usleep((t) * 1000)
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#endif /* _SLEEP_H */
|
||||
@@ -0,0 +1,3 @@
|
||||
subroutine sleep_msec(n)
|
||||
return
|
||||
end subroutine sleep_msec
|
||||
@@ -0,0 +1,4 @@
|
||||
subroutine sort(n,arr)
|
||||
call ssort(arr,tmp,n,1)
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,94 @@
|
||||
subroutine spec9(c0,npts8,nsps,f0a,lagpk,fpk,i1SoftSymbols)
|
||||
|
||||
parameter (MAXFFT=31500)
|
||||
complex c0(0:npts8-1)
|
||||
real s(0:MAXFFT-1)
|
||||
real ssym(0:8,184)
|
||||
real ssymg(0:8,184)
|
||||
complex c(0:MAXFFT-1)
|
||||
integer*1 i1SoftSymbolsScrambled(207)
|
||||
integer*1 i1SoftSymbols(207)
|
||||
integer ibit(207)
|
||||
|
||||
integer*1 t1(13) !72 bits and zero tail as 8-bit bytes
|
||||
integer*4 t4(69) !Symbols from t5, values 0-7
|
||||
integer*4 mettab(0:255,0:1)
|
||||
integer*1 tmp(72)
|
||||
character*22 msg
|
||||
|
||||
integer isync(85)
|
||||
integer ii(16) !Locations of sync symbols
|
||||
data ii/1,6,11,16,21,26,31,39,45,51,57,63,69,75,81,85/
|
||||
integer ig(0:7)
|
||||
data ig/0,1,3,2,7,6,4,5/
|
||||
! data ig/0,1,3,2,6,7,5,4/
|
||||
|
||||
isync=0
|
||||
do i=1,16
|
||||
isync(ii(i))=1
|
||||
enddo
|
||||
|
||||
idt=-400
|
||||
idf=0.
|
||||
fshift=fpk-f0a + 0.1*idf
|
||||
twopi=8.0*atan(1.0)
|
||||
dphi=twopi*fshift/1500.0
|
||||
nsps8=nsps/8
|
||||
nfft=nsps8
|
||||
df=1500.0/nfft
|
||||
s=0.
|
||||
istart=lagpk*nsps8 + idt
|
||||
nsym=min((npts8-istart)/nsps8,85)
|
||||
|
||||
do j=0,nsym-1
|
||||
ia=j*nsps8 + istart
|
||||
ib=ia+nsps8-1
|
||||
c(0:nfft-1)=c0(ia:ib)
|
||||
|
||||
phi=0.
|
||||
do i=0,nfft-1
|
||||
phi=phi + dphi
|
||||
c(i)=c(i) * cmplx(cos(phi),-sin(phi))
|
||||
enddo
|
||||
|
||||
call four2a(c,nfft,1,-1,1)
|
||||
do i=0,nfft-1
|
||||
sx=real(c(i))**2 + aimag(c(i))**2
|
||||
if(i.le.8) ssym(i,1+j)=sx
|
||||
s(i)=s(i) + sx
|
||||
enddo
|
||||
enddo
|
||||
|
||||
ssymg=ssym
|
||||
do j=1,nsym
|
||||
ssym(0,j)=ssymg(0,j)
|
||||
do i=0,7
|
||||
ssym(ig(i)+1,j)=ssymg(i+1,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
m0=3
|
||||
ntones=8
|
||||
k=0
|
||||
do j=1,nsym
|
||||
if(isync(j).eq.1) cycle
|
||||
do m=m0-1,0,-1 !Get bit-wise soft symbols
|
||||
n=2**m
|
||||
r1=0.
|
||||
r2=0.
|
||||
do i=0,ntones-1
|
||||
if(iand(i,n).ne.0) then
|
||||
r1=max(r1,ssym(i+1,j))
|
||||
else
|
||||
r2=max(r2,ssym(i+1,j))
|
||||
endif
|
||||
enddo
|
||||
k=k+1
|
||||
i1SoftSymbolsScrambled(k)=min(127,max(-127,nint(10.0*(r1-r2)))) + 128
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call interleave9(i1SoftSymbolsScrambled,-1,i1SoftSymbols)
|
||||
|
||||
return
|
||||
end subroutine spec9
|
||||
@@ -0,0 +1 @@
|
||||
svn status | grep -v '?'
|
||||
+287
@@ -0,0 +1,287 @@
|
||||
subroutine ssort (x,y,n,kflag)
|
||||
c***purpose sort an array and optionally make the same interchanges in
|
||||
c an auxiliary array. the array may be sorted in increasing
|
||||
c or decreasing order. a slightly modified quicksort
|
||||
c algorithm is used.
|
||||
c
|
||||
c ssort sorts array x and optionally makes the same interchanges in
|
||||
c array y. the array x may be sorted in increasing order or
|
||||
c decreasing order. a slightly modified quicksort algorithm is used.
|
||||
c
|
||||
c description of parameters
|
||||
c x - array of values to be sorted
|
||||
c y - array to be (optionally) carried along
|
||||
c n - number of values in array x to be sorted
|
||||
c kflag - control parameter
|
||||
c = 2 means sort x in increasing order and carry y along.
|
||||
c = 1 means sort x in increasing order (ignoring y)
|
||||
c = -1 means sort x in decreasing order (ignoring y)
|
||||
c = -2 means sort x in decreasing order and carry y along.
|
||||
|
||||
integer kflag, n
|
||||
! real x(n), y(n)
|
||||
! real r, t, tt, tty, ty
|
||||
integer x(n), y(n)
|
||||
integer r, t, tt, tty, ty
|
||||
integer i, ij, j, k, kk, l, m, nn
|
||||
integer il(21), iu(21)
|
||||
|
||||
nn = n
|
||||
if (nn .lt. 1) then
|
||||
! print*,'ssort: The number of sort elements is not positive.'
|
||||
! print*,'ssort: n = ',nn,' kflag = ',kflag
|
||||
return
|
||||
endif
|
||||
c
|
||||
kk = abs(kflag)
|
||||
if (kk.ne.1 .and. kk.ne.2) then
|
||||
print *,
|
||||
+ 'the sort control parameter, k, is not 2, 1, -1, or -2.'
|
||||
return
|
||||
endif
|
||||
c
|
||||
c alter array x to get decreasing order if needed
|
||||
c
|
||||
if (kflag .le. -1) then
|
||||
do 10 i=1,nn
|
||||
x(i) = -x(i)
|
||||
10 continue
|
||||
endif
|
||||
c
|
||||
if (kk .eq. 2) go to 100
|
||||
c
|
||||
c sort x only
|
||||
c
|
||||
m = 1
|
||||
i = 1
|
||||
j = nn
|
||||
r = 0.375e0
|
||||
c
|
||||
20 if (i .eq. j) go to 60
|
||||
if (r .le. 0.5898437e0) then
|
||||
r = r+3.90625e-2
|
||||
else
|
||||
r = r-0.21875e0
|
||||
endif
|
||||
c
|
||||
30 k = i
|
||||
c
|
||||
c select a central element of the array and save it in location t
|
||||
c
|
||||
ij = i + int((j-i)*r)
|
||||
t = x(ij)
|
||||
c
|
||||
c if first element of array is greater than t, interchange with t
|
||||
c
|
||||
if (x(i) .gt. t) then
|
||||
x(ij) = x(i)
|
||||
x(i) = t
|
||||
t = x(ij)
|
||||
endif
|
||||
l = j
|
||||
c
|
||||
c if last element of array is less than than t, interchange with t
|
||||
c
|
||||
if (x(j) .lt. t) then
|
||||
x(ij) = x(j)
|
||||
x(j) = t
|
||||
t = x(ij)
|
||||
c
|
||||
c if first element of array is greater than t, interchange with t
|
||||
c
|
||||
if (x(i) .gt. t) then
|
||||
x(ij) = x(i)
|
||||
x(i) = t
|
||||
t = x(ij)
|
||||
endif
|
||||
endif
|
||||
c
|
||||
c find an element in the second half of the array which is smaller
|
||||
c than t
|
||||
c
|
||||
40 l = l-1
|
||||
if (x(l) .gt. t) go to 40
|
||||
c
|
||||
c find an element in the first half of the array which is greater
|
||||
c than t
|
||||
c
|
||||
50 k = k+1
|
||||
if (x(k) .lt. t) go to 50
|
||||
c
|
||||
c interchange these elements
|
||||
c
|
||||
if (k .le. l) then
|
||||
tt = x(l)
|
||||
x(l) = x(k)
|
||||
x(k) = tt
|
||||
go to 40
|
||||
endif
|
||||
c
|
||||
c save upper and lower subscripts of the array yet to be sorted
|
||||
c
|
||||
if (l-i .gt. j-k) then
|
||||
il(m) = i
|
||||
iu(m) = l
|
||||
i = k
|
||||
m = m+1
|
||||
else
|
||||
il(m) = k
|
||||
iu(m) = j
|
||||
j = l
|
||||
m = m+1
|
||||
endif
|
||||
go to 70
|
||||
c
|
||||
c begin again on another portion of the unsorted array
|
||||
c
|
||||
60 m = m-1
|
||||
if (m .eq. 0) go to 190
|
||||
i = il(m)
|
||||
j = iu(m)
|
||||
c
|
||||
70 if (j-i .ge. 1) go to 30
|
||||
if (i .eq. 1) go to 20
|
||||
i = i-1
|
||||
c
|
||||
80 i = i+1
|
||||
if (i .eq. j) go to 60
|
||||
t = x(i+1)
|
||||
if (x(i) .le. t) go to 80
|
||||
k = i
|
||||
c
|
||||
90 x(k+1) = x(k)
|
||||
k = k-1
|
||||
if (t .lt. x(k)) go to 90
|
||||
x(k+1) = t
|
||||
go to 80
|
||||
c
|
||||
c sort x and carry y along
|
||||
c
|
||||
100 m = 1
|
||||
i = 1
|
||||
j = nn
|
||||
r = 0.375e0
|
||||
c
|
||||
110 if (i .eq. j) go to 150
|
||||
if (r .le. 0.5898437e0) then
|
||||
r = r+3.90625e-2
|
||||
else
|
||||
r = r-0.21875e0
|
||||
endif
|
||||
c
|
||||
120 k = i
|
||||
c
|
||||
c select a central element of the array and save it in location t
|
||||
c
|
||||
ij = i + int((j-i)*r)
|
||||
t = x(ij)
|
||||
ty = y(ij)
|
||||
c
|
||||
c if first element of array is greater than t, interchange with t
|
||||
c
|
||||
if (x(i) .gt. t) then
|
||||
x(ij) = x(i)
|
||||
x(i) = t
|
||||
t = x(ij)
|
||||
y(ij) = y(i)
|
||||
y(i) = ty
|
||||
ty = y(ij)
|
||||
endif
|
||||
l = j
|
||||
c
|
||||
c if last element of array is less than t, interchange with t
|
||||
c
|
||||
if (x(j) .lt. t) then
|
||||
x(ij) = x(j)
|
||||
x(j) = t
|
||||
t = x(ij)
|
||||
y(ij) = y(j)
|
||||
y(j) = ty
|
||||
ty = y(ij)
|
||||
c
|
||||
c if first element of array is greater than t, interchange with t
|
||||
c
|
||||
if (x(i) .gt. t) then
|
||||
x(ij) = x(i)
|
||||
x(i) = t
|
||||
t = x(ij)
|
||||
y(ij) = y(i)
|
||||
y(i) = ty
|
||||
ty = y(ij)
|
||||
endif
|
||||
endif
|
||||
c
|
||||
c find an element in the second half of the array which is smaller
|
||||
c than t
|
||||
c
|
||||
130 l = l-1
|
||||
if (x(l) .gt. t) go to 130
|
||||
c
|
||||
c find an element in the first half of the array which is greater
|
||||
c than t
|
||||
c
|
||||
140 k = k+1
|
||||
if (x(k) .lt. t) go to 140
|
||||
c
|
||||
c interchange these elements
|
||||
c
|
||||
if (k .le. l) then
|
||||
tt = x(l)
|
||||
x(l) = x(k)
|
||||
x(k) = tt
|
||||
tty = y(l)
|
||||
y(l) = y(k)
|
||||
y(k) = tty
|
||||
go to 130
|
||||
endif
|
||||
c
|
||||
c save upper and lower subscripts of the array yet to be sorted
|
||||
c
|
||||
if (l-i .gt. j-k) then
|
||||
il(m) = i
|
||||
iu(m) = l
|
||||
i = k
|
||||
m = m+1
|
||||
else
|
||||
il(m) = k
|
||||
iu(m) = j
|
||||
j = l
|
||||
m = m+1
|
||||
endif
|
||||
go to 160
|
||||
c
|
||||
c begin again on another portion of the unsorted array
|
||||
c
|
||||
150 m = m-1
|
||||
if (m .eq. 0) go to 190
|
||||
i = il(m)
|
||||
j = iu(m)
|
||||
c
|
||||
160 if (j-i .ge. 1) go to 120
|
||||
if (i .eq. 1) go to 110
|
||||
i = i-1
|
||||
c
|
||||
170 i = i+1
|
||||
if (i .eq. j) go to 150
|
||||
t = x(i+1)
|
||||
ty = y(i+1)
|
||||
if (x(i) .le. t) go to 170
|
||||
k = i
|
||||
c
|
||||
180 x(k+1) = x(k)
|
||||
y(k+1) = y(k)
|
||||
k = k-1
|
||||
if (t .lt. x(k)) go to 180
|
||||
x(k+1) = t
|
||||
y(k+1) = ty
|
||||
go to 170
|
||||
c
|
||||
c clean up
|
||||
c
|
||||
190 if (kflag .le. -1) then
|
||||
do 200 i=1,nn
|
||||
x(i) = -x(i)
|
||||
200 continue
|
||||
endif
|
||||
return
|
||||
end
|
||||
+146
@@ -0,0 +1,146 @@
|
||||
subroutine symspecx(k,ntrperiod,nsps,ndiskdat,nb,nbslider,pxdb,s,f0a,df3, &
|
||||
ihsym,nzap,slimit,lstrong)
|
||||
|
||||
! Input:
|
||||
! k pointer to the most recent new data
|
||||
! ntrperiod T/R sequence length, minutes
|
||||
! nsps samples per symbol (12000 Hz)
|
||||
! ndiskdat 0/1 to indicate if data from disk
|
||||
! nb 0/1 status of noise blanker (off/on)
|
||||
! nbslider NB setting, 0-100
|
||||
|
||||
! Output:
|
||||
! pxdb power (0-60 dB)
|
||||
! s spectrum for waterfall display
|
||||
! ihsym index number of this half-symbol (1-322)
|
||||
! nzap number of samples zero'ed by noise blanker
|
||||
! slimit NB scale adjustment
|
||||
! lstrong true if strong signal at this freq
|
||||
|
||||
parameter (NMAX=1800*12000) !Total sample intervals per 30 minutes
|
||||
parameter (NDMAX=1800*1500) !Sample intervals at 1500 Hz rate
|
||||
parameter (NSMAX=22000) !Max length of saved spectra
|
||||
parameter (NFFT1=1024)
|
||||
parameter (NFFT2=1024,NFFT2A=NFFT2/8)
|
||||
parameter (MAXFFT3=32768)
|
||||
real*4 s(NSMAX),w(NFFT1),w3(MAXFFT3)
|
||||
real*4 stmp(NFFT2/2)
|
||||
real*4 x0(NFFT1),x1(NFFT1)
|
||||
real*4 x2(NFFT2)
|
||||
complex cx2(0:NFFT2/2)
|
||||
complex cx2a(NFFT2A)
|
||||
complex z,zfac
|
||||
complex zsumx
|
||||
complex cx(MAXFFT3)
|
||||
complex cx00(NFFT1)
|
||||
complex cx0(0:1023),cx1(0:1023)
|
||||
logical*1 lstrong(0:1023) !Should be (0:512)
|
||||
integer*2 id2
|
||||
complex c0
|
||||
common/jt8com/id2(NMAX),ss(184,NSMAX),savg(NSMAX),c0(NDMAX), &
|
||||
nutc,npts8,junk(20)
|
||||
equivalence (x2,cx2)
|
||||
data rms/999.0/,k0/99999999/,ntrperiod0/0/,nfft3z/0/
|
||||
save
|
||||
|
||||
if(ntrperiod.eq.1) nfft3=1024
|
||||
if(ntrperiod.eq.2) nfft3=2048
|
||||
if(ntrperiod.eq.5) nfft3=6144
|
||||
if(ntrperiod.eq.10) nfft3=12288
|
||||
if(ntrperiod.eq.30) nfft3=32768
|
||||
|
||||
jstep=nsps/16
|
||||
if(k.gt.NMAX) go to 999
|
||||
if(k.lt.nfft3) then
|
||||
ihsym=0
|
||||
go to 999 !Wait for enough samples to start
|
||||
endif
|
||||
if(nfft3.ne.nfft3z) then
|
||||
pi=4.0*atan(1.0)
|
||||
do i=1,nfft3
|
||||
w3(i)=(sin(i*pi/nfft3))**2 !Window for nfft3
|
||||
enddo
|
||||
stmp=0.
|
||||
nfft3z=nfft3
|
||||
endif
|
||||
|
||||
if(k.lt.k0) then
|
||||
ja=-2*jstep
|
||||
savg=0.
|
||||
ihsym=0
|
||||
k1=0
|
||||
k8=0
|
||||
if(ndiskdat.eq.0) id2(k+1:)=0. !### Should not be needed ??? ###
|
||||
endif
|
||||
k0=k
|
||||
|
||||
nzap=0
|
||||
sigmas=1.5*(10.0**(0.01*nbslider)) + 0.7
|
||||
peaklimit=sigmas*max(10.0,rms)
|
||||
faclim=3.0
|
||||
px=0.
|
||||
df2=12000.0/NFFT2
|
||||
|
||||
! nwindow=2
|
||||
nwindow=0 !### No windowing ###
|
||||
kstep1=NFFT1
|
||||
if(nwindow.ne.0) kstep1=NFFT1/2
|
||||
fac=1.0/(NFFT1*NFFT2)
|
||||
nblks=(k-k1)/kstep1
|
||||
do nblk=1,nblks
|
||||
do i=1,NFFT1
|
||||
x0(i)=fac*id2(k1+i)
|
||||
enddo
|
||||
call timf2x(x0,k,NFFT1,nwindow,nb,peaklimit,faclim,x1, &
|
||||
slimit,lstrong,px,nzap)
|
||||
! x1=x0
|
||||
x2=x1
|
||||
call four2a(x2,NFFT2,1,-1,0) !Second forward FFT, r2c
|
||||
|
||||
i0=nint(1000.0/df2)
|
||||
f0a=i0*df2
|
||||
cx2a(1:NFFT2A/2)=cx2(i0:NFFT2A/2+i0-1)
|
||||
cx2a(NFFT2A/2+1:NFFT2A)=cx2(i0-1-NFFT2A/2:i0-1)
|
||||
call four2a(cx2a,NFFT2A,1,1,1)
|
||||
|
||||
c0(k8+1:k8+NFFT2A)=cx2a
|
||||
npts8=k8+NFFT2A
|
||||
|
||||
!### Test for gliches at multiples of 128
|
||||
! if(k8.lt.1000) then
|
||||
! do i=k8+1,k8+NFFT2A
|
||||
! write(82,4002) i,c0(i)
|
||||
!4002 format(i8,2e12.3)
|
||||
! enddo
|
||||
! endif
|
||||
!###
|
||||
|
||||
k1=k1+kstep1
|
||||
k8=k8+kstep1/8
|
||||
enddo
|
||||
|
||||
ja=ja+jstep !Index of first sample
|
||||
if(ja.lt.0) go to 999
|
||||
do i=1,nfft3 !Copy data into cx
|
||||
cx(i)=c0(ja+i)
|
||||
enddo
|
||||
|
||||
pxdb=0.
|
||||
if(rmsx.gt.1.0) pxdb=20.0*log10(rmsx)
|
||||
if(pxdb.gt.60.0) pxdb=60.0
|
||||
|
||||
ihsym=ihsym+1
|
||||
call four2a(cx,nfft3,1,-1,1) !Third forward FFT (X)
|
||||
|
||||
n=min(184,ihsym)
|
||||
df3=1500.0/nfft3
|
||||
iz=min(NSMAX,nint(1000.0/df3))
|
||||
do i=1,iz
|
||||
sx=real(cx(i))**2 + aimag(cx(i))**2
|
||||
ss(n,i)=sx
|
||||
savg(i)=savg(i) + sx
|
||||
s(i)=sx
|
||||
enddo
|
||||
|
||||
999 return
|
||||
end subroutine symspecx
|
||||
@@ -0,0 +1,83 @@
|
||||
subroutine symspecx(k,nsps,ndiskdat,nb,nbslider,pxdb,s,ihsym, &
|
||||
nzap,slimit,lstrong)
|
||||
|
||||
! k pointer to the most recent new data
|
||||
! nsps samples per symbol (at 12000 Hz)
|
||||
! ndiskdat 0/1 to indicate if data from disk
|
||||
! nb 0/1 status of noise blanker (off/on)
|
||||
! pxdb power (0-60 dB)
|
||||
! s spectrum for waterfall display
|
||||
! ihsym index number of this half-symbol (1-322)
|
||||
! nzap number of samples zero'ed by noise blanker
|
||||
|
||||
parameter (NMAX=1800*12000) !Total sample intervals per 30 minutes
|
||||
parameter (NSMAX=10000) !Max length of saved spectra
|
||||
parameter (MAXFFT=262144) !Max length of FFTs
|
||||
integer*2 id2
|
||||
real*8 ts,hsym
|
||||
real*8 fcenter
|
||||
common/jt8com/id2(NMAX),ss(184,NSMAX),savg(NSMAX),fcenter,nutc,junk(20)
|
||||
real*4 s(NSMAX)
|
||||
real x(MAXFFT)
|
||||
complex cx(0:MAXFFT/2)
|
||||
equivalence (x,cx)
|
||||
data rms/999.0/,k0/99999999/,ntrperiod0/0/
|
||||
save
|
||||
|
||||
nfft=nsps
|
||||
hsym=nsps/2
|
||||
if(k.gt.NMAX) go to 999
|
||||
if(k.lt.nfft) then
|
||||
ihsym=0
|
||||
go to 999 !Wait for enough samples to start
|
||||
endif
|
||||
|
||||
if(k.lt.k0) then
|
||||
ts=1.d0 - hsym
|
||||
savg=0.
|
||||
ihsym=0
|
||||
k1=0
|
||||
if(ndiskdat.eq.0) id2(k+1)=0. !### Should not be needed ??? ###
|
||||
endif
|
||||
k0=k
|
||||
|
||||
nzap=0
|
||||
sigmas=1.5*(10.0**(0.01*nbslider)) + 0.7
|
||||
peaklimit=sigmas*max(10.0,rms)
|
||||
faclim=3.0
|
||||
|
||||
ts=ts+hsym
|
||||
ja=ts !Index of first sample
|
||||
jb=ja+nfft-1 !Last sample
|
||||
|
||||
i=0
|
||||
sq=0.
|
||||
do j=ja,jb !Copy data into cx, cy
|
||||
i=i+1
|
||||
x(i)=id2(j)
|
||||
sq=sq + x(i)*x(i)
|
||||
enddo
|
||||
rms=sqrt(sq/nfft)
|
||||
pxdb=0.
|
||||
if(rms.gt.1.0) pxdb=20.0*log10(rms)
|
||||
if(pxdb.gt.60.0) pxdb=60.0
|
||||
|
||||
ihsym=ihsym+1
|
||||
call four2a(x,nfft,1,-1,0) !Forward FFT of symbol length
|
||||
df=12000.0/nfft
|
||||
i0=nint(1000.0/df)
|
||||
nz=min(NSMAX,nfft/2)
|
||||
! rewind 71
|
||||
do i=1,nz
|
||||
sx=real(cx(i0+i))**2 + aimag(cx(i0+i))**2
|
||||
sx=1.e-8*sx
|
||||
s(i)=sx
|
||||
savg(i)=savg(i) + sx
|
||||
if(ihsym.le.184) ss(ihsym,i)=sx
|
||||
! write(71,3001) (i0+i-1)*df,savg(i),db(savg(i))
|
||||
!3001 format(f12.6,2f12.3)
|
||||
enddo
|
||||
! flush(71)
|
||||
|
||||
999 return
|
||||
end subroutine symspecx
|
||||
@@ -0,0 +1,47 @@
|
||||
subroutine sync9(ss,tstep,f0a,df3,lagpk,fpk)
|
||||
|
||||
parameter (NSMAX=22000) !Max length of saved spectra
|
||||
real ss(184,NSMAX)
|
||||
|
||||
integer ii0(16)
|
||||
integer ii(16) !Locations of sync half-symbols
|
||||
data ii/1,11,21,31,41,51,61,77,89,101,113,125,137,149,161,169/
|
||||
integer isync(85) !Sync vector for half-symbols
|
||||
data isync/ &
|
||||
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,1,0,0,0,0, &
|
||||
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0, &
|
||||
0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0, &
|
||||
0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0, &
|
||||
1,0,0,0,1/
|
||||
|
||||
nz=1000.0/df3
|
||||
|
||||
smax=0.
|
||||
lagmax=2.5/tstep + 0.9999
|
||||
do n=1,nz
|
||||
do lag=-lagmax,lagmax
|
||||
sum=0.
|
||||
do i=1,16
|
||||
k=ii(i) + lag
|
||||
if(k.ge.1) sum=sum + ss(k,n)
|
||||
enddo
|
||||
if(sum.gt.smax) then
|
||||
smax=sum
|
||||
npk=n
|
||||
lagpk=lag
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
fpk=f0a + (npk-1)*df3
|
||||
|
||||
do lag=-lagmax,lagmax
|
||||
sum=0.
|
||||
do i=1,16
|
||||
k=ii(i) + lag
|
||||
if(k.ge.1) sum=sum + ss(k,npk)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine sync9
|
||||
@@ -0,0 +1,36 @@
|
||||
/* 8-bit parity lookup table, generated by partab.c */
|
||||
unsigned char Partab[] = {
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
0, 1, 1, 0, 1, 0, 0, 1,
|
||||
1, 0, 0, 1, 0, 1, 1, 0,
|
||||
};
|
||||
|
||||
@@ -0,0 +1,35 @@
|
||||
program tastro
|
||||
|
||||
implicit real*8 (a-h,o-z)
|
||||
|
||||
character grid*6
|
||||
character*9 cauxra,cauxdec
|
||||
|
||||
character*12 clock(3)
|
||||
integer nt(8)
|
||||
equivalence (nt(1),nyear)
|
||||
|
||||
grid='FN20qi'
|
||||
nfreq=144
|
||||
cauxra='00:00:00'
|
||||
|
||||
10 call date_and_time(clock(1),clock(2),clock(3),nt)
|
||||
ih=ihour-ntz/60
|
||||
if(ih.le.0) then
|
||||
ih=ih+24
|
||||
nday=nday+1
|
||||
endif
|
||||
uth8=ih + imin/60.d0 + isec/3600.d0 + ims/3600000.d0
|
||||
call astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
||||
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
|
||||
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
|
||||
RaAux8,DecAux8,AzAux8,ElAux8,width1,width2,w501,w502,xlst8)
|
||||
|
||||
write(*,1010) nyear,month,nday,ih,imin,isec,AzMoon8,ElMoon8, &
|
||||
AzSun8,ElSun8,ndop,dgrd8,ntsky
|
||||
1010 format(i4,i3,i3,i4.2,':',i2.2,':',i2.2,4f8.1,i6,f6.1,i6)
|
||||
|
||||
call system('sleep 1')
|
||||
go to 10
|
||||
|
||||
end program tastro
|
||||
+110
@@ -0,0 +1,110 @@
|
||||
subroutine timer(dname,k)
|
||||
|
||||
! Times procedure number n between a call with k=0 (tstart) and with
|
||||
! k=1 (tstop). Accumulates sums of these times in array ut (user time).
|
||||
! Also traces all calls (for debugging purposes) if limtrace.gt.0
|
||||
|
||||
character*8 dname,name(50),space,ename
|
||||
character*16 sname
|
||||
logical on(50)
|
||||
real ut(50),ut0(50),dut(50),tt(2)
|
||||
integer ncall(50),nlevel(50),nparent(50)
|
||||
integer onlevel(0:10)
|
||||
common/tracer/ limtrace,lu
|
||||
data eps/0.000001/,ntrace/0/
|
||||
data level/0/,nmax/0/,space/' '/
|
||||
data limtrace/0/,lu/-1/
|
||||
save
|
||||
|
||||
if(limtrace.lt.0) go to 999
|
||||
if(lu.lt.1) lu=6
|
||||
if(k.gt.1) go to 40 !Check for "all done" (k>1)
|
||||
onlevel(0)=0
|
||||
|
||||
do n=1,nmax !Check for existing name
|
||||
if(name(n).eq.dname) go to 20
|
||||
enddo
|
||||
|
||||
nmax=nmax+1 !This is a new one
|
||||
n=nmax
|
||||
ncall(n)=0
|
||||
on(n)=.false.
|
||||
ut(n)=eps
|
||||
name(n)=dname
|
||||
|
||||
20 if(k.eq.0) then !Get start times (k=0)
|
||||
if(on(n)) print*,'Error in timer: ',dname,' already on.'
|
||||
level=level+1 !Increment the level
|
||||
on(n)=.true.
|
||||
ut0(n)=etime(tt)
|
||||
ncall(n)=ncall(n)+1
|
||||
if(ncall(n).gt.1.and.nlevel(n).ne.level) then
|
||||
nlevel(n)=-1
|
||||
else
|
||||
nlevel(n)=level
|
||||
endif
|
||||
nparent(n)=onlevel(level-1)
|
||||
onlevel(level)=n
|
||||
|
||||
else if(k.eq.1) then !Get stop times and accumulate sums. (k=1)
|
||||
if(on(n)) then
|
||||
on(n)=.false.
|
||||
ut1=etime(tt)
|
||||
ut(n)=ut(n)+ut1-ut0(n)
|
||||
endif
|
||||
level=level-1
|
||||
endif
|
||||
|
||||
ntrace=ntrace+1
|
||||
if(ntrace.lt.limtrace) write(lu,1020) ntrace,dname,k,level,nparent(n)
|
||||
1020 format(i8,': ',a8,3i5)
|
||||
go to 998
|
||||
|
||||
! Write out the timer statistics
|
||||
|
||||
40 write(lu,1040)
|
||||
1040 format(/' name time frac dtime', &
|
||||
' dfrac calls level parent'/73('-'))
|
||||
|
||||
if(k.gt.100) then
|
||||
ndiv=k-100
|
||||
do i=1,nmax
|
||||
ncall(i)=ncall(i)/ndiv
|
||||
ut(i)=ut(i)/ndiv
|
||||
enddo
|
||||
endif
|
||||
|
||||
total=ut(1)
|
||||
sum=0.
|
||||
sumf=0.
|
||||
do i=1,nmax
|
||||
dut(i)=ut(i)
|
||||
do j=i,nmax
|
||||
if(nparent(j).eq.i) dut(i)=dut(i)-ut(j)
|
||||
enddo
|
||||
utf=ut(i)/total
|
||||
dutf=dut(i)/total
|
||||
sum=sum+dut(i)
|
||||
sumf=sumf+dutf
|
||||
kk=nlevel(i)
|
||||
sname=space(1:kk)//name(i)//space(1:8-kk)
|
||||
ename=space
|
||||
if(i.ge.2) ename=name(nparent(i))
|
||||
write(lu,1060) float(i),sname,ut(i),utf,dut(i),dutf, &
|
||||
ncall(i),nlevel(i),ename
|
||||
1060 format(f4.0,a16,2(f10.2,f6.2),i7,i5,2x,a8)
|
||||
enddo
|
||||
|
||||
write(lu,1070) sum,sumf
|
||||
1070 format(/36x,f10.2,f6.2)
|
||||
nmax=0
|
||||
eps=0.000001
|
||||
ntrace=0
|
||||
level=0
|
||||
space=' '
|
||||
onlevel(0)=0
|
||||
|
||||
998 flush(lu)
|
||||
|
||||
999 return
|
||||
end subroutine timer
|
||||
@@ -0,0 +1,74 @@
|
||||
/*
|
||||
* timeval.h 1.0 01/12/19
|
||||
*
|
||||
* Defines gettimeofday, timeval, etc. for Win32
|
||||
*
|
||||
* By Wu Yongwei
|
||||
*
|
||||
*/
|
||||
|
||||
#ifndef _TIMEVAL_H
|
||||
#define _TIMEVAL_H
|
||||
|
||||
#ifdef _WIN32
|
||||
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#include <windows.h>
|
||||
#include <time.h>
|
||||
|
||||
#ifndef __GNUC__
|
||||
#define EPOCHFILETIME (116444736000000000i64)
|
||||
#else
|
||||
#define EPOCHFILETIME (116444736000000000LL)
|
||||
#endif
|
||||
|
||||
//struct timeval {
|
||||
// long tv_sec; /* seconds */
|
||||
// long tv_usec; /* microseconds */
|
||||
//};
|
||||
|
||||
struct timezone {
|
||||
int tz_minuteswest; /* minutes W of Greenwich */
|
||||
int tz_dsttime; /* type of dst correction */
|
||||
};
|
||||
|
||||
__inline int gettimeofday(struct timeval *tv, struct timezone *tz)
|
||||
{
|
||||
FILETIME ft;
|
||||
LARGE_INTEGER li;
|
||||
__int64 t;
|
||||
static int tzflag;
|
||||
|
||||
if (tv)
|
||||
{
|
||||
GetSystemTimeAsFileTime(&ft);
|
||||
li.LowPart = ft.dwLowDateTime;
|
||||
li.HighPart = ft.dwHighDateTime;
|
||||
t = li.QuadPart; /* In 100-nanosecond intervals */
|
||||
t -= EPOCHFILETIME; /* Offset to the Epoch time */
|
||||
t /= 10; /* In microseconds */
|
||||
tv->tv_sec = (long)(t / 1000000);
|
||||
tv->tv_usec = (long)(t % 1000000);
|
||||
}
|
||||
|
||||
if (tz)
|
||||
{
|
||||
if (!tzflag)
|
||||
{
|
||||
_tzset();
|
||||
tzflag++;
|
||||
}
|
||||
tz->tz_minuteswest = _timezone / 60;
|
||||
tz->tz_dsttime = _daylight;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
#else /* _WIN32 */
|
||||
|
||||
#include <sys/time.h>
|
||||
|
||||
#endif /* _WIN32 */
|
||||
|
||||
#endif /* _TIMEVAL_H */
|
||||
+225
@@ -0,0 +1,225 @@
|
||||
subroutine timf2(k,nxpol,nfft,nwindow,nb,peaklimit,iqadjust,iqapply,faclim, &
|
||||
cx0,cy0,gainx,gainy,phasex,phasey,cx1,cy1,slimit,lstrong,px,py,nzap)
|
||||
|
||||
! Sequential processing of time-domain I/Q data, using Linrad-like
|
||||
! "first FFT" and "first backward FFT".
|
||||
|
||||
! cx0,cy0 - complex input data
|
||||
! nfft - length of FFTs
|
||||
! nwindow - 0 for no window, 2 for sin^2 window
|
||||
! iqapply - 0/1 determines if I/Q phase and amplitude corrections applied
|
||||
! gainx,y - gain error in Q channel, relative to I
|
||||
! phasex,y - phase error
|
||||
! cx1,cy1 - output data
|
||||
|
||||
! Non-windowed processing means no overlap, so kstep=nfft.
|
||||
! Sin^2 window has 50% overlap, kstep=nfft/2.
|
||||
|
||||
! Frequencies with strong signals are identified and separated. The back
|
||||
! transforms are done separately for weak and strong signals, so that
|
||||
! noise blanking can be applied to the weak-signal portion. Strong and
|
||||
! weak are finally re-combined in the time domain.
|
||||
|
||||
parameter (MAXFFT=1024,MAXNH=MAXFFT/2)
|
||||
parameter (MAXSIGS=100)
|
||||
complex cx0(0:nfft-1),cx1(0:nfft-1)
|
||||
complex cy0(0:nfft-1),cy1(0:nfft-1)
|
||||
complex cx(0:MAXFFT-1),cxt(0:MAXFFT-1)
|
||||
complex cy(0:MAXFFT-1),cyt(0:MAXFFT-1)
|
||||
complex cxs(0:MAXFFT-1),covxs(0:MAXNH-1) !Strong X signals
|
||||
complex cys(0:MAXFFT-1),covys(0:MAXNH-1) !Strong Y signals
|
||||
complex cxw(0:MAXFFT-1),covxw(0:MAXNH-1) !Weak X signals
|
||||
complex cyw(0:MAXFFT-1),covyw(0:MAXNH-1) !Weak Y signals
|
||||
real*4 w(0:MAXFFT-1)
|
||||
real*4 s(0:MAXFFT-1),stmp(0:MAXFFT-1)
|
||||
logical*1 lstrong(0:MAXFFT-1),lprev
|
||||
integer ia(MAXSIGS),ib(MAXSIGS)
|
||||
complex h,u,v
|
||||
logical first
|
||||
data first/.true./
|
||||
data k0/99999999/
|
||||
save w,covxs,covxw,covys,covyw,s,ntc,ntot,nh,kstep,fac,first,k0
|
||||
|
||||
if(first) then
|
||||
pi=4.0*atan(1.0)
|
||||
do i=0,nfft-1
|
||||
w(i)=(sin(i*pi/nfft))**2
|
||||
enddo
|
||||
s=0.
|
||||
ntc=0
|
||||
ntot=0
|
||||
nh=nfft/2
|
||||
kstep=nfft
|
||||
if(nwindow.eq.2) kstep=nh
|
||||
fac=1.0/nfft
|
||||
slimit=1.e30
|
||||
first=.false.
|
||||
endif
|
||||
|
||||
if(k.lt.k0) then
|
||||
covxs=0.
|
||||
covxw=0.
|
||||
covys=0.
|
||||
covyw=0.
|
||||
endif
|
||||
k0=k
|
||||
|
||||
cx(0:nfft-1)=cx0
|
||||
if(nwindow.eq.2) cx(0:nfft-1)=w(0:nfft-1)*cx(0:nfft-1)
|
||||
call four2a(cx,nfft,1,1,1) !First forward FFT
|
||||
|
||||
if(nxpol.ne.0) then
|
||||
cy(0:nfft-1)=cy0
|
||||
if(nwindow.eq.2) cy(0:nfft-1)=w(0:nfft-1)*cy(0:nfft-1)
|
||||
call four2a(cy,nfft,1,1,1) !First forward FFT
|
||||
endif
|
||||
|
||||
if(iqapply.ne.0) then !Apply I/Q corrections
|
||||
h=gainx*cmplx(cos(phasex),sin(phasex))
|
||||
v=0.
|
||||
do i=0,nfft-1
|
||||
u=cx(i)
|
||||
if(i.gt.0) v=cx(nfft-i)
|
||||
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
|
||||
(real(u) - real(v))*real(h)
|
||||
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
|
||||
(real(u) - real(v))*aimag(h)
|
||||
cxt(i)=0.5*cmplx(x,y)
|
||||
enddo
|
||||
else
|
||||
cxt(0:nfft-1)=cx(0:nfft-1)
|
||||
endif
|
||||
|
||||
if(nxpol.ne.0) then
|
||||
if(iqapply.ne.0) then !Apply I/Q corrections
|
||||
h=gainy*cmplx(cos(phasey),sin(phasey))
|
||||
v=0.
|
||||
do i=0,nfft-1
|
||||
u=cy(i)
|
||||
if(i.gt.0) v=cy(nfft-i)
|
||||
x=real(u) + real(v) - (aimag(u) + aimag(v))*aimag(h) + &
|
||||
(real(u) - real(v))*real(h)
|
||||
y=aimag(u) - aimag(v) + (aimag(u) + aimag(v))*real(h) + &
|
||||
(real(u) - real(v))*aimag(h)
|
||||
cyt(i)=0.5*cmplx(x,y)
|
||||
enddo
|
||||
else
|
||||
cyt(0:nfft-1)=cy(0:nfft-1)
|
||||
endif
|
||||
endif
|
||||
|
||||
! Identify frequencies with strong signals, copy frequency-domain
|
||||
! data into array cs (strong) or cw (weak).
|
||||
|
||||
ntot=ntot+1
|
||||
if(mod(ntot,128).eq.5) then
|
||||
call pctile(s,stmp,1024,50,xmedian)
|
||||
slimit=faclim*xmedian
|
||||
endif
|
||||
|
||||
if(ntc.lt.96000/nfft) ntc=ntc+1
|
||||
uu=1.0/ntc
|
||||
smax=0.
|
||||
do i=0,nfft-1
|
||||
p=real(cxt(i))**2 + aimag(cxt(i))**2
|
||||
if(nxpol.ne.0) p=p + real(cyt(i))**2 + aimag(cyt(i))**2
|
||||
s(i)=(1.0-uu)*s(i) + uu*p
|
||||
lstrong(i)=(s(i).gt.slimit)
|
||||
if(s(i).gt.smax) smax=s(i)
|
||||
enddo
|
||||
|
||||
nsigs=0
|
||||
lprev=.false.
|
||||
iwid=1
|
||||
ib=-99
|
||||
do i=0,nfft-1
|
||||
if(lstrong(i) .and. (.not.lprev)) then
|
||||
if(nsigs.lt.MAXSIGS) nsigs=nsigs+1
|
||||
ia(nsigs)=i-iwid
|
||||
if(ia(nsigs).lt.0) ia(nsigs)=0
|
||||
endif
|
||||
if(.not.lstrong(i) .and. lprev) then
|
||||
ib(nsigs)=i-1+iwid
|
||||
if(ib(nsigs).gt.nfft-1) ib(nsigs)=nfft-1
|
||||
endif
|
||||
lprev=lstrong(i)
|
||||
enddo
|
||||
|
||||
if(nsigs.gt.0) then
|
||||
do i=1,nsigs
|
||||
ja=ia(i)
|
||||
jb=ib(i)
|
||||
if(ja.lt.0 .or. ja.gt.nfft-1 .or. jb.lt.0 .or. jb.gt.nfft-1) then
|
||||
cycle
|
||||
endif
|
||||
if(jb.eq.-99) jb=ja + min(2*iwid,nfft-1)
|
||||
lstrong(ja:jb)=.true.
|
||||
enddo
|
||||
endif
|
||||
|
||||
do i=0,nfft-1
|
||||
if(lstrong(i)) then
|
||||
cxs(i)=fac*cxt(i)
|
||||
cxw(i)=0.
|
||||
if(nxpol.ne.0) then
|
||||
cys(i)=fac*cyt(i)
|
||||
cyw(i)=0.
|
||||
endif
|
||||
else
|
||||
cxw(i)=fac*cxt(i)
|
||||
cxs(i)=0.
|
||||
if(nxpol.ne.0) then
|
||||
cyw(i)=fac*cyt(i)
|
||||
cys(i)=0.
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
|
||||
call four2a(cxw,nfft,1,-1,1) !Transform weak and strong X
|
||||
call four2a(cxs,nfft,1,-1,1) !back to time domain, separately
|
||||
|
||||
if(nxpol.ne.0) then
|
||||
call four2a(cyw,nfft,1,-1,1) !Transform weak and strong Y
|
||||
call four2a(cys,nfft,1,-1,1) !back to time domain, separately
|
||||
endif
|
||||
|
||||
if(nwindow.eq.2) then
|
||||
cxw(0:nh-1)=cxw(0:nh-1)+covxw(0:nh-1) !Add previous segment's 2nd half
|
||||
covxw(0:nh-1)=cxw(nh:nfft-1) !Save 2nd half
|
||||
cxs(0:nh-1)=cxs(0:nh-1)+covxs(0:nh-1) !Ditto for strong signals
|
||||
covxs(0:nh-1)=cxs(nh:nfft-1)
|
||||
|
||||
if(nxpol.ne.0) then
|
||||
cyw(0:nh-1)=cyw(0:nh-1)+covyw(0:nh-1) !Add previous segment's 2nd half
|
||||
covyw(0:nh-1)=cyw(nh:nfft-1) !Save 2nd half
|
||||
cys(0:nh-1)=cys(0:nh-1)+covys(0:nh-1) !Ditto for strong signals
|
||||
covys(0:nh-1)=cys(nh:nfft-1)
|
||||
endif
|
||||
endif
|
||||
|
||||
! Apply noise blanking to weak data
|
||||
if(nb.ne.0) then
|
||||
do i=0,kstep-1
|
||||
peak=abs(cxw(i))
|
||||
if(nxpol.ne.0) peak=max(peak,abs(cyw(i)))
|
||||
if(peak.gt.peaklimit) then
|
||||
cxw(i)=0.
|
||||
if(nxpol.ne.0) cyw(i)=0.
|
||||
nzap=nzap+1
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
! Compute power levels from weak data only
|
||||
do i=0,kstep-1
|
||||
px=px + real(cxw(i))**2 + aimag(cxw(i))**2
|
||||
if(nxpol.ne.0) py=py + real(cyw(i))**2 + aimag(cyw(i))**2
|
||||
enddo
|
||||
|
||||
cx1(0:kstep-1)=cxw(0:kstep-1) + cxs(0:kstep-1) !Recombine weak + strong
|
||||
if(nxpol.ne.0) then
|
||||
cy1(0:kstep-1)=cyw(0:kstep-1) + cys(0:kstep-1) !Weak + strong
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine timf2
|
||||
+154
@@ -0,0 +1,154 @@
|
||||
subroutine timf2x(x0,k,nfft,nwindow,nb,peaklimit,faclim,x1, &
|
||||
slimit,lstrong,px,nzap)
|
||||
|
||||
! Sequential processing of time-domain I/Q data, using Linrad-like
|
||||
! "first FFT" and "first backward FFT", treating frequencies with
|
||||
! strong signals differently. Noise blanking is applied to weak
|
||||
! signals only.
|
||||
|
||||
! x0 - real input data
|
||||
! nfft - length of FFTs
|
||||
! nwindow - 0 for no window, 2 for sin^2 window
|
||||
! x1 - real output data
|
||||
|
||||
! Non-windowed processing means no overlap, so kstep=nfft.
|
||||
! Sin^2 window has 50% overlap, kstep=nfft/2.
|
||||
|
||||
! Frequencies with strong signals are identified and separated. Back
|
||||
! transforms are done separately for weak and strong signals, so that
|
||||
! noise blanking can be applied to the weak-signal portion. Strong and
|
||||
! weak are finally re-combined, in the time domain.
|
||||
|
||||
parameter (MAXFFT=1024,MAXNH=MAXFFT/2)
|
||||
parameter (MAXSIGS=100)
|
||||
real x0(0:nfft-1),x1(0:nfft-1)
|
||||
real x(0:MAXFFT-1),xw(0:MAXFFT-1),xs(0:MAXFFT-1)
|
||||
real xwov(0:MAXNH-1),xsov(0:MAXNH-1)
|
||||
complex cx(0:MAXFFT-1),cxt(0:MAXFFT-1)
|
||||
complex cxs(0:MAXFFT-1) !Strong signals
|
||||
complex cxw(0:MAXFFT-1) !Weak signals
|
||||
real*4 w(0:MAXFFT-1)
|
||||
real*4 s(0:MAXNH),stmp(0:MAXNH)
|
||||
logical*1 lstrong(0:MAXNH),lprev
|
||||
integer ia(MAXSIGS),ib(MAXSIGS)
|
||||
logical first
|
||||
equivalence (x,cx),(xw,cxw),(xs,cxs)
|
||||
data first/.true./
|
||||
data k0/99999999/
|
||||
save w,xsov,xwov,s,ntc,ntot,nh,kstep,fac,first,k0
|
||||
|
||||
if(first) then
|
||||
pi=4.0*atan(1.0)
|
||||
do i=0,nfft-1
|
||||
w(i)=(sin(i*pi/nfft))**2
|
||||
enddo
|
||||
s=0.
|
||||
ntc=0
|
||||
ntot=0
|
||||
nh=nfft/2
|
||||
kstep=nfft
|
||||
if(nwindow.eq.2) kstep=nh
|
||||
fac=1.0/nfft
|
||||
slimit=1.e30
|
||||
first=.false.
|
||||
endif
|
||||
|
||||
if(k.lt.k0) then
|
||||
xsov=0.
|
||||
xwov=0.
|
||||
endif
|
||||
k0=k
|
||||
|
||||
x(0:nfft-1)=x0
|
||||
if(nwindow.eq.2) x(0:nfft-1)=w(0:nfft-1)*x(0:nfft-1)
|
||||
call four2a(x,nfft,1,-1,0) !First forward FFT, r2c
|
||||
cxt(0:nh)=cx(0:nh)
|
||||
|
||||
! Identify frequencies with strong signals.
|
||||
|
||||
ntot=ntot+1
|
||||
if(mod(ntot,128).eq.5) then
|
||||
call pctile(s,stmp,nh,50,xmedian)
|
||||
slimit=faclim*xmedian
|
||||
endif
|
||||
|
||||
if(ntc.lt.12000/nfft) ntc=ntc+1
|
||||
uu=1.0/ntc
|
||||
smax=0.
|
||||
do i=0,nh
|
||||
p=real(cxt(i))**2 + aimag(cxt(i))**2
|
||||
s(i)=(1.0-uu)*s(i) + uu*p
|
||||
lstrong(i)=(s(i).gt.slimit)
|
||||
if(s(i).gt.smax) smax=s(i)
|
||||
enddo
|
||||
|
||||
nsigs=0
|
||||
lprev=.false.
|
||||
iwid=1
|
||||
ib=-99
|
||||
do i=0,nh
|
||||
if(lstrong(i) .and. (.not.lprev)) then
|
||||
if(nsigs.lt.MAXSIGS) nsigs=nsigs+1
|
||||
ia(nsigs)=i-iwid
|
||||
if(ia(nsigs).lt.0) ia(nsigs)=0
|
||||
endif
|
||||
if(.not.lstrong(i) .and. lprev) then
|
||||
ib(nsigs)=i-1+iwid
|
||||
if(ib(nsigs).gt.nh) ib(nsigs)=nh
|
||||
endif
|
||||
lprev=lstrong(i)
|
||||
enddo
|
||||
|
||||
if(nsigs.gt.0) then
|
||||
do i=1,nsigs
|
||||
ja=ia(i)
|
||||
jb=ib(i)
|
||||
if(ja.lt.0 .or. ja.gt.nh .or. jb.lt.0 .or. jb.gt.nh) then
|
||||
cycle
|
||||
endif
|
||||
if(jb.eq.-99) jb=ja + min(2*iwid,nh)
|
||||
lstrong(ja:jb)=.true.
|
||||
enddo
|
||||
endif
|
||||
|
||||
! Copy frequency-domain data into array cs (strong) or cw (weak).
|
||||
do i=0,nh
|
||||
if(lstrong(i)) then
|
||||
cxs(i)=fac*cxt(i)
|
||||
cxw(i)=0.
|
||||
else
|
||||
cxw(i)=fac*cxt(i)
|
||||
cxs(i)=0.
|
||||
endif
|
||||
enddo
|
||||
|
||||
call four2a(cxw,nfft,1,1,-1) !Transform weak and strong back
|
||||
call four2a(cxs,nfft,1,1,-1) !to time domain, separately (c2r)
|
||||
|
||||
if(nwindow.eq.2) then
|
||||
xw(0:nh-1)=xw(0:nh-1)+xwov(0:nh-1) !Add previous segment's 2nd half
|
||||
xwov(0:nh-1)=xw(nh:nfft-1) !Save 2nd half
|
||||
xs(0:nh-1)=xs(0:nh-1)+xsov(0:nh-1) !Ditto for strong signals
|
||||
xsov(0:nh-1)=xs(nh:nfft-1)
|
||||
endif
|
||||
|
||||
! Apply noise blanking to weak data
|
||||
if(nb.ne.0) then
|
||||
do i=0,kstep-1
|
||||
peak=abs(xw(i))
|
||||
if(peak.gt.peaklimit) then
|
||||
xw(i)=0.
|
||||
nzap=nzap+1
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
! Compute power levels from weak data only
|
||||
do i=0,kstep-1
|
||||
px=px + xw(i)*xw(i)
|
||||
enddo
|
||||
|
||||
x1(0:kstep-1)=xw(0:kstep-1) + xs(0:kstep-1) !Recombine weak + strong
|
||||
|
||||
return
|
||||
end subroutine timf2x
|
||||
@@ -0,0 +1,28 @@
|
||||
subroutine trimlist(sig,km,ftol,indx,nsiz,nz)
|
||||
|
||||
parameter (MAXMSG=1000) !Size of decoded message list
|
||||
real sig(MAXMSG,30)
|
||||
integer indx(MAXMSG),nsiz(MAXMSG)
|
||||
|
||||
C 1 2 3 4 5 6 7 8
|
||||
C nfile nutc freq snr dt ipol flip sync
|
||||
|
||||
call indexx(km,sig(1,3),indx) !Sort list by frequency
|
||||
|
||||
n=1
|
||||
i0=1
|
||||
do i=2,km
|
||||
j0=indx(i-1)
|
||||
j=indx(i)
|
||||
if(sig(j,3)-sig(j0,3).gt.ftol) then
|
||||
nsiz(n)=i-i0
|
||||
i0=i
|
||||
n=n+1
|
||||
endif
|
||||
enddo
|
||||
nz=n
|
||||
nsiz(nz)=km+1-i0
|
||||
nsiz(nz+1)=-1
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,24 @@
|
||||
subroutine unpackbits(sym,nsymd,m0,dbits)
|
||||
|
||||
! Unpack bits from sym() into dbits(), one bit per byte.
|
||||
! NB: nsymd is the number of input words, and m0 their length.
|
||||
! there will be m0*nsymd output bytes, each 0 or 1.
|
||||
|
||||
integer sym(nsymd)
|
||||
integer*1 dbits(*)
|
||||
integer*1 n1
|
||||
equivalence (n,n1)
|
||||
|
||||
k=0
|
||||
do i=1,nsymd
|
||||
mask=ishft(1,m0-1)
|
||||
do j=1,m0
|
||||
k=k+1
|
||||
dbits(k)=0
|
||||
if(iand(mask,sym(i)).ne.0) dbits(k)=1
|
||||
mask=ishft(mask,-1)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine unpackbits
|
||||
@@ -0,0 +1,142 @@
|
||||
subroutine unpackcall(ncall,word,iv2,psfx)
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
character word*12,c*37,psfx*4
|
||||
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
|
||||
|
||||
n=ncall
|
||||
iv2=0
|
||||
if(n.ge.262177560) go to 20
|
||||
word='......'
|
||||
if(n.ge.262177560) go to 999 !Plain text message ...
|
||||
i=mod(n,27)+11
|
||||
word(6:6)=c(i:i)
|
||||
n=n/27
|
||||
i=mod(n,27)+11
|
||||
word(5:5)=c(i:i)
|
||||
n=n/27
|
||||
i=mod(n,27)+11
|
||||
word(4:4)=c(i:i)
|
||||
n=n/27
|
||||
i=mod(n,10)+1
|
||||
word(3:3)=c(i:i)
|
||||
n=n/10
|
||||
i=mod(n,36)+1
|
||||
word(2:2)=c(i:i)
|
||||
n=n/36
|
||||
i=n+1
|
||||
word(1:1)=c(i:i)
|
||||
do i=1,4
|
||||
if(word(i:i).ne.' ') go to 10
|
||||
enddo
|
||||
go to 999
|
||||
10 word=word(i:)
|
||||
go to 999
|
||||
|
||||
20 if(n.ge.267796946) go to 999
|
||||
|
||||
! We have a JT65v2 message
|
||||
if((n.ge.262178563) .and. (n.le.264002071)) Then
|
||||
! CQ with prefix
|
||||
iv2=1
|
||||
n=n-262178563
|
||||
i=mod(n,37)+1
|
||||
psfx(4:4)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(3:3)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(2:2)=c(i:i)
|
||||
n=n/37
|
||||
i=n+1
|
||||
psfx(1:1)=c(i:i)
|
||||
endif
|
||||
|
||||
if((n.ge.264002072) .and. (n.le.265825580)) Then
|
||||
! QRZ with prefix
|
||||
iv2=2
|
||||
n=n-264002072
|
||||
i=mod(n,37)+1
|
||||
psfx(4:4)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(3:3)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(2:2)=c(i:i)
|
||||
n=n/37
|
||||
i=n+1
|
||||
psfx(1:1)=c(i:i)
|
||||
endif
|
||||
|
||||
if((n.ge.265825581) .and. (n.le.267649089)) Then
|
||||
! DE with prefix
|
||||
iv2=3
|
||||
n=n-265825581
|
||||
i=mod(n,37)+1
|
||||
psfx(4:4)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(3:3)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(2:2)=c(i:i)
|
||||
n=n/37
|
||||
i=n+1
|
||||
psfx(1:1)=c(i:i)
|
||||
endif
|
||||
|
||||
if((n.ge.267649090) .and. (n.le.267698374)) Then
|
||||
! CQ with suffix
|
||||
iv2=4
|
||||
n=n-267649090
|
||||
i=mod(n,37)+1
|
||||
psfx(3:3)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(2:2)=c(i:i)
|
||||
n=n/37
|
||||
i=n+1
|
||||
psfx(1:1)=c(i:i)
|
||||
endif
|
||||
|
||||
if((n.ge.267698375) .and. (n.le.267747659)) Then
|
||||
! QRZ with suffix
|
||||
iv2=5
|
||||
n=n-267698375
|
||||
i=mod(n,37)+1
|
||||
psfx(3:3)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(2:2)=c(i:i)
|
||||
n=n/37
|
||||
i=n+1
|
||||
psfx(1:1)=c(i:i)
|
||||
endif
|
||||
|
||||
if((n.ge.267747660) .and. (n.le.267796944)) Then
|
||||
! DE with suffix
|
||||
iv2=6
|
||||
n=n-267747660
|
||||
i=mod(n,37)+1
|
||||
psfx(3:3)=c(i:i)
|
||||
n=n/37
|
||||
i=mod(n,37)+1
|
||||
psfx(2:2)=c(i:i)
|
||||
n=n/37
|
||||
i=n+1
|
||||
psfx(1:1)=c(i:i)
|
||||
endif
|
||||
|
||||
if(n.eq.267796945) Then
|
||||
! DE with no prefix or suffix
|
||||
iv2=7
|
||||
psfx = ' '
|
||||
endif
|
||||
|
||||
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
|
||||
|
||||
return
|
||||
end
|
||||
@@ -0,0 +1,32 @@
|
||||
subroutine unpackgrid(ng,grid)
|
||||
|
||||
parameter (NGBASE=180*180)
|
||||
character grid*4,grid6*6
|
||||
|
||||
grid=' '
|
||||
if(ng.ge.32400) go to 10
|
||||
dlat=mod(ng,180)-90
|
||||
dlong=(ng/180)*2 - 180 + 2
|
||||
call deg2grid(dlong,dlat,grid6)
|
||||
grid=grid6(:4)
|
||||
go to 100
|
||||
|
||||
10 n=ng-NGBASE-1
|
||||
if(n.ge.1 .and.n.le.30) then
|
||||
write(grid,1012) -n
|
||||
1012 format(i3.2)
|
||||
else if(n.ge.31 .and.n.le.60) then
|
||||
n=n-30
|
||||
write(grid,1022) -n
|
||||
1022 format('R',i3.2)
|
||||
else if(n.eq.61) then
|
||||
grid='RO'
|
||||
else if(n.eq.62) then
|
||||
grid='RRR'
|
||||
else if(n.eq.63) then
|
||||
grid='73'
|
||||
endif
|
||||
|
||||
100 return
|
||||
end
|
||||
|
||||
+100
@@ -0,0 +1,100 @@
|
||||
subroutine unpackmsg(dat,msg)
|
||||
|
||||
parameter (NBASE=37*36*10*27*27*27)
|
||||
parameter (NGBASE=180*180)
|
||||
integer dat(12)
|
||||
character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4
|
||||
logical cqnnn
|
||||
|
||||
cqnnn=.false.
|
||||
nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+
|
||||
+ ishft(dat(4),4) + iand(ishft(dat(5),-2),15)
|
||||
|
||||
nc2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) +
|
||||
+ ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) +
|
||||
+ iand(ishft(dat(10),-4),3)
|
||||
|
||||
ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12)
|
||||
|
||||
if(ng.gt.32768) then
|
||||
call unpacktext(nc1,nc2,ng,msg)
|
||||
go to 100
|
||||
endif
|
||||
|
||||
call unpackcall(nc1,c1,iv2,psfx)
|
||||
if(iv2.eq.0) then
|
||||
! This is an "original JT65" message
|
||||
if(nc1.eq.NBASE+1) c1='CQ '
|
||||
if(nc1.eq.NBASE+2) c1='QRZ '
|
||||
nfreq=nc1-NBASE-3
|
||||
if(nfreq.ge.0 .and. nfreq.le.999) then
|
||||
write(c1,1002) nfreq
|
||||
1002 format('CQ ',i3.3)
|
||||
cqnnn=.true.
|
||||
endif
|
||||
endif
|
||||
|
||||
call unpackcall(nc2,c2,junk1,junk2)
|
||||
call unpackgrid(ng,grid)
|
||||
|
||||
if(iv2.gt.0) then
|
||||
! This is a JT65v2 message
|
||||
n1=len_trim(psfx)
|
||||
n2=len_trim(c2)
|
||||
if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
|
||||
if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
|
||||
if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid
|
||||
if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
|
||||
if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
|
||||
if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid
|
||||
if(iv2.eq.7) msg='DE '//c2(:n2)//' '//grid
|
||||
go to 100
|
||||
else
|
||||
|
||||
endif
|
||||
|
||||
grid6=grid//'ma'
|
||||
call grid2k(grid6,k)
|
||||
if(k.ge.1 .and. k.le.450) call getpfx2(k,c1)
|
||||
if(k.ge.451 .and. k.le.900) call getpfx2(k,c2)
|
||||
|
||||
i=index(c1,char(0))
|
||||
if(i.ge.3) c1=c1(1:i-1)//' '
|
||||
i=index(c2,char(0))
|
||||
if(i.ge.3) c2=c2(1:i-1)//' '
|
||||
|
||||
msg=' '
|
||||
j=0
|
||||
if(cqnnn) then
|
||||
msg=c1//' '
|
||||
j=7 !### ??? ###
|
||||
go to 10
|
||||
endif
|
||||
|
||||
do i=1,12
|
||||
j=j+1
|
||||
msg(j:j)=c1(i:i)
|
||||
if(c1(i:i).eq.' ') go to 10
|
||||
enddo
|
||||
j=j+1
|
||||
msg(j:j)=' '
|
||||
|
||||
10 do i=1,12
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=c2(i:i)
|
||||
if(c2(i:i).eq.' ') go to 20
|
||||
enddo
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=' '
|
||||
|
||||
20 if(k.eq.0) then
|
||||
do i=1,4
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=grid(i:i)
|
||||
enddo
|
||||
if(j.le.21) j=j+1
|
||||
msg(j:j)=' '
|
||||
endif
|
||||
|
||||
100 return
|
||||
end
|
||||
@@ -0,0 +1,35 @@
|
||||
subroutine unpacktext(nc1,nc2,nc3,msg)
|
||||
|
||||
character*22 msg
|
||||
character*44 c
|
||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
||||
|
||||
nc3=iand(nc3,32767) !Remove the "plain text" bit
|
||||
if(iand(nc1,1).ne.0) nc3=nc3+32768
|
||||
nc1=nc1/2
|
||||
if(iand(nc2,1).ne.0) nc3=nc3+65536
|
||||
nc2=nc2/2
|
||||
|
||||
do i=5,1,-1
|
||||
j=mod(nc1,42)+1
|
||||
msg(i:i)=c(j:j)
|
||||
nc1=nc1/42
|
||||
enddo
|
||||
|
||||
do i=10,6,-1
|
||||
j=mod(nc2,42)+1
|
||||
msg(i:i)=c(j:j)
|
||||
nc2=nc2/42
|
||||
enddo
|
||||
|
||||
do i=13,11,-1
|
||||
j=mod(nc3,42)+1
|
||||
msg(i:i)=c(j:j)
|
||||
nc3=nc3/42
|
||||
enddo
|
||||
msg(14:22) = ' '
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
|
||||
+219
@@ -0,0 +1,219 @@
|
||||
/* Viterbi decoder for arbitrary convolutional code
|
||||
* viterbi27 and viterbi37 for the r=1/2 and r=1/3 K=7 codes are faster
|
||||
* Copyright 1999 Phil Karn, KA9Q
|
||||
* May be used under the terms of the GNU Public License
|
||||
*/
|
||||
|
||||
/* Select code here */
|
||||
|
||||
#define V216
|
||||
|
||||
|
||||
#ifdef V216
|
||||
#define K 16 /* Constraint length */
|
||||
#define N 2 /* Number of symbols per data bit */
|
||||
#define Polys Poly216 /* Select polynomials here */
|
||||
#endif
|
||||
|
||||
/* Rate 1/2 codes */
|
||||
unsigned int Poly216[] = {0126723, 0152711}; /* k = 16 */
|
||||
|
||||
#include <memory.h>
|
||||
#define NULL ((void *)0)
|
||||
|
||||
#define LONGBITS 32
|
||||
#define LOGLONGBITS 5
|
||||
|
||||
#undef max
|
||||
#define max(x,y) ((x) > (y) ? (x) : (y))
|
||||
#define D (1 << max(0,K-LOGLONGBITS-1))
|
||||
#define MAXNBITS 200 /* Maximum frame size (user bits) */
|
||||
|
||||
extern unsigned char Partab[]; /* Parity lookup table */
|
||||
|
||||
int Syms[1 << K];
|
||||
int VDInit = 0;
|
||||
|
||||
int parity(int x)
|
||||
{
|
||||
x ^= (x >> 16);
|
||||
x ^= (x >> 8);
|
||||
return Partab[x & 0xff];
|
||||
}
|
||||
|
||||
// Wrapper for calling "encode" from Fortran:
|
||||
//void __stdcall ENCODE(
|
||||
void enc216_(
|
||||
unsigned char data[], // User data, 8 bits per byte
|
||||
int *nbits, // Number of user bits
|
||||
unsigned char symbols[], // Encoded one-bit symbols, 8 per byte
|
||||
int *nsymbols, // Number of symbols
|
||||
int *kk, // K
|
||||
int *nn) // N
|
||||
{
|
||||
int nbytes;
|
||||
nbytes=(*nbits+7)/8; // Always encode multiple of 8 information bits
|
||||
enc216(symbols,data,nbytes,0,0); // Do the encoding
|
||||
*nsymbols=(*nbits+K-1)*N; // Return number of encoded symbols
|
||||
*kk=K;
|
||||
*nn=N;
|
||||
}
|
||||
|
||||
/* Convolutionally encode data into binary symbols */
|
||||
enc216(unsigned char symbols[], unsigned char data[],
|
||||
unsigned int nbytes, unsigned int startstate,
|
||||
unsigned int endstate)
|
||||
{
|
||||
int i,j,k,n=-1;
|
||||
unsigned int encstate = startstate;
|
||||
|
||||
for(k=0; k<nbytes; k++) {
|
||||
for(i=7;i>=0;i--){
|
||||
encstate = (encstate + encstate) + ((data[k] >> i) & 1);
|
||||
for(j=0;j<N;j++) {
|
||||
n=n+1;
|
||||
symbols[n] = parity(encstate & Polys[j]);
|
||||
}
|
||||
}
|
||||
}
|
||||
// Flush out with zero tail. (No need, if tail-biting code.)
|
||||
for(i=0; i<K-1;i++){
|
||||
encstate = (encstate << 1) | ((endstate >> i) & 1);
|
||||
for(j=0;j<N;j++) {
|
||||
n=n+1;
|
||||
symbols[n] = parity(encstate & Polys[j]);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
// Wrapper for calling "viterbi" from Fortran:
|
||||
//void __stdcall VITERBI(
|
||||
void vit216_(
|
||||
unsigned char symbols[], /* Raw deinterleaved input symbols */
|
||||
unsigned int *Nbits, /* Number of decoded information bits */
|
||||
int mettab[2][256], /* Metric table, [sent sym][rx symbol] */
|
||||
unsigned char ddec[], /* Decoded output data */
|
||||
long *Metric /* Final path metric (bigger is better) */
|
||||
){
|
||||
long metric;
|
||||
vit216(&metric,ddec,symbols,*Nbits,mettab,0,0);
|
||||
*Metric=metric;
|
||||
}
|
||||
|
||||
/* Viterbi decoder */
|
||||
int vit216(
|
||||
long *metric, /* Final path metric (returned value) */
|
||||
unsigned char *data, /* Decoded output data */
|
||||
unsigned char *symbols, /* Raw deinterleaved input symbols */
|
||||
unsigned int nbits, /* Number of output bits */
|
||||
int mettab[2][256], /* Metric table, [sent sym][rx symbol] */
|
||||
unsigned int startstate, /* Encoder starting state */
|
||||
unsigned int endstate /* Encoder ending state */
|
||||
){
|
||||
int bitcnt = -(K-1);
|
||||
long m0,m1;
|
||||
int i,j,sym,ipp;
|
||||
int mets[1 << N];
|
||||
unsigned long paths[(MAXNBITS+K-1)*D];
|
||||
unsigned long *pp,mask;
|
||||
long cmetric[1 << (K-1)],nmetric[1 << (K-1)];
|
||||
|
||||
memset(paths,0,sizeof(paths));
|
||||
|
||||
// Initialize on first time through:
|
||||
if(!VDInit){
|
||||
for(i=0;i<(1<<K);i++){
|
||||
sym = 0;
|
||||
for(j=0;j<N;j++)
|
||||
sym = (sym << 1) + parity(i & Polys[j]);
|
||||
Syms[i] = sym;
|
||||
}
|
||||
VDInit++;
|
||||
}
|
||||
|
||||
// Keep only lower K-1 bits of specified startstate and endstate
|
||||
startstate &= ~((1<<(K-1)) - 1);
|
||||
endstate &= ~((1<<(K-1)) - 1);
|
||||
|
||||
/* Initialize starting metrics */
|
||||
for(i=0;i< 1<<(K-1);i++)
|
||||
cmetric[i] = -999999;
|
||||
cmetric[startstate] = 0;
|
||||
|
||||
pp = paths;
|
||||
ipp=0;
|
||||
for(;;){ /* For each data bit */
|
||||
/* Read input symbols and compute branch metrics */
|
||||
for(i=0;i< 1<<N;i++){
|
||||
mets[i] = 0;
|
||||
for(j=0;j<N;j++){
|
||||
mets[i] += mettab[(i >> (N-j-1)) & 1][symbols[j]];
|
||||
}
|
||||
}
|
||||
symbols += N;
|
||||
/* Run the add-compare-select operations */
|
||||
mask = 1;
|
||||
for(i=0;i< 1 << (K-1);i+=2){
|
||||
int b1,b2;
|
||||
|
||||
b1 = mets[Syms[i]];
|
||||
nmetric[i] = m0 = cmetric[i/2] + b1;
|
||||
b2 = mets[Syms[i+1]];
|
||||
b1 -= b2;
|
||||
m1 = cmetric[(i/2) + (1<<(K-2))] + b2;
|
||||
|
||||
if(m1 > m0){
|
||||
nmetric[i] = m1;
|
||||
*pp |= mask;
|
||||
}
|
||||
|
||||
m0 -= b1;
|
||||
nmetric[i+1] = m0;
|
||||
m1 += b1;
|
||||
|
||||
if(m1 > m0){
|
||||
nmetric[i+1] = m1;
|
||||
*pp |= mask << 1;
|
||||
}
|
||||
|
||||
mask <<= 2;
|
||||
if(mask == 0){
|
||||
mask = 1;
|
||||
pp++;
|
||||
ipp++;
|
||||
}
|
||||
}
|
||||
if(mask != 1){
|
||||
pp++;
|
||||
ipp++;
|
||||
}
|
||||
if(++bitcnt == nbits){
|
||||
*metric = nmetric[endstate];
|
||||
break;
|
||||
}
|
||||
memcpy(cmetric,nmetric,sizeof(cmetric));
|
||||
}
|
||||
|
||||
/* Chain back from terminal state to produce decoded data */
|
||||
if(data == NULL)
|
||||
return 0;/* Discard output */
|
||||
memset(data,0,(nbits+7)/8); /* round up in case nbits % 8 != 0 */
|
||||
|
||||
for(i=nbits-1;i >= 0;i--){
|
||||
// int a0,a1;
|
||||
pp -= D;
|
||||
ipp -= D;
|
||||
m0=endstate >> LOGLONGBITS;
|
||||
m1=1L << (endstate & (LONGBITS-1));
|
||||
if(pp[m0] & m1) {
|
||||
// a0=nmetric[endstate];
|
||||
endstate |= (1 << (K-1));
|
||||
// a1=nmetric[endstate];
|
||||
data[i>>3] |= 0x80 >> (i&7);
|
||||
// printf("B %d %d %d %d\n",*metric,i,a0,a1);
|
||||
}
|
||||
endstate >>= 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
Reference in New Issue
Block a user