w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-22 12:23:37 -05:00
Code Issues Packages Projects Releases Wiki Activity

1. General code cleanup. Most compiler warning messages have been silenced.

Browse Source 
2. "/A" added to list of optional callsign suffixes.
3. Improved algorithm for measuring error in soundcard sample rates.
4. Optional 5-sec shift of input data, to catch some clock errors.


git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/trunk@274 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor 2006-09-06 18:09:05 +00:00
parent daa2ffd27a
commit 8c9ed820c8
28 changed files with 1806 additions and 1802 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CALL3.TXT
View File

@ -6,6 +6,7 @@
3V8BB,JM56ER,EME,,,,,06/02
3V8SS,JM55GX,EME,,Expedition,,144: 16JXX and 1kw,12/05
3Y0X,EC41RE,EME,,Expedition,,144: 4x 9el 350W,02/06
4F2KWT,PK06,EME,,
4J1FS,KP40,,,Expedition,,,1990
4N7AX,KN05PC,,,,,144: 200 W 2x10el 9BVtx1500/rx3000lpm DSP,08/00
4O4AR,JN94AS,,,=YU4AR,,144: TR9130 250W 10el PA0MS-ant PreampUHER 15,11/02

5
Makefile.in
View File

@ -107,8 +107,9 @@ wsjt6: @NEEDPORTAUDIO@ Audio.so #wsjt.spec
# ${PYTHON} c:\python23\installer\Build.py wsjt.spec
# ${RM} wsjt6
#
#
deep65.o: deep65.F
$(FC) -c -O0 -Wall deep65.F
Audio.so: $(OBJS2C) $(OBJS3C) $(OBJS2F77) $(SRCS2F90) $(AUDIOSRCS)
${F2PY} -c --quiet --opt="-O ${CFLAGS} \
-fno-second-underscore" $(OBJS2C) $(OBJS2F77) -m Audio \

27
Makefile.win
View File

@ -2,8 +2,10 @@
!include <dfinc.mak> #Some definitions for Compaq Visual Fortran
gcc = cl
FC = df
#To do bounds checking (with useless reports) put "/check:all" in the
# --opt= line below (line 56, more or less ...)
#FFLAGS = /traceback /check:all
FFLAGS = /traceback /fast
FFLAGS = /traceback /fast /nologo
all: JT65code.exe WSJT6.EXE
@ -16,7 +18,7 @@ OBJS1 = JT65code.obj nchar.obj grid2deg.obj packmsg.obj packtext.obj \
wrapkarn.obj
JT65code.exe: $(OBJS1)
$(FC) /exe:JT65code.exe $(OBJS1)
$(FC) $(FFLAGS) /exe:JT65code.exe $(OBJS1)
OBJS2C = init_rs.o encode_rs.o decode_rs.o jtaudio.o
@ -51,7 +53,8 @@ WSJT6.EXE: Audio.pyd wsjt.spec
Audio.pyd: $(OBJS2C) $(SRCS2F90) $(SRCS2F77) $(SRCS2C)
python f2py.py -c \
--quiet --"fcompiler=compaqv" \
--opt="/traceback /fast /fpp /define:Win32 /define:USE_PORTAUDIO" \
--opt="/nologo /traceback /warn:errors /fast /fpp /define:Win32 \
/define:USE_PORTAUDIO" \
$(OBJS2C) \
-lwinmm -lpa -llibsamplerate \
-m Audio \
@ -63,31 +66,31 @@ wsjt.spec: wsjt.py astro.py g.py options.py palettes.py smeter.py specjt.py
--tk --onefile wsjt.py
jtaudio.o: jtaudio.c
cl /c /DWin32 /Fojtaudio.o jtaudio.c
$(CC) /nologo /c /DWin32 /Fojtaudio.o jtaudio.c
init_rs.obj: init_rs.c
$(CC) /c /DBIGSYM=1 init_rs.c
$(CC) /nologo /c /DBIGSYM=1 init_rs.c
init_rs.o: init_rs.obj
$(CC) /c /DBIGSYM=1 /Foinit_rs.o init_rs.c
$(CC) /nologo /c /DBIGSYM=1 /Foinit_rs.o init_rs.c
encode_rs.obj: encode_rs.c
$(CC) /c /DBIGSYM=1 encode_rs.c
$(CC) /nologo /c /DBIGSYM=1 encode_rs.c
encode_rs.o: encode_rs.c
$(CC) /c /DBIGSYM=1 /Foencode_rs.o encode_rs.c
$(CC) /nologo /c /DBIGSYM=1 /Foencode_rs.o encode_rs.c
decode_rs.obj: decode_rs.c
$(CC) /c /DBIGSYM=1 decode_rs.c
$(CC) /nologo /c /DBIGSYM=1 decode_rs.c
decode_rs.o: decode_rs.c
$(CC) /c /DBIGSYM=1 /Ox /Zd /Fodecode_rs.o decode_rs.c
$(CC) /nologo /c /DBIGSYM=1 /Ox /Zd /Fodecode_rs.o decode_rs.c
wrapkarn.obj: wrapkarn.c
$(CC) /c /DWin32=1 wrapkarn.c
$(CC) /nologo /c /DWin32=1 wrapkarn.c
igray.obj: igray.c
$(CC) /c /DWin32=1 igray.c
$(CC) /nologo /c /DWin32=1 igray.c
.PHONY : clean

63
abc441.F90
View File

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

252
astro.F
View File

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

1
astro0.F90
View File

@ -10,7 +10,6 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
character grid*6
character*9 cauxra,cauxdec
real*8 utch8
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,AzAux8,ElAux8
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0
real*8 sd8,poloffset8

155
audio_init.F90
View File

@ -1,78 +1,77 @@
!------------------------------------------------ audio_init
subroutine audio_init(ndin,ndout)
#ifdef Win32
use dfmt
integer Thread1,Thread2
external a2d,decode1
#endif
integer*2 a(225000) !Pixel values for 750 x 300 array
integer brightness,contrast
include 'gcom1.f90'
include 'gcom2.f90'
nmode=1
if(mode(1:4).eq.'JT65') then
nmode=2
if(mode(5:5).eq.'A') mode65=1
if(mode(5:5).eq.'B') mode65=2
if(mode(5:5).eq.'C') mode65=4
endif
if(mode.eq.'Echo') nmode=3
if(mode.eq.'JT6M') nmode=4
ndevin=ndin
ndevout=ndout
TxOK=0
Transmitting=0
nfsample=11025
nspb=1024
nbufs=2048
nmax=nbufs*nspb
nwave=60*nfsample
ngo=1
brightness=0
contrast=0
nsec=1
df=11025.0/4096
f0=800.0
do i=1,nwave
iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample))
enddo
#ifdef Win32
! Priority classes (for processes):
! IDLE_PRIORITY_CLASS 64
! NORMAL_PRIORITY_CLASS 32
! HIGH_PRIORITY_CLASS 128
! Priority definitions (for threads):
! THREAD_PRIORITY_IDLE -15
! THREAD_PRIORITY_LOWEST -2
! THREAD_PRIORITY_BELOW_NORMAL -1
! THREAD_PRIORITY_NORMAL 0
! THREAD_PRIORITY_ABOVE_NORMAL 1
! THREAD_PRIORITY_HIGHEST 2
! THREAD_PRIORITY_TIME_CRITICAL 15
m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS)
! Start a thread for doing A/D and D/A with sound card.
Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1)
m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL)
m2=ResumeThread(Thread1)
! Start a thread for background decoding.
Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2)
m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL)
m4=ResumeThread(Thread2)
#else
! print*,'Audio INIT called.'
ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, &
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name)
#endif
return
end subroutine audio_init
!------------------------------------------------ audio_init
subroutine audio_init(ndin,ndout)
#ifdef Win32
use dfmt
integer Thread1,Thread2
external a2d,decode1
#endif
integer brightness,contrast
include 'gcom1.f90'
include 'gcom2.f90'
nmode=1
if(mode(1:4).eq.'JT65') then
nmode=2
if(mode(5:5).eq.'A') mode65=1
if(mode(5:5).eq.'B') mode65=2
if(mode(5:5).eq.'C') mode65=4
endif
if(mode.eq.'Echo') nmode=3
if(mode.eq.'JT6M') nmode=4
ndevin=ndin
ndevout=ndout
TxOK=0
Transmitting=0
nfsample=11025
nspb=1024
nbufs=2048
nmax=nbufs*nspb
nwave=60*nfsample
ngo=1
brightness=0
contrast=0
nsec=1
df=11025.0/4096
f0=800.0
do i=1,nwave
iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample))
enddo
#ifdef Win32
! Priority classes (for processes):
! IDLE_PRIORITY_CLASS 64
! NORMAL_PRIORITY_CLASS 32
! HIGH_PRIORITY_CLASS 128
! Priority definitions (for threads):
! THREAD_PRIORITY_IDLE -15
! THREAD_PRIORITY_LOWEST -2
! THREAD_PRIORITY_BELOW_NORMAL -1
! THREAD_PRIORITY_NORMAL 0
! THREAD_PRIORITY_ABOVE_NORMAL 1
! THREAD_PRIORITY_HIGHEST 2
! THREAD_PRIORITY_TIME_CRITICAL 15
m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS)
! Start a thread for doing A/D and D/A with sound card.
Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1)
m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL)
m2=ResumeThread(Thread1)
! Start a thread for background decoding.
Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2)
m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL)
m4=ResumeThread(Thread2)
#else
! print*,'Audio INIT called.'
ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, &
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name)
#endif
return
end subroutine audio_init

123
avemsg65.f
View File

@ -1,60 +1,63 @@
subroutine avemsg65(mseg,mode65,ndepth,decoded,nused,
+ nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual,
+ ns,ncount)
C Decodes averaged JT65 data for the specified segment (mseg=1 or 2).
parameter (MAXAVE=120) !Max avg count is 120
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
real s3(64,63)
common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE)
C Count the available spectra for this Monitor segment (mseg=1 or 2),
C and the number of spectra flagged as good.
nused=0
ns=0
nqual=0
deepmsg=' '
do i=1,nsave
if(iseg(i).eq.mseg) then
ns=ns+1
if(nflag(i).eq.1) nused=nused+1
endif
enddo
if(nused.lt.1) go to 100
C Compute the average of all flagged spectra for this segment.
do j=1,63
call zero(s3(1,j),64)
do n=1,nsave
if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then
call add(s3(1,j),ppsave(1,j,n),s3(1,j),64)
endif
enddo
enddo
nadd=nused*mode65
call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message
if(ncount.lt.0) decoded=' '
nqual=0
C Possibly should pass nadd=nused, also:
if(ndepth.ge.3) then
flipx=1.0 !Normal flip not relevant for ave msg
call deep65(s3,mode65,neme,nsked,flipx,
+ mycall,hiscall,hisgrid,deepmsg,qual)
nqual=qual
if(nqual.lt.nq1) deepmsg=' '
if(nqual.ge.nq1 .and. nqual.lt.nq2) deepmsg(19:19)='?'
endif
if(ncount.lt.0) decoded=deepmsg
C Suppress "birdie messages":
if(decoded(1:7).eq.'000AAA ') decoded=' '
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
100 if(nused.lt.1) decoded=' '
return
end
subroutine avemsg65(mseg,mode65,ndepth,decoded,nused,
+ nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual,
+ ns,ncount)
C Decodes averaged JT65 data for the specified segment (mseg=1 or 2).
parameter (MAXAVE=120) !Max avg count is 120
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
real s3(64,63)
common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE)
C Count the available spectra for this Monitor segment (mseg=1 or 2),
C and the number of spectra flagged as good.
nused=0
ns=0
nqual=0
deepmsg=' '
do i=1,nsave
if(iseg(i).eq.mseg) then
ns=ns+1
if(nflag(i).eq.1) nused=nused+1
endif
enddo
if(nused.lt.1) go to 100
C Compute the average of all flagged spectra for this segment.
do j=1,63
call zero(s3(1,j),64)
do n=1,nsave
if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then
call add(s3(1,j),ppsave(1,j,n),s3(1,j),64)
endif
enddo
enddo
nadd=nused*mode65
call extract(s3,nadd,ncount,decoded) !Extract the message
if(ncount.lt.0) decoded=' '
nqual=0
C Possibly should pass nadd=nused, also:
if(ndepth.ge.3) then
flipx=1.0 !Normal flip not relevant for ave msg
call deep65(s3,mode65,neme,nsked,flipx,
+ mycall,hiscall,hisgrid,deepmsg,qual)
nqual=qual
if(nqual.lt.nq1) deepmsg=' '
if(nqual.ge.nq1 .and. nqual.lt.nq2) deepmsg(19:19)='?'
else
deepmsg=' '
qual=0.
endif
if(ncount.lt.0) decoded=deepmsg
C Suppress "birdie messages":
if(decoded(1:7).eq.'000AAA ') decoded=' '
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
100 if(nused.lt.1) decoded=' '
return
end

104
avesp2.f
View File

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

2
decode1.F90
View File

@ -9,7 +9,7 @@ subroutine decode1(iarg)
use dflib
#endif
character sending0*28,fcum*80,mode0*6,cshort*11
character sending0*28,mode0*6,cshort*11
integer sendingsh0
include 'gcom1.f90'

1
decode2.f90
View File

@ -5,7 +5,6 @@ subroutine decode2
! Get data and parameters from gcom, then call the decoders
character fnamex*24
integer*2 d2d(30*11025)
include 'gcom1.f90'
include 'gcom2.f90'

21
decode3.F90
View File

@ -5,12 +5,9 @@ subroutine decode3(d2,jz,istart,filename)
use dfport
#endif
integer*2 d2(jz),d2d(60*11025)
real*8 sq
integer*2 d2(jz),d2d(65*11025)
character*24 filename
character FileID*40
character mycall0*12,hiscall0*12,hisgrid0*6
logical savefile
include 'gcom1.f90'
include 'gcom2.f90'
@ -51,10 +48,20 @@ subroutine decode3(d2,jz,istart,filename)
endif
open(23,file=appdir(:lenappdir)//'/CALL3.TXT',status='unknown')
if(nadd5.eq.1) then
nzero=5*11025
do i=jz,nzero+1,-1
d2d(i)=d2d(i-nzero)
enddo
do i=1,nzero
d2d(i)=0
enddo
jz=min(60*11025,jz+nzero)
endif
call wsjt1(d2d,jz,istart,samfacin,FileID,ndepth,MinSigdB, &
NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve, &
nMode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65, &
MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2, &
NQRN,DFTolerance,MouseButton,NClearAve, &
nMode,NFreeze,NAFC,NZap,mode65, &
MyCall,HisCall,HisGrid,neme,nsked,ntx2,s2, &
ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg, &
MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
close(23)

106
decode65.f
View File

@ -1,53 +1,53 @@
subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
+ nsnr,mycall,hiscall,hisgrid,mode65,nafc,decoded,ncount,
+ deepmsg,qual)
C Decodes JT65 data, assuming that DT and DF have already been determined.
real dat(npts) !Raw data
real s2(77,126)
real s3(64,63)
real ftrack(126)
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
include 'avecom.h'
include 'prcom.h'
save
dt=2.0/11025.0 !Sample interval (2x downsampled data)
istart=nint(dtx/dt) !Start index for synced FFTs
nsym=126
C Compute spectra of the channel symbols
f0=1270.46 + dfx
call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,nafc,mode65,s2)
do j=1,63
k=mdat(j) !Points to data symbol
if(flip.lt.0.0) k=mdat2(j)
do i=1,64
s3(i,j)=s2(i+7,k)
enddo
enddo
nadd=mode65
call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message
qual=0.
if(ndepth.ge.1) call deep65(s3,mode65,neme,
+ nsked,flip,mycall,hiscall,hisgrid,deepmsg,qual)
if(ncount.lt.0) decoded=' '
C Suppress "birdie messages":
if(decoded(1:7).eq.'000AAA ') decoded=' '
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
C Save symbol spectra for possible decoding of average.
do j=1,63
k=mdat(j)
if(flip.lt.0.0) k=mdat2(j)
call move(s2(8,k),ppsave(1,j,nsave),64)
enddo
return
end
subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
+ mycall,hiscall,hisgrid,mode65,nafc,decoded,ncount,
+ deepmsg,qual)
C Decodes JT65 data, assuming that DT and DF have already been determined.
real dat(npts) !Raw data
real s2(77,126)
real s3(64,63)
real ftrack(126)
character decoded*22,deepmsg*22
character mycall*12,hiscall*12,hisgrid*6
include 'avecom.h'
include 'prcom.h'
save
dt=2.0/11025.0 !Sample interval (2x downsampled data)
istart=nint(dtx/dt) !Start index for synced FFTs
nsym=126
C Compute spectra of the channel symbols
f0=1270.46 + dfx
call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,nafc,mode65,s2)
do j=1,63
k=mdat(j) !Points to data symbol
if(flip.lt.0.0) k=mdat2(j)
do i=1,64
s3(i,j)=s2(i+7,k)
enddo
enddo
nadd=mode65
call extract(s3,nadd,ncount,decoded) !Extract the message
qual=0.
if(ndepth.ge.1) call deep65(s3,mode65,neme,
+ nsked,flip,mycall,hiscall,hisgrid,deepmsg,qual)
if(ncount.lt.0) decoded=' '
C Suppress "birdie messages":
if(decoded(1:7).eq.'000AAA ') decoded=' '
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
C Save symbol spectra for possible decoding of average.
do j=1,63
k=mdat(j)
if(flip.lt.0.0) k=mdat2(j)
call move(s2(8,k),ppsave(1,j,nsave),64)
enddo
return
end

313
deep65.F
View File

@ -1,158 +1,155 @@
subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,
+ hisgrid,decoded,qual)
parameter (MAXCALLS=7000,MAXRPT=63)
real s3(64,63)
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
character*12 mycall,hiscall
character*22 decoded
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*180 line
character*4 rpt(MAXRPT)
integer ncode(63,2*MAXCALLS + 2 + MAXRPT)
real pp(2*MAXCALLS + 2 + MAXRPT)
common/tmp9/ mrs(63),mrs2(63)
data neme0/-99/
data rpt/'-01','-02','-03','-04','-05',
+ '-06','-07','-08','-09','-10',
+ '-11','-12','-13','-14','-15',
+ '-16','-17','-18','-19','-20',
+ '-21','-22','-23','-24','-25',
+ '-26','-27','-28','-29','-30',
+ 'R-01','R-02','R-03','R-04','R-05',
+ 'R-06','R-07','R-08','R-09','R-10',
+ 'R-11','R-12','R-13','R-14','R-15',
+ 'R-16','R-17','R-18','R-19','R-20',
+ 'R-21','R-22','R-23','R-24','R-25',
+ 'R-26','R-27','R-28','R-29','R-30',
+ 'RO','RRR','73'/
rewind 23
k=0
icall=0
do n=1,MAXCALLS
if(n.eq.1) then
callsign=hiscall
do i=4,12
if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' '
enddo
grid=hisgrid(1:4)
if(ichar(grid(3:3)).eq.0) grid(3:3)=' '
if(ichar(grid(4:4)).eq.0) grid(4:4)=' '
else
read(23,1002,end=20) line
1002 format (A80)
if(line(1:4).eq.'ZZZZ') go to 20
if(line(1:2).eq.'//') go to 10
i1=index(line,',')
if(i1.lt.4) go to 10
i2=index(line(i1+1:),',')
if(i2.lt.5) go to 10
i2=i2+i1
i3=index(line(i2+1:),',')
if(i3.lt.1) i3=index(line(i2+1:),' ')
i3=i2+i3
callsign=line(1:i1-1)
grid=line(i1+1:i2-1)
ceme=line(i2+1:i3-1)
if(neme.eq.1 .and. ceme.ne.'EME') go to 10
endif
icall=icall+1
j1=index(mycall,' ') - 1
if(j1.le.-1) j1=12
if(j1.lt.3) j1=6
j2=index(callsign,' ') - 1
if(j2.le.-1) j2=12
if(j2.lt.3) j2=6
j3=index(mycall,'/')
j4=index(callsign,'/')
callgrid(icall)=callsign(1:j2)
mz=1
if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and.
+ flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1
C Test for messages with MyCall + HisCall + report
do m=1,mz
if(m.gt.1) grid=rpt(m-1)
if(j3.lt.1 .and.j4.lt.1)
+ callgrid(icall)=callsign(1:j2)//' '//grid
message=mycall(1:j1)//' '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
C Insert CQ message unless sync=OOO (flip=-1).
if(m.eq.1 .and. flip.gt.0.0) then
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
endif
enddo
if(nsked.eq.1) go to 20
10 enddo
20 ntot=k
neme0=neme
ref0=0.
do j=1,63
ref0=ref0 + s3(mrs(j),j)
enddo
p1=-1.e30
p2=-1.e30
do k=1,ntot
sum=0.
ref=ref0
do j=1,63
i=ncode(j,k)+1
sum=sum + s3(i,j)
if(i.eq.mrs(j)) then
ref=ref - s3(i,j) + s3(mrs2(j),j)
endif
enddo
p=sum/ref
pp(k)=p
if(p.gt.p1) then
p1=p
ip1=k
endif
enddo
p2=-1.e30
do i=1,ntot
if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i)
enddo
if(mode65.eq.1) bias=max(1.12*p2,0.335)
if(mode65.eq.2) bias=max(1.08*p2,0.405)
if(mode65.ge.4) bias=max(1.04*p2,0.505)
C This is really weird, but do not remove the following statements!
! write(77,*) mode65,bias,p1,p2
! rewind 77
! rewind 23
call sleepqqq(1)
qual=100.0*(p1-bias)
decoded=' '
c=' '
if(qual.gt.1.0) then
if(qual.lt.6.0) c='?'
decoded=testmsg(ip1)
else
qual=0.
endif
decoded(22:22)=c
C Make sure everything is upper case.
do i=1,22
if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z')
+ decoded(i:i)=char(ichar(decoded(i:i))-32)
enddo
return
end
subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,
+ hisgrid,decoded,qual)
parameter (MAXCALLS=7000,MAXRPT=63)
real s3(64,63)
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
character*12 mycall,hiscall
character*22 decoded
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
character*15 callgrid(MAXCALLS)
character*180 line
character*4 rpt(MAXRPT)
integer ncode(63,2*MAXCALLS + 2 + MAXRPT)
real pp(2*MAXCALLS + 2 + MAXRPT)
common/tmp9/ mrs(63),mrs2(63)
#ifdef Win32
C This prevents some optimizations that break this subroutine.
volatile p1,p2,bias
#endif
data neme0/-99/
data rpt/'-01','-02','-03','-04','-05',
+ '-06','-07','-08','-09','-10',
+ '-11','-12','-13','-14','-15',
+ '-16','-17','-18','-19','-20',
+ '-21','-22','-23','-24','-25',
+ '-26','-27','-28','-29','-30',
+ 'R-01','R-02','R-03','R-04','R-05',
+ 'R-06','R-07','R-08','R-09','R-10',
+ 'R-11','R-12','R-13','R-14','R-15',
+ 'R-16','R-17','R-18','R-19','R-20',
+ 'R-21','R-22','R-23','R-24','R-25',
+ 'R-26','R-27','R-28','R-29','R-30',
+ 'RO','RRR','73'/
rewind 23
k=0
icall=0
do n=1,MAXCALLS
if(n.eq.1) then
callsign=hiscall
do i=4,12
if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' '
enddo
grid=hisgrid(1:4)
if(ichar(grid(3:3)).eq.0) grid(3:3)=' '
if(ichar(grid(4:4)).eq.0) grid(4:4)=' '
else
read(23,1002,end=20) line
1002 format (A80)
if(line(1:4).eq.'ZZZZ') go to 20
if(line(1:2).eq.'//') go to 10
i1=index(line,',')
if(i1.lt.4) go to 10
i2=index(line(i1+1:),',')
if(i2.lt.5) go to 10
i2=i2+i1
i3=index(line(i2+1:),',')
if(i3.lt.1) i3=index(line(i2+1:),' ')
i3=i2+i3
callsign=line(1:i1-1)
grid=line(i1+1:i2-1)
ceme=line(i2+1:i3-1)
if(neme.eq.1 .and. ceme.ne.'EME') go to 10
endif
icall=icall+1
j1=index(mycall,' ') - 1
if(j1.le.-1) j1=12
if(j1.lt.3) j1=6
j2=index(callsign,' ') - 1
if(j2.le.-1) j2=12
if(j2.lt.3) j2=6
j3=index(mycall,'/')
j4=index(callsign,'/')
callgrid(icall)=callsign(1:j2)
mz=1
if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and.
+ flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1
C Test for messages with MyCall + HisCall + report
do m=1,mz
if(m.gt.1) grid=rpt(m-1)
if(j3.lt.1 .and.j4.lt.1)
+ callgrid(icall)=callsign(1:j2)//' '//grid
message=mycall(1:j1)//' '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
C Insert CQ message unless sync=OOO (flip=-1).
if(m.eq.1 .and. flip.gt.0.0) then
message='CQ '//callgrid(icall)
k=k+1
testmsg(k)=message
call encode65(message,ncode(1,k))
endif
enddo
if(nsked.eq.1) go to 20
10 continue
enddo
20 ntot=k
neme0=neme
ref0=0.
do j=1,63
ref0=ref0 + s3(mrs(j),j)
enddo
p1=-1.e30
p2=-1.e30
do k=1,ntot
sum=0.
ref=ref0
do j=1,63
i=ncode(j,k)+1
sum=sum + s3(i,j)
if(i.eq.mrs(j)) then
ref=ref - s3(i,j) + s3(mrs2(j),j)
endif
enddo
p=sum/ref
pp(k)=p
if(p.gt.p1) then
p1=p
ip1=k
endif
enddo
p2=-1.e30
do i=1,ntot
if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i)
enddo
if(mode65.eq.1) bias=max(1.12*p2,0.335)
if(mode65.eq.2) bias=max(1.08*p2,0.405)
if(mode65.ge.4) bias=max(1.04*p2,0.505)
qual=100.0*(p1-bias)
decoded=' '
c=' '
if(qual.gt.1.0) then
if(qual.lt.6.0) c='?'
decoded=testmsg(ip1)
else
qual=0.
endif
decoded(22:22)=c
C Make sure everything is upper case.
do i=1,22
if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z')
+ decoded(i:i)=char(ichar(decoded(i:i))-32)
enddo
return
end

150
extract.f
View File

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

64
fivehz.F90
View File

@ -14,8 +14,10 @@ subroutine fivehz
use dfport
#endif
parameter (NTRING=64)
real*8 tt1(0:NTRING-1)
real*8 tstart,tstop,t60
logical first,txtime,debug
logical first,txtime,debug,filled
integer ptt
integer TxOKz
real*8 fs,fsample,tt,tt0,u
@ -40,22 +42,36 @@ subroutine fivehz
ibuf00=-99
ncall=-1
tt0=tt
u=0.1d0
u=0.05d0
fsample=11025.d0
maxms=0
mfsample=110250
filled=.false.
endif
if(txdelay.lt.0.2d0) txdelay=0.2d0
! Measure average sampling frequency over a recent interval
ncall=ncall+1
if(ncall.eq.9) tt0=tt
if(ncall.ge.10 .and. mod(ncall,2).eq.1) then
fs=(ncall-9)*2048.d0/(tt-tt0)
fsample=u*fs + (1.d0-u)*fsample
mfsample=nint(10.d0*fsample)
if(ncall.eq.9) then
tt0=tt
ntt0=0
ntt1=0
tt1(ntt1)=tt
endif
! if(ncall.ge.10 .and. mod(ncall,2).eq.1) then
if(ncall.ge.10) then
ntt1=iand(ntt1+1,NTRING-1)
tt1(ntt1)=tt
if(ntt1.eq.NTRING-1) filled=.true.
if(filled) ntt0=iand(ntt1+1,NTRING-1)
if(mod(ncall,2).eq.1) then
nd=ntt1-ntt0
if(nd.lt.0) nd=nd+NTRING
fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0))
fsample=u*fs + (1.d0-u)*fsample
mfsample=nint(10.d0*fsample)
endif
endif
if(trperiod.le.0) trperiod=30
@ -180,7 +196,9 @@ subroutine fivehztx
use dfport
#endif
logical first
parameter (NTRING=64)
real*8 tt1(0:NTRING-1)
logical first,filled
real*8 fs,fsample,tt,tt0,u
include 'gcom1.f90'
data first/.true./
@ -195,18 +213,34 @@ subroutine fivehztx
ncall=-1
fsample=11025.d0
nsec0=-999
u=0.1d0
u=0.05d0
mfsample2=110250
tt0=tt
filled=.false.
endif
! Measure average sampling frequency over a recent interval
ncall=ncall+1
if(ncall.eq.9) tt0=tt
if(ncall.ge.10 .and. mod(ncall,2).eq.1) then
fs=(ncall-9)*2048.d0/(tt-tt0)
fsample=u*fs + (1.d0-u)*fsample
mfsample2=nint(10.d0*fsample)
if(ncall.eq.9) then
tt0=tt
ntt0=0
ntt1=0
tt1(ntt1)=tt
endif
if(ncall.ge.10) then
ntt1=iand(ntt1+1,NTRING-1)
tt1(ntt1)=tt
if(ntt1.eq.NTRING-1) filled=.true.
if(filled) ntt0=iand(ntt1+1,NTRING-1)
if(mod(ncall,2).eq.1) then
nd=ntt1-ntt0
if(nd.lt.0) nd=nd+NTRING
fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0))
fsample=u*fs + (1.d0-u)*fsample
mfsample2=nint(10.d0*fsample)
endif
endif
return
end subroutine fivehztx

3
gcom2.f90
View File

@ -20,6 +20,7 @@ integer nrestart !True if transmission should restart GUI,SoundIn
integer ntr !Are we in 2nd sequence? SoundIn
integer nmsg !Length of Tx message SoundIn
integer nsave !Which files to save? GUI
integer nadd5 !Prepend 5 sec of 0's before decoding? GUI
integer dftolerance !DF tolerance (Hz) GUI
logical LDecoded !Was a message decoded? Decoder
logical rxdone !Has the Rx sequence finished? SoundIn,Decoder
@ -85,7 +86,7 @@ character*12 pttport
common/gcom2/ps0(431),psavg(450),s2(64,3100),ccf(-5:540), &
green(500),ngreen,dgain,iter,ndecoding,ndecoding0,mousebutton, &
ndecdone,npingtime,ierr,lauto,mantx,nrestart,ntr,nmsg,nsave, &
ndecdone,npingtime,ierr,lauto,mantx,nrestart,ntr,nmsg,nsave,nadd5, &
dftolerance,LDecoded,rxdone,monitoring,nzap,nsavecum,minsigdb, &
nclearave,nfreeze,nafc,nmode,mode65,nclip,ndebug,nblank,nport, &
mousedf,neme,nsked,naggressive,ntx2,nslim2,nagain,nsavelast, &

160
gencw.f
View File

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

2
getpfx2.f
View File

@ -10,7 +10,7 @@
if(k.ge.1 .and. k.le.NZ) then
iz=index(pfx(k),' ') - 1
callsign=pfx(k)(1:iz)//'/'//callsign
else if(k.ge.401 .and. k.le.411) then
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

19
jtaudio.c
View File

@ -1,5 +1,10 @@
#include <stdio.h>
#include <portaudio.h>
#include <string.h>
void fivehz_();
void fivehztx_();
void addnoise_(short int *n);
// Definition of structure pointing to the audio data
typedef struct
@ -66,7 +71,6 @@ static int SoundIn( void *inputBuffer, void *outputBuffer,
{
paTestData *data = (paTestData*)userData;
short *in = (short*)inputBuffer;
short *wptr = (short*)outputBuffer;
unsigned int i;
static int n0;
static int ia=0;
@ -99,8 +103,8 @@ static int SoundIn( void *inputBuffer, void *outputBuffer,
// if((inputBuffer==NULL) & (ncall>2) & (stime>stime0)) {
if((statusFlags!=0) & (ncall>2) & (stime>stime0)) {
if(*data->ndebug)
printf("Status flags %d at Tsec = %7.1f s, DT = %7.1f\n",stime,
stime-stime0);
printf("Status flags %d at Tsec = %7.1f s, DT = %7.1f\n",
statusFlags,stime,stime-stime0);
stime0=stime;
}
@ -134,7 +138,6 @@ static int SoundOut( void *inputBuffer, void *outputBuffer,
void *userData )
{
paTestData *data = (paTestData*)userData;
short *in = (short*)inputBuffer;
short *wptr = (short*)outputBuffer;
unsigned int i,n;
static short int n2;
@ -202,9 +205,9 @@ int jtaudio_(int *ndevin, int *ndevout, short y1[], short y2[],
PaStream *outstream;
PaStreamParameters inputParameters;
PaStreamParameters outputParameters;
PaStreamInfo *streamInfo;
// PaStreamInfo *streamInfo;
int i,nfs,ndin,ndout;
int nfs,ndin,ndout;
PaError err1,err2,err2a,err3,err3a;
double dnfs;
@ -318,11 +321,11 @@ error:
int padevsub_(int *numdev, int *ndefin, int *ndefout,
int nchin[], int nchout[])
{
int i,j,n;
int i;
int numDevices;
const PaDeviceInfo *pdi;
PaError err;
PaHostApiInfo *hostapi;
// PaHostApiInfo *hostapi;
Pa_Initialize();

256
longx.f
View File

@ -1,128 +1,128 @@
subroutine longx(dat,npts0,ps,DFTolerance,noffset,
+ msg,msglen,bauderr,MouseButton)
C Look for 441-baud modulation, synchronize to it, and decode message.
C Longest allowed data analysis is 1 second.
parameter (NMAX=11025)
parameter (NDMAX=NMAX/25)
real dat(npts0)
real ps(128),psmo(20)
integer DFTolerance
real y1(NMAX)
real y2(NMAX)
real y3(NMAX)
real y4(NMAX)
real wgt(-2:2)
integer dit(NDMAX)
integer n4(0:2)
character msg*40
character c*48
common/acom/a1,a2,a3,a4
data c/' 123456789.,?/# $ABCD FGHIJKLMNOPQRSTUVWXY 0EZ '/
data wgt/1.0,4.0,6.0,4.0,1.0/
NSPD=25 !Change if FSK110 is implemented
LTone=2
NBaud=11025/NSPD
npts=min(NMAX,npts0)
df=11025.0/256.0
smax=0.
C Find the frequency offset of this ping.
C NB: this might be improved by including a bandpass correction to ps.
ia=nint((LTone*NBaud-DFTolerance)/df)
ib=nint((LTone*NBaud+DFTolerance)/df)
do i=ia,ib !Search for correct DF
sum=0.
do j=1,4 !Sum over the 4 tones
m=nint((i*df+(j-1)*NBaud)/df)
do k=-2,2 !Weighted averages over 5 bins
sum=sum+wgt(k)*ps(m+k)
enddo
enddo
k=i-ia+1
psmo(k)=sum
kpk=0
if(sum.gt.smax) then
smax=sum
noffset=nint(i*df-LTone*NBaud)
kpk=k
endif
enddo
if(kpk.gt.1 .and. kpk.lt.20) then
call peakup(psmo(kpk-1),psmo(kpk),psmo(kpk+1),dx)
noffset=nint(noffset+dx*df)
endif
C Do square-law detection in each of four filters.
f1=LTone*NBaud+noffset
f2=(LTone+1)*NBaud+noffset
f3=(LTone+2)*NBaud+noffset
f4=(LTone+3)*NBaud+noffset
call detect(dat,npts,f1,y1)
call detect(dat,npts,f2,y2)
call detect(dat,npts,f3,y3)
call detect(dat,npts,f4,y4)
C Bandpass correction:
npts=npts-(NSPD-1)
do i=1,npts
y1(i)=y1(i)*a1
y2(i)=y2(i)*a2
y3(i)=y3(i)*a3
y4(i)=y4(i)*a4
enddo
call sync(y1,y2,y3,y4,npts,jpk,baud,bauderr)
C Decimate y arrays by NSPD
ndits=npts/NSPD - 1
do i=1,ndits
y1(i)=y1(jpk+(i-1)*NSPD)
y2(i)=y2(jpk+(i-1)*NSPD)
y3(i)=y3(jpk+(i-1)*NSPD)
y4(i)=y4(jpk+(i-1)*NSPD)
enddo
C Now find the mod3 phase that has no tone 3's
n4(0)=0
n4(1)=0
n4(2)=0
do i=1,ndits
ymax=max(y1(i),y2(i),y3(i),y4(i))
if(y1(i).eq.ymax) dit(i)=0
if(y2(i).eq.ymax) dit(i)=1
if(y3(i).eq.ymax) dit(i)=2
if(y4(i).eq.ymax) then
dit(i)=3
k=mod(i,3)
n4(k)=n4(k)+1
endif
enddo
n4min=min(n4(0),n4(1),n4(2))
if(n4min.eq.n4(0)) jsync=3
if(n4min.eq.n4(1)) jsync=1
if(n4min.eq.n4(2)) jsync=2
C Might want to notify if n4min>0 or if one of the others is equal
C to n4min. In both cases, could then decode 2 or 3 times, using
C other starting phases.
C Finally, decode the message.
msg=' '
msglen=ndits/3
msglen=min(msglen,40)
do i=1,msglen
j=(i-1)*3+jsync
nc=16*dit(j) + 4*dit(j+1) +dit(j+2)
msg(i:i)=' '
if(nc.le.47) msg(i:i)=c(nc+1:nc+1)
enddo
return
end
subroutine longx(dat,npts0,ps,DFTolerance,noffset,
+ msg,msglen,bauderr)
C Look for 441-baud modulation, synchronize to it, and decode message.
C Longest allowed data analysis is 1 second.
parameter (NMAX=11025)
parameter (NDMAX=NMAX/25)
real dat(npts0)
real ps(128),psmo(20)
integer DFTolerance
real y1(NMAX)
real y2(NMAX)
real y3(NMAX)
real y4(NMAX)
real wgt(-2:2)
integer dit(NDMAX)
integer n4(0:2)
character msg*40
character c*48
common/acom/a1,a2,a3,a4
data c/' 123456789.,?/# $ABCD FGHIJKLMNOPQRSTUVWXY 0EZ '/
data wgt/1.0,4.0,6.0,4.0,1.0/
NSPD=25 !Change if FSK110 is implemented
LTone=2
NBaud=11025/NSPD
npts=min(NMAX,npts0)
df=11025.0/256.0
smax=0.
C Find the frequency offset of this ping.
C NB: this might be improved by including a bandpass correction to ps.
ia=nint((LTone*NBaud-DFTolerance)/df)
ib=nint((LTone*NBaud+DFTolerance)/df)
do i=ia,ib !Search for correct DF
sum=0.
do j=1,4 !Sum over the 4 tones
m=nint((i*df+(j-1)*NBaud)/df)
do k=-2,2 !Weighted averages over 5 bins
sum=sum+wgt(k)*ps(m+k)
enddo
enddo
k=i-ia+1
psmo(k)=sum
kpk=0
if(sum.gt.smax) then
smax=sum
noffset=nint(i*df-LTone*NBaud)
kpk=k
endif
enddo
if(kpk.gt.1 .and. kpk.lt.20) then
call peakup(psmo(kpk-1),psmo(kpk),psmo(kpk+1),dx)
noffset=nint(noffset+dx*df)
endif
C Do square-law detection in each of four filters.
f1=LTone*NBaud+noffset
f2=(LTone+1)*NBaud+noffset
f3=(LTone+2)*NBaud+noffset
f4=(LTone+3)*NBaud+noffset
call detect(dat,npts,f1,y1)
call detect(dat,npts,f2,y2)
call detect(dat,npts,f3,y3)
call detect(dat,npts,f4,y4)
C Bandpass correction:
npts=npts-(NSPD-1)
do i=1,npts
y1(i)=y1(i)*a1
y2(i)=y2(i)*a2
y3(i)=y3(i)*a3
y4(i)=y4(i)*a4
enddo
call sync(y1,y2,y3,y4,npts,jpk,baud,bauderr)
C Decimate y arrays by NSPD
ndits=npts/NSPD - 1
do i=1,ndits
y1(i)=y1(jpk+(i-1)*NSPD)
y2(i)=y2(jpk+(i-1)*NSPD)
y3(i)=y3(jpk+(i-1)*NSPD)
y4(i)=y4(jpk+(i-1)*NSPD)
enddo
C Now find the mod3 phase that has no tone 3's
n4(0)=0
n4(1)=0
n4(2)=0
do i=1,ndits
ymax=max(y1(i),y2(i),y3(i),y4(i))
if(y1(i).eq.ymax) dit(i)=0
if(y2(i).eq.ymax) dit(i)=1
if(y3(i).eq.ymax) dit(i)=2
if(y4(i).eq.ymax) then
dit(i)=3
k=mod(i,3)
n4(k)=n4(k)+1
endif
enddo
n4min=min(n4(0),n4(1),n4(2))
if(n4min.eq.n4(0)) jsync=3
if(n4min.eq.n4(1)) jsync=1
if(n4min.eq.n4(2)) jsync=2
C Might want to notify if n4min>0 or if one of the others is equal
C to n4min. In both cases, could then decode 2 or 3 times, using
C other starting phases.
C Finally, decode the message.
msg=' '
msglen=ndits/3
msglen=min(msglen,40)
do i=1,msglen
j=(i-1)*3+jsync
nc=16*dit(j) + 4*dit(j+1) +dit(j+2)
msg(i:i)=' '
if(nc.le.47) msg(i:i)=c(nc+1:nc+1)
enddo
return
end

296
mtdecode.f
View File

@ -1,149 +1,147 @@
subroutine mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth,
+ NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum,
+ cfile6,ps0)
C Decode Multi-Tone FSK441 mesages.
real dat(jz) !Raw audio data
real s2(nchan,nz) !2d spectrum of data
integer NQRN
integer DFTolerance
logical pick
character*6 cfile6,cf*1
real sigdb(3100) !Detected signal in dB, sampled at 20 ms
real work(3100)
integer indx(3100)
real pingdat(3,100)
real ps(128)
real ps0(128)
character msg*40,msg3*3
character*90 line
common/ccom/nline,tping(100),line(100)
slim=MinSigdB
wmin=0.001*MinWidth * (19.95/20.0)
nf1=-DFTolerance
nf2=DFTolerance
msg3=' '
nq=64
dt=1.0/11025.0
df=11025.0/256.0
C Find signal power at suitable intervals to search for pings.
istep=221
dtbuf=istep/11025.
do n=1,nz
s=0.
ib=n*istep
ia=ib-istep+1
do i=ia,ib
s=s+dat(i)**2
enddo
sigdb(n)=s/istep
enddo
!#####################################################################
if(.not.pick) then
! Remove initial transient from sigdb
call indexx(nz,sigdb,indx)
imax=0
do i=1,50
if(indx(i).gt.50) go to 10
imax=max(imax,indx(i))
enddo
10 do i=1,50
if(indx(nz+1-i).gt.50) go to 20
imax=max(imax,indx(nz+1-i))
enddo
20 imax=imax+6 !Safety margin
base1=sigdb(indx(nz/2))
do i=1,imax
sigdb(i)=base1
enddo
endif
!##################################################################
call smooth(sigdb,nz)
C Remove baseline and one dB for good measure.
call pctile (sigdb,work,nz,50,base1)
do i=1,nz
sigdb(i)=dB(sigdb(i)/base1) - 1.0
enddo
call ping(sigdb,nz,dtbuf,slim,wmin,pingdat,nping)
C If this is a "mouse pick" and no ping was found, force a pseudo-ping
C at center of data.
if(pick.and.nping.eq.0) then
if(nping.le.99) nping=nping+1
pingdat(1,nping)=0.5*jz*dt
pingdat(2,nping)=0.16
pingdat(3,nping)=1.0
endif
bigpeak=0.
do iping=1,nping
C Find starting place and length of data to be analyzed:
tstart=pingdat(1,iping)
width=pingdat(2,iping)
peak=pingdat(3,iping)
mswidth=10*nint(100.0*width)
jj=(tstart-0.02)/dt
if(jj.lt.1) jj=1
jjz=nint((width+0.02)/dt)+1
jjz=min(jjz,jz+1-jj)
C Compute average spectrum of this ping.
call spec441(dat(jj),jjz,ps,f0)
C Decode the message.
msg=' '
call longx(dat(jj),jjz,ps,DFTolerance,noffset,msg,
+ msglen,bauderr,MouseButton)
qrnlimit=4.4*1.5**(5.0-NQRN)
if(NQRN.eq.0) qrnlimit=99.
if(msglen.eq.0) go to 100
C Assemble a signal report:
nwidth=0
if(width.ge.0.04) nwidth=1 !These might depend on NSPD
if(width.ge.0.12) nwidth=2
if(width.gt.1.00) nwidth=3
nstrength=6
if(peak.ge.11.0) nstrength=7
if(peak.ge.17.0) nstrength=8
if(peak.ge.23.0) nstrength=9
! if(peak.gt.5.0 .and.mswidth.ge.100) then
! call specsq(dat(jj),jjz,DFTolerance,0,noffset2)
! noffset=noffset2
! endif
C Discard this ping if DF outside tolerance limits or bauderr too big.
C (However, if the ping was mouse-picked, proceed anyway.)
if(.not.pick .and. ((noffset.lt.nf1 .or. noffset.gt.nf2) .or.
+ (abs(bauderr).gt.qrnlimit))) goto 100
C If it's the best ping yet, save the spectrum:
if(peak.gt.bigpeak) then
bigpeak=peak
do i=1,128
ps0(i)=ps(i)
enddo
endif
tstart=tstart + dt*(istart-1)
cf=' '
if(nline.le.99) nline=nline+1
tping(nline)=tstart
snr=10.0*log10(10.0**(0.1*peak)-1.0)
write(line(nline),1050) cfile6,tstart,mswidth,int(peak),
+ nwidth,nstrength,noffset,msg3,msg,cf
1050 format(a6,f5.1,i5,i3,1x,2i1,i5,1x,a3,1x,a40,1x,a1)
100 enddo
return
end
subroutine mtdecode(dat,jz,nz,MinSigdB,MinWidth,
+ NQRN,DFTolerance,istart,pick,cfile6,ps0)
C Decode Multi-Tone FSK441 mesages.
real dat(jz) !Raw audio data
integer NQRN
integer DFTolerance
logical pick
character*6 cfile6,cf*1
real sigdb(3100) !Detected signal in dB, sampled at 20 ms
real work(3100)
integer indx(3100)
real pingdat(3,100)
real ps(128)
real ps0(128)
character msg*40,msg3*3
character*90 line
common/ccom/nline,tping(100),line(100)
slim=MinSigdB
wmin=0.001*MinWidth * (19.95/20.0)
nf1=-DFTolerance
nf2=DFTolerance
msg3=' '
nq=64
dt=1.0/11025.0
df=11025.0/256.0
C Find signal power at suitable intervals to search for pings.
istep=221
dtbuf=istep/11025.
do n=1,nz
s=0.
ib=n*istep
ia=ib-istep+1
do i=ia,ib
s=s+dat(i)**2
enddo
sigdb(n)=s/istep
enddo
!#####################################################################
if(.not.pick) then
! Remove initial transient from sigdb
call indexx(nz,sigdb,indx)
imax=0
do i=1,50
if(indx(i).gt.50) go to 10
imax=max(imax,indx(i))
enddo
10 do i=1,50
if(indx(nz+1-i).gt.50) go to 20
imax=max(imax,indx(nz+1-i))
enddo
20 imax=imax+6 !Safety margin
base1=sigdb(indx(nz/2))
do i=1,imax
sigdb(i)=base1
enddo
endif
!##################################################################
call smooth(sigdb,nz)
C Remove baseline and one dB for good measure.
call pctile (sigdb,work,nz,50,base1)
do i=1,nz
sigdb(i)=dB(sigdb(i)/base1) - 1.0
enddo
call ping(sigdb,nz,dtbuf,slim,wmin,pingdat,nping)
C If this is a "mouse pick" and no ping was found, force a pseudo-ping
C at center of data.
if(pick.and.nping.eq.0) then
if(nping.le.99) nping=nping+1
pingdat(1,nping)=0.5*jz*dt
pingdat(2,nping)=0.16
pingdat(3,nping)=1.0
endif
bigpeak=0.
do iping=1,nping
C Find starting place and length of data to be analyzed:
tstart=pingdat(1,iping)
width=pingdat(2,iping)
peak=pingdat(3,iping)
mswidth=10*nint(100.0*width)
jj=(tstart-0.02)/dt
if(jj.lt.1) jj=1
jjz=nint((width+0.02)/dt)+1
jjz=min(jjz,jz+1-jj)
C Compute average spectrum of this ping.
call spec441(dat(jj),jjz,ps,f0)
C Decode the message.
msg=' '
call longx(dat(jj),jjz,ps,DFTolerance,noffset,msg,
+ msglen,bauderr)
qrnlimit=4.4*1.5**(5.0-NQRN)
if(NQRN.eq.0) qrnlimit=99.
if(msglen.eq.0) go to 100
C Assemble a signal report:
nwidth=0
if(width.ge.0.04) nwidth=1 !These might depend on NSPD
if(width.ge.0.12) nwidth=2
if(width.gt.1.00) nwidth=3
nstrength=6
if(peak.ge.11.0) nstrength=7
if(peak.ge.17.0) nstrength=8
if(peak.ge.23.0) nstrength=9
! if(peak.gt.5.0 .and.mswidth.ge.100) then
! call specsq(dat(jj),jjz,DFTolerance,0,noffset2)
! noffset=noffset2
! endif
C Discard this ping if DF outside tolerance limits or bauderr too big.
C (However, if the ping was mouse-picked, proceed anyway.)
if(.not.pick .and. ((noffset.lt.nf1 .or. noffset.gt.nf2) .or.
+ (abs(bauderr).gt.qrnlimit))) goto 100
C If it's the best ping yet, save the spectrum:
if(peak.gt.bigpeak) then
bigpeak=peak
do i=1,128
ps0(i)=ps(i)
enddo
endif
tstart=tstart + dt*(istart-1)
cf=' '
if(nline.le.99) nline=nline+1
tping(nline)=tstart
snr=10.0*log10(10.0**(0.1*peak)-1.0)
write(line(nline),1050) cfile6,tstart,mswidth,int(peak),
+ nwidth,nstrength,noffset,msg3,msg,cf
1050 format(a6,f5.1,i5,i3,1x,2i1,i5,1x,a3,1x,a40,1x,a1)
100 enddo
return
end

4
pfx.f
View File

@ -1,9 +1,9 @@
parameter (NZ=338) !Total number of prefixes
parameter (NZ2=11) !Total number of suffixes
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'/
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 ',

6
spec.f90
View File

@ -11,13 +11,7 @@ subroutine spec(brightness,contrast,logmap,ngain,nspeed,a)
! Output:
integer*2 a(225000) !Pixel values for 750 x 300 array
real psa(750) !Grand average spectrum
real ref(750) !Ref spect: smoothed ave of lower half
real birdie(750) !Spec (with birdies) for plot, in dB
real variance(750) !Variance in each spectral channel
real a0(225000) !Save the last 300 spectra
integer*2 idat(11025) !Sound data, read from file
integer nstep(5)
integer b0,c0
real x(4096) !Data for FFT

351
sync65.f
View File

@ -1,176 +1,175 @@
subroutine sync65(dat,jz,DFTolerance,NFreeze,NAFC,MouseDF,
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
C Synchronizes JT65 data, finding the best-fit DT and DF.
C NB: at this stage, submodes ABC are processed in the same way.
parameter (NP2=60*11025) !Size of data array
parameter (NFFTMAX=2048) !Max length of FFTs
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
parameter (NSMAX=320) !Max number of half-symbol steps
integer DFTolerance !Range of DF search
real dat(jz)
real psavg(NHMAX) !Average spectrum of whole record
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real ccfblue(-5:540) !CCF with pseudorandom sequence
real ccfred(-224:224) !Peak of ccfblue, as function of freq
real tmp(450)
integer itry(100)
save
C Do FFTs of symbol length, stepped by half symbols. Note that we have
C already downsampled the data by factor of 2.
nsym=126
nfft=2048
nsteps=2*jz/nfft - 1
nh=nfft/2
df=0.5*11025.0/nfft
C Compute power spectrum for each step and get average
call zero(psavg,nh)
do j=1,nsteps
k=(j-1)*nh + 1
call limit(dat(k),nfft)
call ps(dat(k),nfft,s2(1,j))
if(mode65.eq.4) call smooth(s2(1,j),nh)
call add(psavg,s2(1,j),psavg,nh)
enddo
call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra
C Find the best frequency channel for CCF
famin= 670.46
fbmax=1870.46
! famin=200
! fbmax=3800
fa=famin
fb=fbmax
if(NFreeze.eq.1) then
fa=max(famin,1270.46+MouseDF-DFTolerance)
fb=min(fbmax,1270.46+MouseDF+DFTolerance)
endif
ia=fa/df
ib=fb/df
i0=nint(1270.46/df)
ired0=ia-i0
ired1=ib-i0
lag1=-5
lag2=59
syncbest=-1.e30
syncbest2=-1.e30
call zero(ccfred,449)
do i=ia,ib
call xcor(s2,i,nsteps,nsym,lag1,lag2,
+ ccfblue,ccf0,lagpk0,flip,0.0)
j=i-i0
if(j.ge.-224 .and. j.le.224) ccfred(j)=ccf0
C Find rms of the CCF, without the main peak
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
sync=abs(ccfblue(lagpk0))
ppmax=psavg(i)-1.0
C Find the best sync value
if(sync.gt.syncbest2) then
ipk2=i
lagpk2=lagpk0
syncbest2=sync
flippk2=flip
endif
C We are most interested if snrx will be more than -30 dB.
if(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0
if(sync.gt.syncbest) then
ipk=i
lagpk=lagpk0
syncbest=sync
flippk=flip
endif
endif
enddo
C If we found nothing with snrx > -30 dB, take the best sync that *was* found.
if(syncbest.lt.-10.) then
ipk=ipk2
lagpk=lagpk2
syncbest=syncbest2
flippk=flippk2
endif
C Peak up in frequency to fraction of channel
base=0.25*(psavg(ipk-3)+psavg(ipk-2)+psavg(ipk+2)+psavg(ipk+3))
! call peakup(psavg(ipk-1),psavg(ipk),psavg(ipk+1),dx)
! if(dx.lt.-1.0) dx=-1.0
! if(dx.gt.1.0) dx=1.0
dx=0.
dfx=(ipk+dx-i0)*df
C Peak up in time, at best whole-channel frequency
call xcor(s2,ipk,nsteps,nsym,lag1,lag2,
+ ccfblue,ccfmax,lagpk,flip,0.0)
xlag=lagpk
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
xlag=lagpk+dx2
endif
C Find rms of the CCF, without the main peak
call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0)
sq=0.
nsq=0
do lag=lag1,lag2
if(abs(lag-xlag).gt.2.0) then
sq=sq+ccfblue(lag)**2
nsq=nsq+1
endif
enddo
rms=sqrt(sq/nsq)
snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical
dt=2.0/11025.0
istart=xlag*nh
dtx=istart*dt
snrx=-99.0
! ppmax=psavg(ipk)/base-1.0
ppmax=psavg(ipk)-1.0
C Plus 3 dB because sync tone is on half the time. (Don't understand
C why an additional +2 dB is needed ...)
if(ppmax.gt.0.0001) snrx=db(ppmax*df/2500.0) + 5.0 !###
if(mode65.eq.4) snrx=snrx + 2.0
if(snrx.lt.-33.0) snrx=-33.0
C Compute width of sync tone to outermost -3 dB points
call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base)
jpk=ipk-i0
stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB
do i=-10,0
if(jpk+i.ge.-223) then
if(ccfred(jpk+i).gt.stest) go to 30
endif
enddo
i=0
30 x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1))
do i=10,0,-1
if(jpk+i.le.223) then
if(ccfred(jpk+i).gt.stest) go to 32
endif
enddo
i=0
32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1))
width=x2-x1
if(width.gt.1.2) width=sqrt(width**2 - 1.44)
width=df*width
width=max(0.0,min(99.0,width))
ic=600/df
nn=1800/df
nred=448
return
end
subroutine sync65(dat,jz,DFTolerance,NFreeze,MouseDF,
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
C Synchronizes JT65 data, finding the best-fit DT and DF.
C NB: at this stage, submodes ABC are processed in the same way.
parameter (NP2=60*11025) !Size of data array
parameter (NFFTMAX=2048) !Max length of FFTs
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
parameter (NSMAX=320) !Max number of half-symbol steps
integer DFTolerance !Range of DF search
real dat(jz)
real psavg(NHMAX) !Average spectrum of whole record
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real ccfblue(-5:540) !CCF with pseudorandom sequence
real ccfred(-224:224) !Peak of ccfblue, as function of freq
real tmp(450)
save
C Do FFTs of symbol length, stepped by half symbols. Note that we have
C already downsampled the data by factor of 2.
nsym=126
nfft=2048
nsteps=2*jz/nfft - 1
nh=nfft/2
df=0.5*11025.0/nfft
C Compute power spectrum for each step and get average
call zero(psavg,nh)
do j=1,nsteps
k=(j-1)*nh + 1
call limit(dat(k),nfft)
call ps(dat(k),nfft,s2(1,j))
if(mode65.eq.4) call smooth(s2(1,j),nh)
call add(psavg,s2(1,j),psavg,nh)
enddo
call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra
C Find the best frequency channel for CCF
famin= 670.46
fbmax=1870.46
! famin=200
! fbmax=3800
fa=famin
fb=fbmax
if(NFreeze.eq.1) then
fa=max(famin,1270.46+MouseDF-DFTolerance)
fb=min(fbmax,1270.46+MouseDF+DFTolerance)
endif
ia=fa/df
ib=fb/df
i0=nint(1270.46/df)
ired0=ia-i0
ired1=ib-i0
lag1=-5
lag2=59
syncbest=-1.e30
syncbest2=-1.e30
call zero(ccfred,449)
do i=ia,ib
call xcor(s2,i,nsteps,nsym,lag1,lag2,
+ ccfblue,ccf0,lagpk0,flip,0.0)
j=i-i0
if(j.ge.-224 .and. j.le.224) ccfred(j)=ccf0
C Find rms of the CCF, without the main peak
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
sync=abs(ccfblue(lagpk0))
ppmax=psavg(i)-1.0
C Find the best sync value
if(sync.gt.syncbest2) then
ipk2=i
lagpk2=lagpk0
syncbest2=sync
flippk2=flip
endif
C We are most interested if snrx will be more than -30 dB.
if(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0
if(sync.gt.syncbest) then
ipk=i
lagpk=lagpk0
syncbest=sync
flippk=flip
endif
endif
enddo
C If we found nothing with snrx > -30 dB, take the best sync that *was* found.
if(syncbest.lt.-10.) then
ipk=ipk2
lagpk=lagpk2
syncbest=syncbest2
flippk=flippk2
endif
C Peak up in frequency to fraction of channel
base=0.25*(psavg(ipk-3)+psavg(ipk-2)+psavg(ipk+2)+psavg(ipk+3))
! call peakup(psavg(ipk-1),psavg(ipk),psavg(ipk+1),dx)
! if(dx.lt.-1.0) dx=-1.0
! if(dx.gt.1.0) dx=1.0
dx=0.
dfx=(ipk+dx-i0)*df
C Peak up in time, at best whole-channel frequency
call xcor(s2,ipk,nsteps,nsym,lag1,lag2,
+ ccfblue,ccfmax,lagpk,flip,0.0)
xlag=lagpk
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
xlag=lagpk+dx2
endif
C Find rms of the CCF, without the main peak
call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0)
sq=0.
nsq=0
do lag=lag1,lag2
if(abs(lag-xlag).gt.2.0) then
sq=sq+ccfblue(lag)**2
nsq=nsq+1
endif
enddo
rms=sqrt(sq/nsq)
snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical
dt=2.0/11025.0
istart=xlag*nh
dtx=istart*dt
snrx=-99.0
! ppmax=psavg(ipk)/base-1.0
ppmax=psavg(ipk)-1.0
C Plus 3 dB because sync tone is on half the time. (Don't understand
C why an additional +2 dB is needed ...)
if(ppmax.gt.0.0001) snrx=db(ppmax*df/2500.0) + 5.0 !###
if(mode65.eq.4) snrx=snrx + 2.0
if(snrx.lt.-33.0) snrx=-33.0
C Compute width of sync tone to outermost -3 dB points
call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base)
jpk=ipk-i0
stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB
do i=-10,0
if(jpk+i.ge.-223) then
if(ccfred(jpk+i).gt.stest) go to 30
endif
enddo
i=0
30 x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1))
do i=10,0,-1
if(jpk+i.le.223) then
if(ccfred(jpk+i).gt.stest) go to 32
endif
enddo
i=0
32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1))
width=x2-x1
if(width.gt.1.2) width=sqrt(width**2 - 1.44)
width=df*width
width=max(0.0,min(99.0,width))
ic=600/df
nn=1800/df
nred=448
return
end

35
wsjt.py
View File

@ -884,22 +884,16 @@ def decdsec(event):
ldsec.configure(text='Dsec '+str(0.1*idsec),bg=bg)
Audio.gcom1.ndsec=idsec
###------------------------------------------------------ incrdsec
##def incrdsec(event):
## global irdsec
## irdsec=irdsec+5
## bg='red'
## if irdsec==0: bg='white'
## lrdsec.configure(text='RDsec '+str(0.1*irdsec),bg=bg)
##
###------------------------------------------------------ decrdsec
##def decrdsec(event):
## global irdsec
## irdsec=irdsec-5
## bg='red'
## if irdsec==0: bg='white'
## lrdsec.configure(text='RDsec '+str(0.1*irdsec),bg=bg)
##
#------------------------------------------------------ toggle_shift
def toggle_shift(event):
Audio.gcom2.nadd5=1-Audio.gcom2.nadd5
if Audio.gcom2.nadd5:
bg='red'
lshift.configure(text='Shift 5.0',bg=bg)
else:
bg='white'
lshift.configure(text='Shift 0.0',bg=bg)
#------------------------------------------------------ inctrperiod
def inctrperiod(event):
global ncwtrperiod
@ -1874,14 +1868,11 @@ Button(f5b,text='Defaults',command=defaults,padx=1,pady=1).grid(column=0,
row=3,sticky='EW')
ldsec=Label(f5b, bg='white', fg='black', text='Dsec 0.0', width=8, relief=RIDGE)
ldsec.grid(column=0,row=4,ipadx=3,padx=2,pady=5,sticky='EW')
#lrdsec=Label(f5b, bg='white', fg='black', text='RDsec 0.0', width=8, relief=RIDGE)
#lrdsec.grid(column=1,row=4,ipadx=3,padx=2,pady=5,sticky='EW')
lshift=Label(f5b, bg='white', fg='black', text='Shift 0.0', width=8, relief=RIDGE)
lshift.grid(column=1,row=4,ipadx=3,padx=2,pady=5,sticky='EW')
Widget.bind(ldsec,'<Button-1>',incdsec)
Widget.bind(ldsec,'<Button-3>',decdsec)
#Widget.bind(lrdsec,'<Button-1>',incrdsec)
#Widget.bind(lrdsec,'<Button-3>',decrdsec)
#Widget.bind(lrdsec,'<Button-1>',stub)
#Widget.bind(lrdsec,'<Button-3>',stub)
Widget.bind(lshift,'<Button-1>',toggle_shift)
f5b.pack(side=LEFT,expand=0,fill=BOTH)

660
wsjt1.F
View File

@ -1,335 +1,325 @@
subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB,
+ NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve,
+ Mode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65,
+ MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2,
+ ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg,
+ MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
parameter (NP2=1024*1024)
integer*2 d(jz0) !Buffer for raw one-byte data
integer istart !Starting location in original d() array
character FileID*40 !Name of file being processed
integer MinSigdB !Minimum ping strength, dB
integer NQRN !QRN rejection parameter
integer DFTolerance !Defines DF search range
integer NSaveCum !Set to 1 if cumulative file is to be saved
integer NSyncOK !Set to 1 if JT65 file synchronized OK
character AppDir*80 !Installation directory for WSJT
character*12 utcdate
character*12 mycall
character*12 hiscall
character*6 hisgrid
real ps0(431) !Spectrum of best ping
integer npkept !Number of pings kept and decoded
integer lumsg !Logical unit for decoded.txt
real basevb !Baseline signal level, dB
integer nslim2 !Minimum strength for single-tone pings, dB
real psavg(450) !Average spectrum of the whole file
integer Nseg !First or second Tx sequence?
integer MouseDF !Freeze position for DF
logical pick !True if this is a mouse-picked ping
logical stbest !True if the best decode was Single-Tone
logical STfound !True if at least one ST decode
logical LDecoded !True if anything was decoded
real s2(64,3100) !2D spectral array
real ccf(-5:540) !X-cor function in JT65 mode (blue line)
real red(512)
real ss1(-224:224) !Magenta curve (for JT65 shorthands)
real ss2(-224:224) !Orange curve (for JT65 shorthands)
real yellow(216)
real yellow0(216)
real fzap(200)
integer resample
real*8 samfacin,samratio
real dat2(NP2)
integer*1 dtmp
character msg3*3
character cfile6*6
character fname*99,fcum*99
logical lcum
integer indx(100)
character*90 line
character*24 today
common/avecom/dat(NP2),labdat,jza,modea
common/avecom2/f0a
common/ccom/nline,tping(100),line(100)
common/limcom/ nslim2a
common/clipcom/ nclip
equivalence (dtmp,ntmp)
save
lcum=.true.
jz=jz0
modea=Mode
nclip=NQRN-5
nslim2a=nclip
MinWidth=40 !Minimum width of pings, ms
call zero(psavg,450)
rewind 11
rewind 12
do i=1,40
if(FileID(i:i).eq.'.') go to 3
enddo
i=4
3 ia=max(1,i-6)
cfile6=FileID(ia:i-1)
nline=0
ndiag=0
! If file "/wsjt.reg" exists, set ndiag=1
open(16,file='/wsjt.reg',status='old',err=4)
ndiag=1
close(16)
4 if(jz.gt.655360) jz=655360
if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this!
sum=0.
do j=1,jz !Convert raw data from i*2 to real, remove DC
dat(j)=0.1*d(j)
sum=sum + dat(j)
enddo
ave=sum/jz
samratio=1.d0/samfacin
if(samratio.eq.1.d0) then
do j=1,jz
dat(j)=dat(j)-ave
enddo
else
do j=1,jz
dat2(j)=dat(j)-ave
enddo
#if (USE_PORTAUDIO==1) || defined(Win32)
ierr=resample(dat2,dat,samratio,jz)
if(ierr.ne.0) print*,'Resample error.',samratio
#endif
endif
if(ndiag.ne.0 .and. nclip.lt.0) then
C Intentionally degrade SNR by -nclip dB.
sq=0.
do i=1,jz
sq=sq + dat(i)**2
enddo
p0=sq/jz
p1=p0*10.0**(-0.1*nclip)
dnoise=sqrt(4*(p1-p0))
idum=-1
do i=1,jz
dat(i)=dat(i) + dnoise*gran(idum)
enddo
endif
if(mode.ne.2 .and. nzap.ne.0) then
nfrz=NFreeze
if(mode.eq.1) nfrz=0
if(jz.gt.100000) call avesp2(dat,jz,2,f0a,mode,nfrz,MouseDF,
+ DFTolerance,fzap)
nadd=1
call bzap(dat,jz,nadd,mode,fzap)
endif
sq=0.
do j=1,jz !Compute power level for whole array
sq=sq + dat(j)**2
enddo
avesq=sq/jz
basevb=dB(avesq) - 44 !Base power level to send back to GUI
if(avesq.eq.0) go to 900
nz=600
nstep=jz/nz
sq=0.
k=0
do j=1,nz
sum=0.
do n=1,nstep
k=k+1
sum=sum+dat(k)**2
enddo
sum=sum/nstep
sq=sq + (sum-avesq)**2
enddo
rmspower=sqrt(sq/nz)
pick=.false.
if(istart.gt.1) pick=.true. !This is a mouse-picked decoding
if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900
nchan=64 !Save 64 spectral channels
nstep=221 !Set step size to ~20 ms
nz=jz/nstep - 1 !# of spectra to compute
if(.not.pick) then
MouseButton=0
jza=jz
labdat=labdat+1
endif
tbest=0.
NsyncOK=0
! If we're in JT65 mode, call the decode65 routines.
if(mode.eq.2) then
! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data
! Check for a JT65 shorthand message
nstest=0
if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF,
+ DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh,
+ idriftsh,snrsh,ss1,ss2,nwsh)
! Lowpass filter and decimate by 2
call lpf1(dat,jz,jz2)
jz=jz2
nadd=1
fzap(1)=0.
if(nzap.eq.1) call avesp2(dat,jz,nadd,f0a,mode,NFreeze,MouseDF,
+ DFTolerance,fzap)
if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap)
i=index(MyCall,char(0))
if(i.le.0) i=index(MyCall,' ')
mycall=MyCall(1:i-1)//' '
i=index(HisCall,char(0))
if(i.le.0) i=index(HisCall,' ')
hiscall=HisCall(1:i-1)//' '
! Offset data by about 1 s.
if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6,
+ NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg,
+ MouseDF,NAgain,ndepth,neme,nsked,
+ mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf,
+ nstest,dfsh,iderrsh,idriftsh,snrsh,
+ NSyncOK,ccf,psavg,ndiag,nwsh)
goto 900
endif
! If we're in JT6M mode, call the 6M decoding routines.
if(mode.eq.4) then
do i=1,jz !### Why is it level-sensitive?
dat(i)=dat(i)/25.0
enddo
! For waterfall plot
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
if(sigma.lt.0.0) basevb=-99.0
if(jz/11025.0.lt.3.9 .or. sigma.lt.0.0) go to 900
f0=1076.66
if(NFreeze.eq.1) f0=1076.66 + MouseDF
f00=f0
call syncf0(dat,jz,NFreeze,DFTolerance,jstart,f0,smax)
call synct(dat,jz,jstart,f0,smax)
call syncf1(dat,jz,jstart,f0,NFreeze,DFTolerance,smax,red)
f0a=f0
do i=1,512
ccf(i-6)=dB(red(i))
enddo
df=11025./256.
do i=1,64
sum=0.
do k=8*i-7,8*i
sum=sum+red(k)
enddo
psavg(i)=5.0*sum
fac=1.0
freq=i*df
if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0)
psavg(i)=fac*psavg(i)
psavg(i+64)=0.001
enddo
jz=jz-jstart+1
nslim=MinSigdB
NFixLen=0
C Call the decoder if DF is in range or Freeze is off.
if(NFreeze.eq.0 .or.
+ abs(f0-f00).lt.float(DFTolerance)) then
call decode6m(dat(jstart),jz,cfile6,nslim,istart,
+ NFixLen,lcum,f0,lumsg,npkept,yellow)
endif
if(npkept.eq.0) f0a=0.
if(pick) then
do i=1,216
ps0(i)=yellow0(i)
enddo
else
ps0(216)=yellow(216)
yellow0(216)=yellow(216)
do i=1,215
ps0(i)=2*yellow(i)
yellow0(i)=ps0(i)
enddo
endif
goto 800
endif
! We're in FSK441 mode. Compute the 2D spectrum.
df=11025.0/256.0 !FFT resolution ~43 Hz
dtbuf=nstep/11025.0
stlim=nslim2 !Single-tone threshold
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
if(sigma.lt.0.0) basevb=-99.0
if(sigma.lt.0.0) go to 900
nline0=nline
STfound=.false.
npkept=0
C Look for single-tone messages
if((.not.pick) .or. MouseButton.eq.1) then
call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim,
+ DFTolerance,cfile6,pick,istart)
endif
if(nline.gt.nline0) STfound=.true. !ST message(s) found
C Now the multi-tone decoding
call mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth,
+ NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum,
+ cfile6,ps0)
npkept=nline !Number of pings that were kept
smax=0.
stbest=.false.
if(npkept.gt.0) then
call indexx(npkept,tping,indx) !Merge the ST and MT decodes
do i=1,npkept
j=indx(i)
if(pick .and. STFound .and.
+ line(j)(29:31).eq.' ') goto 10
write(lumsg,1050) line(j) !Write to decoded.txt
1050 format(a79)
if(lcum) write(21,1050) line(j) !Write to ALL.TXT
read(line(j),1060) sig,msg3
1060 format(16x,f3.0,9x,a3)
if(sig.gt.smax) then
smax=sig
tbest=tping(j)
stbest = (msg3.ne.' ')
endif
10 enddo
endif
dt=1.0/11025.0 !Compute spectrum for pink curve
if(stbest) then
jj=nint(tbest/dt)
call spec441(dat(jj),1102,ps0,f0)
endif
800 continue
call s2shape(s2,nchan,nz,tbest)
900 LDecoded = ((NSyncOK.gt.0) .or. npkept.gt.0)
end file 11
call flushqqq(11)
call flushqqq(12)
call flushqqq(21)
return
end
subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB,
+ NQRN,DFTolerance,MouseButton,NClearAve,
+ Mode,NFreeze,NAFC,NZap,mode65,
+ MyCall,HisCall,HisGrid,neme,nsked,ntx2,s2,
+ ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg,
+ MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
parameter (NP2=1024*1024)
integer*2 d(jz0) !Buffer for raw one-byte data
integer istart !Starting location in original d() array
character FileID*40 !Name of file being processed
integer MinSigdB !Minimum ping strength, dB
integer NQRN !QRN rejection parameter
integer DFTolerance !Defines DF search range
integer NSyncOK !Set to 1 if JT65 file synchronized OK
character*12 mycall
character*12 hiscall
character*6 hisgrid
real ps0(431) !Spectrum of best ping
integer npkept !Number of pings kept and decoded
integer lumsg !Logical unit for decoded.txt
real basevb !Baseline signal level, dB
integer nslim2 !Minimum strength for single-tone pings, dB
real psavg(450) !Average spectrum of the whole file
integer Nseg !First or second Tx sequence?
integer MouseDF !Freeze position for DF
logical pick !True if this is a mouse-picked ping
logical stbest !True if the best decode was Single-Tone
logical STfound !True if at least one ST decode
logical LDecoded !True if anything was decoded
real s2(64,3100) !2D spectral array
real ccf(-5:540) !X-cor function in JT65 mode (blue line)
real red(512)
real ss1(-224:224) !Magenta curve (for JT65 shorthands)
real ss2(-224:224) !Orange curve (for JT65 shorthands)
real yellow(216)
real yellow0(216)
real fzap(200)
integer resample
real*8 samfacin,samratio
real dat2(NP2)
integer*1 dtmp
character msg3*3
character cfile6*6
logical lcum
integer indx(100)
character*90 line
common/avecom/dat(NP2),labdat,jza,modea
common/ccom/nline,tping(100),line(100)
common/limcom/ nslim2a
common/clipcom/ nclip
equivalence (dtmp,ntmp)
save
lcum=.true.
jz=jz0
modea=Mode
nclip=NQRN-5
nslim2a=nclip
MinWidth=40 !Minimum width of pings, ms
call zero(psavg,450)
rewind 11
rewind 12
do i=1,40
if(FileID(i:i).eq.'.') go to 3
enddo
i=4
3 ia=max(1,i-6)
cfile6=FileID(ia:i-1)
nline=0
ndiag=0
! If file "/wsjt.reg" exists, set ndiag=1
open(16,file='/wsjt.reg',status='old',err=4)
ndiag=1
close(16)
4 if(jz.gt.655360) jz=655360
if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this!
sum=0.
do j=1,jz !Convert raw data from i*2 to real, remove DC
dat(j)=0.1*d(j)
sum=sum + dat(j)
enddo
ave=sum/jz
samratio=1.d0/samfacin
if(samratio.eq.1.d0) then
do j=1,jz
dat(j)=dat(j)-ave
enddo
else
do j=1,jz
dat2(j)=dat(j)-ave
enddo
#if (USE_PORTAUDIO==1) || defined(Win32)
ierr=resample(dat2,dat,samratio,jz)
if(ierr.ne.0) print*,'Resample error.',samratio
#endif
endif
if(ndiag.ne.0 .and. nclip.lt.0) then
C Intentionally degrade SNR by -nclip dB.
sq=0.
do i=1,jz
sq=sq + dat(i)**2
enddo
p0=sq/jz
p1=p0*10.0**(-0.1*nclip)
dnoise=sqrt(4*(p1-p0))
idum=-1
do i=1,jz
dat(i)=dat(i) + dnoise*gran(idum)
enddo
endif
if(mode.ne.2 .and. nzap.ne.0) then
nfrz=NFreeze
if(mode.eq.1) nfrz=0
if(jz.gt.100000) call avesp2(dat,jz,2,mode,nfrz,MouseDF,
+ DFTolerance,fzap)
nadd=1
call bzap(dat,jz,nadd,mode,fzap)
endif
sq=0.
do j=1,jz !Compute power level for whole array
sq=sq + dat(j)**2
enddo
avesq=sq/jz
basevb=dB(avesq) - 44 !Base power level to send back to GUI
if(avesq.eq.0) go to 900
nz=600
nstep=jz/nz
sq=0.
k=0
do j=1,nz
sum=0.
do n=1,nstep
k=k+1
sum=sum+dat(k)**2
enddo
sum=sum/nstep
sq=sq + (sum-avesq)**2
enddo
rmspower=sqrt(sq/nz)
pick=.false.
if(istart.gt.1) pick=.true. !This is a mouse-picked decoding
if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900
nchan=64 !Save 64 spectral channels
nstep=221 !Set step size to ~20 ms
nz=jz/nstep - 1 !# of spectra to compute
if(.not.pick) then
MouseButton=0
jza=jz
labdat=labdat+1
endif
tbest=0.
NsyncOK=0
! If we're in JT65 mode, call the decode65 routines.
if(mode.eq.2) then
! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data
! Check for a JT65 shorthand message
nstest=0
if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF,
+ DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh,
+ idriftsh,snrsh,ss1,ss2,nwsh)
! Lowpass filter and decimate by 2
call lpf1(dat,jz,jz2)
jz=jz2
nadd=1
fzap(1)=0.
if(nzap.eq.1) call avesp2(dat,jz,nadd,mode,NFreeze,MouseDF,
+ DFTolerance,fzap)
if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap)
i=index(MyCall,char(0))
if(i.le.0) i=index(MyCall,' ')
mycall=MyCall(1:i-1)//' '
i=index(HisCall,char(0))
if(i.le.0) i=index(HisCall,' ')
hiscall=HisCall(1:i-1)//' '
! Offset data by about 1 s.
if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6,
+ NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg,
+ MouseDF,NAgain,ndepth,neme,nsked,
+ mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf,
+ nstest,dfsh,snrsh,
+ NSyncOK,ccf,psavg,ndiag,nwsh)
goto 900
endif
! If we're in JT6M mode, call the 6M decoding routines.
if(mode.eq.4) then
do i=1,jz !### Why is it level-sensitive?
dat(i)=dat(i)/25.0
enddo
! For waterfall plot
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
if(sigma.lt.0.0) basevb=-99.0
if(jz/11025.0.lt.3.9 .or. sigma.lt.0.0) go to 900
f0=1076.66
if(NFreeze.eq.1) f0=1076.66 + MouseDF
f00=f0
call syncf0(dat,jz,NFreeze,DFTolerance,jstart,f0,smax)
call synct(dat,jz,jstart,f0,smax)
call syncf1(dat,jz,jstart,f0,NFreeze,DFTolerance,smax,red)
do i=1,512
ccf(i-6)=dB(red(i))
enddo
df=11025./256.
do i=1,64
sum=0.
do k=8*i-7,8*i
sum=sum+red(k)
enddo
psavg(i)=5.0*sum
fac=1.0
freq=i*df
if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0)
psavg(i)=fac*psavg(i)
psavg(i+64)=0.001
enddo
jz=jz-jstart+1
nslim=MinSigdB
NFixLen=0
C Call the decoder if DF is in range or Freeze is off.
if(NFreeze.eq.0 .or.
+ abs(f0-f00).lt.float(DFTolerance)) then
call decode6m(dat(jstart),jz,cfile6,nslim,istart,
+ NFixLen,lcum,f0,lumsg,npkept,yellow)
endif
if(pick) then
do i=1,216
ps0(i)=yellow0(i)
enddo
else
ps0(216)=yellow(216)
yellow0(216)=yellow(216)
do i=1,215
ps0(i)=2*yellow(i)
yellow0(i)=ps0(i)
enddo
endif
goto 800
endif
! We're in FSK441 mode. Compute the 2D spectrum.
df=11025.0/256.0 !FFT resolution ~43 Hz
dtbuf=nstep/11025.0
stlim=nslim2 !Single-tone threshold
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
if(sigma.lt.0.0) basevb=-99.0
if(sigma.lt.0.0) go to 900
nline0=nline
STfound=.false.
npkept=0
C Look for single-tone messages
if((.not.pick) .or. MouseButton.eq.1) then
call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim,
+ DFTolerance,cfile6,pick,istart)
endif
if(nline.gt.nline0) STfound=.true. !ST message(s) found
C Now the multi-tone decoding
call mtdecode(dat,jz,nz,MinSigdB,MinWidth,
+ NQRN,DFTolerance,istart,pick,cfile6,ps0)
npkept=nline !Number of pings that were kept
smax=0.
stbest=.false.
if(npkept.gt.0) then
call indexx(npkept,tping,indx) !Merge the ST and MT decodes
do i=1,npkept
j=indx(i)
if(pick .and. STFound .and.
+ line(j)(29:31).eq.' ') goto 10
write(lumsg,1050) line(j) !Write to decoded.txt
1050 format(a79)
if(lcum) write(21,1050) line(j) !Write to ALL.TXT
read(line(j),1060) sig,msg3
1060 format(16x,f3.0,9x,a3)
if(sig.gt.smax) then
smax=sig
tbest=tping(j)
stbest = (msg3.ne.' ')
endif
10 enddo
endif
dt=1.0/11025.0 !Compute spectrum for pink curve
if(stbest) then
jj=nint(tbest/dt)
call spec441(dat(jj),1102,ps0,f0)
endif
800 continue
call s2shape(s2,nchan,nz,tbest)
900 LDecoded = ((NSyncOK.gt.0) .or. npkept.gt.0)
end file 11
call flushqqq(11)
call flushqqq(12)
call flushqqq(21)
return
end

428
wsjt65.f
View File

@ -1,216 +1,212 @@
subroutine wsjt65(dat,npts,cfile6,NClearAve,MinSigdB,
+ DFTolerance,NFreeze,NAFC,mode65,Nseg,MouseDF,NAgain,
+ ndepth,neme,nsked,mycall,hiscall,hisgrid,
+ lumsg,lcum,nspecial,ndf,nstest,dfsh,iderrsh,idriftsh,
+ snrsh,NSyncOK,ccfblue,ccfred,ndiag,nwsh)
C Orchestrates the process of decoding JT65 messages, using data that
C have been 2x downsampled. The search for shorthand messages has
C already been done.
real dat(npts) !Raw data
integer DFTolerance
logical first
logical lcum
character decoded*22,cfile6*6,special*5,cooo*3
character*22 avemsg1,avemsg2,deepmsg,deepbest
character*67 line,ave1,ave2
character*1 csync,c1
character*12 mycall
character*12 hiscall
character*6 hisgrid
real ccfblue(-5:540),ccfred(-224:224)
real ftrack(126)
logical lmid
integer itf(2,9)
include 'avecom.h'
common/avecom2/f0a
data first/.true./,ns10/0/,ns20/0/
data itf/0,0, 1,0, -1,0, 0,-1, 0,1, 1,-1, 1,1, -1,-1, -1,1/
save
if(first) then
call setup65 !Initialize pseudo-random arrays
nsave=0
first=.false.
ave1=' '
ave2=' '
endif
naggressive=0
if(ndepth.ge.2) naggressive=1
nq1=3
nq2=6
if(naggressive.eq.1) nq1=1
if(NClearAve.ne.0) then
nsave=0 !Clear the averaging accumulators
ns10=0
ns20=0
ave1=' '
ave2=' '
endif
if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then
ns10=0 !For Include/Exclude ?
ns20=0
endif
C Attempt to synchronize: look for sync tone, get DF and DT.
call sync65(dat,npts,DFTolerance,NFreeze,NAFC,MouseDF,
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
f0=1270.46 + dfx
csync=' '
decoded=' '
deepmsg=' '
special=' '
cooo=' '
itry=0
ncount=-1 !Flag for RS decode of current record
ncount1=-1 !Flag for RS Decode of ave1
ncount2=-1 !Flag for RS Decode of ave2
NSyncOK=0
nqual1=0
nqual2=0
if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1))
+ nsave=nsave+1
if(nsave.le.0) go to 900 !Prevent bounds error
nflag(nsave)=0 !Clear the "good sync" flag
iseg(nsave)=Nseg !Set the RX segment to 1 or 2
nsync=nint(snrsync-3.0)
nsnr=nint(snrx)
if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0
nsnrlim=-32
C Good Sync takes precedence over a shorthand message:
if(nsync.ge.MinSigdB .and. nsnr.ge.nsnrlim .and.
+ nsync.gt.nstest) nstest=0
if(nstest.gt.0) then
dfx=dfsh
nsync=nstest
nsnr=snrsh
dtx=1.
ccfblue(-5)=-999.0
if(nspecial.eq.1) special='ATT '
if(nspecial.eq.2) special='RO '
if(nspecial.eq.3) special='RRR '
if(nspecial.eq.4) special='73 '
NSyncOK=1 !Mark this RX file as good (for "Save Decoded")
if(NFreeze.eq.0 .or. DFTolerance.ge.200) special(5:5)='?'
width=nwsh
go to 200
endif
if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200
C If we get here, we have achieved sync!
NSyncOK=1
nflag(nsave)=1 !Mark this RX file as good
csync='*'
if(flip.lt.0.0) then
csync='#'
cooo='O ?'
endif
call decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
+ nsnr,mycall,hiscall,hisgrid,mode65,nafc,decoded,
+ ncount,deepmsg,qual)
if(ncount.eq.-999) qual=0 !Bad data
200 kvqual=0
if(ncount.ge.0) kvqual=1
nqual=qual
if(ndiag.eq.0 .and. nqual.gt.10) nqual=10
if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg
ndf=nint(dfx)
if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO'
if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?'
if(decoded.eq.' ') cooo=' '
do i=1,22
c1=decoded(i:i)
if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32)
enddo
write(line,1010) cfile6,nsync,nsnr,dtx-1.0,ndf,
+ nint(width),csync,special,decoded(1:19),cooo,kvqual,nqual
1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4)
C Blank all end-of-line stuff if no decode
if(line(31:40).eq.' ') line=line(:30)
C Blank DT if shorthand message (### wrong logic? ###)
if(special.ne.' ') then
line(15:19)=' '
line=line(:35)
ccfblue(-5)=-9999.0
! if(ndiag.gt.0) write(line(51:57),1012) iderrsh,idriftsh
! 1012 format(i3,i4)
else
nspecial=0
endif
if(lcum) write(21,1011) line
1011 format(a67)
C Write decoded msg unless this is an "Exclude" request:
if(MinSigdB.lt.99) write(lumsg,1011) line
if(nsave.ge.1) call avemsg65(1,mode65,ndepth,avemsg1,nused1,
+ nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual1,
+ ns1,ncount1)
if(nsave.ge.1) call avemsg65(2,mode65,ndepth,avemsg2,nused2,
+ nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual2,
+ ns2,ncount2)
nqual1=qual1
nqual2=qual2
if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10
if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10
nc1=0
nc2=0
if(ncount1.ge.0) nc1=1
if(ncount2.ge.0) nc2=1
C Write the average line
! if(ns1.ge.1 .and. ns1.ne.ns10) then
if(ns1.ge.1) then
if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1,
+ nc1,nqual1
1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4)
if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6,
+ 1,nused1,ns1,avemsg1,nc1,nqual1
1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4)
if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1,
+ avemsg1,nc1,nqual1
1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4)
if(lcum .and. (avemsg1.ne.' '))
+ write(21,1011) ave1
ns10=ns1
endif
C If Monitor segment #2 is available, write that line also
! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? ***
if(ns2.ge.1) then
if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2,
+ nc2,nqual2
if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6,
+ 2,nused2,ns2,avemsg2,nc2,nqual2
if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2,
+ nc2,nqual2
if(lcum .and. (avemsg2.ne.' '))
+ write(21,1011) ave2
ns20=ns2
endif
if(ave1(31:40).eq.' ') ave1=ave1(:30)
if(ave2(31:40).eq.' ') ave2=ave2(:30)
write(12,1011) ave1
write(12,1011) ave2
call flushqqq(12)
800 if(lumsg.ne.6) end file 11
f0a=f0
900 continue
return
end
subroutine wsjt65(dat,npts,cfile6,NClearAve,MinSigdB,
+ DFTolerance,NFreeze,NAFC,mode65,Nseg,MouseDF,NAgain,
+ ndepth,neme,nsked,mycall,hiscall,hisgrid,
+ lumsg,lcum,nspecial,ndf,nstest,dfsh,
+ snrsh,NSyncOK,ccfblue,ccfred,ndiag,nwsh)
C Orchestrates the process of decoding JT65 messages, using data that
C have been 2x downsampled. The search for shorthand messages has
C already been done.
real dat(npts) !Raw data
integer DFTolerance
logical first
logical lcum
character decoded*22,cfile6*6,special*5,cooo*3
character*22 avemsg1,avemsg2,deepmsg
character*67 line,ave1,ave2
character*1 csync,c1
character*12 mycall
character*12 hiscall
character*6 hisgrid
real ccfblue(-5:540),ccfred(-224:224)
integer itf(2,9)
include 'avecom.h'
data first/.true./,ns10/0/,ns20/0/
data itf/0,0, 1,0, -1,0, 0,-1, 0,1, 1,-1, 1,1, -1,-1, -1,1/
save
if(first) then
call setup65 !Initialize pseudo-random arrays
nsave=0
first=.false.
ave1=' '
ave2=' '
endif
naggressive=0
if(ndepth.ge.2) naggressive=1
nq1=3
nq2=6
if(naggressive.eq.1) nq1=1
if(NClearAve.ne.0) then
nsave=0 !Clear the averaging accumulators
ns10=0
ns20=0
ave1=' '
ave2=' '
endif
if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then
ns10=0 !For Include/Exclude ?
ns20=0
endif
C Attempt to synchronize: look for sync tone, get DF and DT.
call sync65(dat,npts,DFTolerance,NFreeze,MouseDF,
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
f0=1270.46 + dfx
csync=' '
decoded=' '
deepmsg=' '
special=' '
cooo=' '
itry=0
ncount=-1 !Flag for RS decode of current record
ncount1=-1 !Flag for RS Decode of ave1
ncount2=-1 !Flag for RS Decode of ave2
NSyncOK=0
nqual1=0
nqual2=0
if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1))
+ nsave=nsave+1
if(nsave.le.0) go to 900 !Prevent bounds error
nflag(nsave)=0 !Clear the "good sync" flag
iseg(nsave)=Nseg !Set the RX segment to 1 or 2
nsync=nint(snrsync-3.0)
nsnr=nint(snrx)
if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0
nsnrlim=-32
C Good Sync takes precedence over a shorthand message:
if(nsync.ge.MinSigdB .and. nsnr.ge.nsnrlim .and.
+ nsync.gt.nstest) nstest=0
if(nstest.gt.0) then
dfx=dfsh
nsync=nstest
nsnr=snrsh
dtx=1.
ccfblue(-5)=-999.0
if(nspecial.eq.1) special='ATT '
if(nspecial.eq.2) special='RO '
if(nspecial.eq.3) special='RRR '
if(nspecial.eq.4) special='73 '
NSyncOK=1 !Mark this RX file as good (for "Save Decoded")
if(NFreeze.eq.0 .or. DFTolerance.ge.200) special(5:5)='?'
width=nwsh
go to 200
endif
if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200
C If we get here, we have achieved sync!
NSyncOK=1
nflag(nsave)=1 !Mark this RX file as good
csync='*'
if(flip.lt.0.0) then
csync='#'
cooo='O ?'
endif
call decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
+ mycall,hiscall,hisgrid,mode65,nafc,decoded,
+ ncount,deepmsg,qual)
if(ncount.eq.-999) qual=0 !Bad data
200 kvqual=0
if(ncount.ge.0) kvqual=1
nqual=qual
if(ndiag.eq.0 .and. nqual.gt.10) nqual=10
if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg
ndf=nint(dfx)
if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO'
if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?'
if(decoded.eq.' ') cooo=' '
do i=1,22
c1=decoded(i:i)
if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32)
enddo
write(line,1010) cfile6,nsync,nsnr,dtx-1.0,ndf,
+ nint(width),csync,special,decoded(1:19),cooo,kvqual,nqual
1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4)
C Blank all end-of-line stuff if no decode
if(line(31:40).eq.' ') line=line(:30)
C Blank DT if shorthand message (### wrong logic? ###)
if(special.ne.' ') then
line(15:19)=' '
line=line(:35)
ccfblue(-5)=-9999.0
! if(ndiag.gt.0) write(line(51:57),1012) iderrsh,idriftsh
! 1012 format(i3,i4)
else
nspecial=0
endif
if(lcum) write(21,1011) line
1011 format(a67)
C Write decoded msg unless this is an "Exclude" request:
if(MinSigdB.lt.99) write(lumsg,1011) line
if(nsave.ge.1) call avemsg65(1,mode65,ndepth,avemsg1,nused1,
+ nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual1,
+ ns1,ncount1)
if(nsave.ge.1) call avemsg65(2,mode65,ndepth,avemsg2,nused2,
+ nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual2,
+ ns2,ncount2)
nqual1=qual1
nqual2=qual2
if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10
if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10
nc1=0
nc2=0
if(ncount1.ge.0) nc1=1
if(ncount2.ge.0) nc2=1
C Write the average line
! if(ns1.ge.1 .and. ns1.ne.ns10) then
if(ns1.ge.1) then
if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1,
+ nc1,nqual1
1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4)
if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6,
+ 1,nused1,ns1,avemsg1,nc1,nqual1
1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4)
if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1,
+ avemsg1,nc1,nqual1
1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4)
if(lcum .and. (avemsg1.ne.' '))
+ write(21,1011) ave1
ns10=ns1
endif
C If Monitor segment #2 is available, write that line also
! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? ***
if(ns2.ge.1) then
if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2,
+ nc2,nqual2
if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6,
+ 2,nused2,ns2,avemsg2,nc2,nqual2
if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2,
+ nc2,nqual2
if(lcum .and. (avemsg2.ne.' '))
+ write(21,1011) ave2
ns20=ns2
endif
if(ave1(31:40).eq.' ') ave1=ave1(:30)
if(ave2(31:40).eq.' ') ave2=ave2(:30)
write(12,1011) ave1
write(12,1011) ave2
call flushqqq(12)
800 if(lumsg.ne.6) end file 11
900 continue
return
end