mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-10-01 01:26:39 -04:00
1. General code cleanup. Most compiler warning messages have been silenced.
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
parent
daa2ffd27a
commit
8c9ed820c8
@ -6,6 +6,7 @@
|
|||||||
3V8BB,JM56ER,EME,,,,,06/02
|
3V8BB,JM56ER,EME,,,,,06/02
|
||||||
3V8SS,JM55GX,EME,,Expedition,,144: 16JXX and 1kw,12/05
|
3V8SS,JM55GX,EME,,Expedition,,144: 16JXX and 1kw,12/05
|
||||||
3Y0X,EC41RE,EME,,Expedition,,144: 4x 9el 350W,02/06
|
3Y0X,EC41RE,EME,,Expedition,,144: 4x 9el 350W,02/06
|
||||||
|
4F2KWT,PK06,EME,,
|
||||||
4J1FS,KP40,,,Expedition,,,1990
|
4J1FS,KP40,,,Expedition,,,1990
|
||||||
4N7AX,KN05PC,,,,,144: 200 W 2x10el 9BVtx1500/rx3000lpm DSP,08/00
|
4N7AX,KN05PC,,,,,144: 200 W 2x10el 9BVtx1500/rx3000lpm DSP,08/00
|
||||||
4O4AR,JN94AS,,,=YU4AR,,144: TR9130 250W 10el PA0MS-ant PreampUHER 15,11/02
|
4O4AR,JN94AS,,,=YU4AR,,144: TR9130 250W 10el PA0MS-ant PreampUHER 15,11/02
|
||||||
|
|||||||
@ -107,8 +107,9 @@ wsjt6: @NEEDPORTAUDIO@ Audio.so #wsjt.spec
|
|||||||
# ${PYTHON} c:\python23\installer\Build.py wsjt.spec
|
# ${PYTHON} c:\python23\installer\Build.py wsjt.spec
|
||||||
# ${RM} wsjt6
|
# ${RM} wsjt6
|
||||||
|
|
||||||
#
|
deep65.o: deep65.F
|
||||||
#
|
$(FC) -c -O0 -Wall deep65.F
|
||||||
|
|
||||||
Audio.so: $(OBJS2C) $(OBJS3C) $(OBJS2F77) $(SRCS2F90) $(AUDIOSRCS)
|
Audio.so: $(OBJS2C) $(OBJS3C) $(OBJS2F77) $(SRCS2F90) $(AUDIOSRCS)
|
||||||
${F2PY} -c --quiet --opt="-O ${CFLAGS} \
|
${F2PY} -c --quiet --opt="-O ${CFLAGS} \
|
||||||
-fno-second-underscore" $(OBJS2C) $(OBJS2F77) -m Audio \
|
-fno-second-underscore" $(OBJS2C) $(OBJS2F77) -m Audio \
|
||||||
|
|||||||
27
Makefile.win
27
Makefile.win
@ -2,8 +2,10 @@
|
|||||||
!include <dfinc.mak> #Some definitions for Compaq Visual Fortran
|
!include <dfinc.mak> #Some definitions for Compaq Visual Fortran
|
||||||
gcc = cl
|
gcc = cl
|
||||||
FC = df
|
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 /check:all
|
||||||
FFLAGS = /traceback /fast
|
FFLAGS = /traceback /fast /nologo
|
||||||
|
|
||||||
all: JT65code.exe WSJT6.EXE
|
all: JT65code.exe WSJT6.EXE
|
||||||
|
|
||||||
@ -16,7 +18,7 @@ OBJS1 = JT65code.obj nchar.obj grid2deg.obj packmsg.obj packtext.obj \
|
|||||||
wrapkarn.obj
|
wrapkarn.obj
|
||||||
|
|
||||||
JT65code.exe: $(OBJS1)
|
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
|
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)
|
Audio.pyd: $(OBJS2C) $(SRCS2F90) $(SRCS2F77) $(SRCS2C)
|
||||||
python f2py.py -c \
|
python f2py.py -c \
|
||||||
--quiet --"fcompiler=compaqv" \
|
--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) \
|
$(OBJS2C) \
|
||||||
-lwinmm -lpa -llibsamplerate \
|
-lwinmm -lpa -llibsamplerate \
|
||||||
-m Audio \
|
-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
|
--tk --onefile wsjt.py
|
||||||
|
|
||||||
jtaudio.o: jtaudio.c
|
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
|
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
|
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
|
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
|
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
|
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
|
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
|
wrapkarn.obj: wrapkarn.c
|
||||||
$(CC) /c /DWin32=1 wrapkarn.c
|
$(CC) /nologo /c /DWin32=1 wrapkarn.c
|
||||||
|
|
||||||
igray.obj: igray.c
|
igray.obj: igray.c
|
||||||
$(CC) /c /DWin32=1 igray.c
|
$(CC) /nologo /c /DWin32=1 igray.c
|
||||||
|
|
||||||
.PHONY : clean
|
.PHONY : clean
|
||||||
|
|
||||||
|
|||||||
63
abc441.F90
63
abc441.F90
@ -1,33 +1,30 @@
|
|||||||
subroutine abc441(msg,nmsg,itone,ndits)
|
subroutine abc441(msg,nmsg,itone,ndits)
|
||||||
|
|
||||||
character msg*28,msg2*29
|
character msg*28
|
||||||
integer itone(84)
|
integer itone(84)
|
||||||
integer lookup(0:91)
|
integer lookup(0:91)
|
||||||
integer codeword4(4,0:42)
|
character cc*43
|
||||||
integer codeword7(7,0:42)
|
data cc/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.,?/#$'/
|
||||||
character c*1
|
data lookup/13, 15, 17, 46, 47, 45, 44, 12, 11, 14, &
|
||||||
character cc*43
|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, &
|
||||||
data cc/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.,?/#$'/
|
16, 48, 18, 19, 20, 21, 22, 23, 24, 25, &
|
||||||
data lookup/13, 15, 17, 46, 47, 45, 44, 12, 11, 14, &
|
26, 27, 15, 29, 30, 14, 16, 42, 46, 35, &
|
||||||
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, &
|
36, 37, 21, 0, 11, 41, 10, 13, 43, 1, &
|
||||||
16, 48, 18, 19, 20, 21, 22, 23, 24, 25, &
|
2, 3, 4, 5, 6, 7, 8, 9, 49, 56, &
|
||||||
26, 27, 15, 29, 30, 14, 16, 42, 46, 35, &
|
52, 55, 54, 12, 63, 17, 18, 19, 20, 44, &
|
||||||
36, 37, 21, 0, 11, 41, 10, 13, 43, 1, &
|
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, &
|
||||||
2, 3, 4, 5, 6, 7, 8, 9, 49, 56, &
|
32, 33, 34, 35, 36, 37, 38, 39, 40, 41, &
|
||||||
52, 55, 54, 12, 63, 17, 18, 19, 20, 44, &
|
45, 63/
|
||||||
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, &
|
save
|
||||||
32, 33, 34, 35, 36, 37, 38, 39, 40, 41, &
|
|
||||||
45, 63/
|
do i=1,nmsg
|
||||||
save
|
n=ichar(msg(i:i))
|
||||||
|
if(n.lt.0 .or. n.gt.91) n=32 !Replace illegal char with blank
|
||||||
do i=1,nmsg
|
n=lookup(n)
|
||||||
n=ichar(msg(i:i))
|
itone(3*i-2)=n/16 + 1
|
||||||
if(n.lt.0 .or. n.gt.91) n=32 !Replace illegal char with blank
|
itone(3*i-1)=mod(n/4,4) + 1
|
||||||
n=lookup(n)
|
itone(3*i)=mod(n,4) + 1
|
||||||
itone(3*i-2)=n/16 + 1
|
enddo
|
||||||
itone(3*i-1)=mod(n/4,4) + 1
|
ndits=3*nmsg
|
||||||
itone(3*i)=mod(n,4) + 1
|
return
|
||||||
enddo
|
end subroutine abc441
|
||||||
ndits=3*nmsg
|
|
||||||
return
|
|
||||||
end subroutine abc441
|
|
||||||
|
|||||||
252
astro.F
252
astro.F
@ -1,128 +1,124 @@
|
|||||||
subroutine astro(AppDir,nyear,month,nday,uth,nfreq,Mygrid,
|
subroutine astro(AppDir,nyear,month,nday,uth,nfreq,Mygrid,
|
||||||
+ NStation,mode,MoonDX,AzSun,ElSun,AzMoon,ElMoon0,
|
+ NStation,mode,MoonDX,AzSun,ElSun,AzMoon,ElMoon0,
|
||||||
+ ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,
|
+ ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd,
|
||||||
+ poloffset,xnr,auxra,auxdec,azaux,elaux)
|
+ poloffset,xnr,auxra,auxdec,azaux,elaux)
|
||||||
|
|
||||||
C Computes astronomical quantities for display in JT65, CW, and EME Echo mode.
|
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.
|
C NB: may want to smooth the Tsky map to 10 degrees or so.
|
||||||
|
|
||||||
character*80 AppDir,fname
|
character*80 AppDir,fname
|
||||||
character*240 Display
|
character*6 MyGrid,HisGrid
|
||||||
character*14 d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,d11,d12,d13,d14,d15
|
logical first,ltsky
|
||||||
character*14 d1a,d2a,d3a
|
real LST
|
||||||
character*2 crlf
|
real lat,lon
|
||||||
character*6 MyGrid,HisGrid
|
real ldeg
|
||||||
logical first,ltsky
|
integer*1 n1sky(129600)
|
||||||
real LST
|
integer*2 nsky
|
||||||
real lat,lon
|
common/sky/ nsky(360,180)
|
||||||
real ldeg
|
common/echo/xdop(2),techo,ElMoon,mjd
|
||||||
integer*1 n1sky(129600)
|
equivalence (n1sky,nsky)
|
||||||
integer*2 nsky
|
data first/.true./
|
||||||
common/sky/ nsky(360,180)
|
data rad/57.2957795/
|
||||||
common/echo/xdop(2),techo,ElMoon,mjd
|
save first
|
||||||
equivalence (n1sky,nsky)
|
|
||||||
data first/.true./
|
if(first) then
|
||||||
data rad/57.2957795/
|
do i=80,1,-1
|
||||||
save first
|
if(ichar(AppDir(i:i)).ne.0 .and.
|
||||||
|
+ ichar(AppDir(i:i)).ne.32) goto 1
|
||||||
if(first) then
|
enddo
|
||||||
do i=80,1,-1
|
1 lenappdir=i
|
||||||
if(ichar(AppDir(i:i)).ne.0 .and.
|
call zero(nsky,180*180)
|
||||||
+ ichar(AppDir(i:i)).ne.32) goto 1
|
fname=Appdir(1:lenappdir)//'/TSKY.DAT'
|
||||||
enddo
|
#ifdef Win32
|
||||||
1 lenappdir=i
|
open(13,file=fname,status='old',form='binary',err=10)
|
||||||
call zero(nsky,180*180)
|
read(13) nsky
|
||||||
fname=Appdir(1:lenappdir)//'/TSKY.DAT'
|
close(13)
|
||||||
#ifdef Win32
|
#else
|
||||||
open(13,file=fname,status='old',form='binary',err=10)
|
call rfile2(fname,nsky,129600,nr)
|
||||||
read(13) nsky
|
if(nr.ne.129600) go to 10
|
||||||
close(13)
|
#endif
|
||||||
#else
|
ltsky=.true.
|
||||||
call rfile2(fname,nsky,129600,nr)
|
first=.false.
|
||||||
if(nr.ne.129600) go to 10
|
endif
|
||||||
#endif
|
go to 20
|
||||||
ltsky=.true.
|
10 ltsky=.false.
|
||||||
first=.false.
|
|
||||||
endif
|
20 call grid2deg(MyGrid,elon,lat)
|
||||||
go to 20
|
lon=-elon
|
||||||
10 ltsky=.false.
|
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST,
|
||||||
|
+ AzSun,ElSun,mjd)
|
||||||
20 call grid2deg(MyGrid,elon,lat)
|
|
||||||
lon=-elon
|
! If(NStation.eq.1 .and. ElSun.gt.-2.0) then
|
||||||
call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST,
|
! arg=ElSun + 8.6/(ElSun+4.4)
|
||||||
+ AzSun,ElSun,mjd)
|
! refraction=0.0167/tan(arg/rad) !Refraction in degrees
|
||||||
|
! ElSun=ElSun+refraction
|
||||||
! If(NStation.eq.1 .and. ElSun.gt.-2.0) then
|
! endif
|
||||||
! arg=ElSun + 8.6/(ElSun+4.4)
|
|
||||||
! refraction=0.0167/tan(arg/rad) !Refraction in degrees
|
mjd2=mjd
|
||||||
! ElSun=ElSun+refraction
|
freq=nfreq*1.e6
|
||||||
! endif
|
|
||||||
|
call MoonDop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon,
|
||||||
mjd2=mjd
|
+ LST,HA,AzMoon,ElMoon,ldeg,bdeg,vr,dist)
|
||||||
freq=nfreq*1.e6
|
|
||||||
|
C Compute spatial polarization offset
|
||||||
call MoonDop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon,
|
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)*
|
||||||
+ LST,HA,AzMoon,ElMoon,ldeg,bdeg,vr,dist)
|
+ cos(AzMoon/rad)*sin(ElMoon/rad)
|
||||||
|
yy=cos(lat/rad)*sin(AzMoon/rad)
|
||||||
C Compute spatial polarization offset
|
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
|
||||||
xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)*
|
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
|
||||||
+ cos(AzMoon/rad)*sin(ElMoon/rad)
|
|
||||||
yy=cos(lat/rad)*sin(AzMoon/rad)
|
! If(NStation.eq.1 .and. ElMoon.gt.-2.0) then
|
||||||
if(NStation.eq.1) poloffset1=rad*atan2(yy,xx)
|
! arg=ElMoon + 8.6/(ElMoon+4.4)
|
||||||
if(NStation.eq.2) poloffset2=rad*atan2(yy,xx)
|
! refraction=0.0167/tan(arg/rad) !Refraction in degrees
|
||||||
|
! ElMoon=ElMoon+refraction
|
||||||
! If(NStation.eq.1 .and. ElMoon.gt.-2.0) then
|
! endif
|
||||||
! arg=ElMoon + 8.6/(ElMoon+4.4)
|
|
||||||
! refraction=0.0167/tan(arg/rad) !Refraction in degrees
|
techo=2.0 * dist/2.99792458e5 !Echo delay time
|
||||||
! ElMoon=ElMoon+refraction
|
doppler=-freq*vr/2.99792458e5 !One-way Doppler
|
||||||
! endif
|
t408=ftsky(ldeg,bdeg) !Read sky map
|
||||||
|
tsky=t408*(408.0/nfreq)**2.6 !Tsky for obs freq
|
||||||
techo=2.0 * dist/2.99792458e5 !Echo delay time
|
if(ltsky.and.(tsky.lt.3.0)) tsky=3.0 !Minimum = 3 Kelvin
|
||||||
doppler=-freq*vr/2.99792458e5 !One-way Doppler
|
|
||||||
t408=ftsky(ldeg,bdeg) !Read sky map
|
xdop(NStation)=doppler
|
||||||
tsky=t408*(408.0/nfreq)**2.6 !Tsky for obs freq
|
if(NStation.eq.2) then
|
||||||
if(ltsky.and.(tsky.lt.3.0)) tsky=3.0 !Minimum = 3 Kelvin
|
HisGrid=MyGrid
|
||||||
|
go to 900
|
||||||
xdop(NStation)=doppler
|
endif
|
||||||
if(NStation.eq.2) then
|
|
||||||
HisGrid=MyGrid
|
doppler00=2.0*xdop(1)
|
||||||
go to 900
|
if(mode.eq.2 .or. mode.eq.5) doppler=xdop(1)+xdop(2)
|
||||||
endif
|
if(mode.eq.3) doppler=2.0*xdop(1)
|
||||||
|
dBMoon=-40.0*log10(dist/356903.)
|
||||||
doppler00=2.0*xdop(1)
|
sd=16.23*370152.0/dist
|
||||||
if(mode.eq.2 .or. mode.eq.5) doppler=xdop(1)+xdop(2)
|
|
||||||
if(mode.eq.3) doppler=2.0*xdop(1)
|
! if(NStation.eq.1 .and. MoonDX.ne.0 .and.
|
||||||
dBMoon=-40.0*log10(dist/356903.)
|
! + (mode.eq.2 .or. mode.eq.5)) then
|
||||||
sd=16.23*370152.0/dist
|
if(NStation.eq.1 .and. MoonDX.ne.0) then
|
||||||
|
poloffset=mod(poloffset2-poloffset1+720.0,180.0)
|
||||||
! if(NStation.eq.1 .and. MoonDX.ne.0 .and.
|
if(poloffset.gt.90.0) poloffset=poloffset-180.0
|
||||||
! + (mode.eq.2 .or. mode.eq.5)) then
|
x1=abs(cos(2*poloffset/rad))
|
||||||
if(NStation.eq.1 .and. MoonDX.ne.0) then
|
if(x1.lt.0.056234) x1=0.056234
|
||||||
poloffset=mod(poloffset2-poloffset1+720.0,180.0)
|
xnr=-20.0*log10(x1)
|
||||||
if(poloffset.gt.90.0) poloffset=poloffset-180.0
|
if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'Z') xnr=0
|
||||||
x1=abs(cos(2*poloffset/rad))
|
endif
|
||||||
if(x1.lt.0.056234) x1=0.056234
|
|
||||||
xnr=-20.0*log10(x1)
|
tr=80.0 !Good preamp
|
||||||
if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'Z') xnr=0
|
tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature
|
||||||
endif
|
tsysmin=tskymin+tr
|
||||||
|
tsys=tsky+tr
|
||||||
tr=80.0 !Good preamp
|
dgrd=-10.0*log10(tsys/tsysmin) + dbMoon
|
||||||
tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature
|
|
||||||
tsysmin=tskymin+tr
|
900 ElMoon0=Elmoon
|
||||||
tsys=tsky+tr
|
ntsky=nint(tsky)
|
||||||
dgrd=-10.0*log10(tsys/tsysmin) + dbMoon
|
|
||||||
|
auxHA = 15.0*(LST-auxra) !HA in degrees
|
||||||
900 ElMoon0=Elmoon
|
pi=3.14159265
|
||||||
ntsky=nint(tsky)
|
pio2=0.5*pi
|
||||||
|
call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0,
|
||||||
auxHA = 15.0*(LST-auxra) !HA in degrees
|
+ auxdec/rad,azaux,elaux)
|
||||||
pi=3.14159265
|
AzAux=azaux*rad
|
||||||
pio2=0.5*pi
|
ElAux=ElAux*rad
|
||||||
call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0,
|
|
||||||
+ auxdec/rad,azaux,elaux)
|
return
|
||||||
AzAux=azaux*rad
|
|
||||||
ElAux=ElAux*rad
|
end
|
||||||
|
|
||||||
return
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|||||||
@ -10,7 +10,6 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, &
|
|||||||
|
|
||||||
character grid*6
|
character grid*6
|
||||||
character*9 cauxra,cauxdec
|
character*9 cauxra,cauxdec
|
||||||
real*8 utch8
|
|
||||||
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,AzAux8,ElAux8
|
real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,AzAux8,ElAux8
|
||||||
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0
|
real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0
|
||||||
real*8 sd8,poloffset8
|
real*8 sd8,poloffset8
|
||||||
|
|||||||
155
audio_init.F90
155
audio_init.F90
@ -1,78 +1,77 @@
|
|||||||
!------------------------------------------------ audio_init
|
!------------------------------------------------ audio_init
|
||||||
subroutine audio_init(ndin,ndout)
|
subroutine audio_init(ndin,ndout)
|
||||||
|
|
||||||
#ifdef Win32
|
#ifdef Win32
|
||||||
use dfmt
|
use dfmt
|
||||||
integer Thread1,Thread2
|
integer Thread1,Thread2
|
||||||
external a2d,decode1
|
external a2d,decode1
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
integer*2 a(225000) !Pixel values for 750 x 300 array
|
integer brightness,contrast
|
||||||
integer brightness,contrast
|
include 'gcom1.f90'
|
||||||
include 'gcom1.f90'
|
include 'gcom2.f90'
|
||||||
include 'gcom2.f90'
|
|
||||||
|
nmode=1
|
||||||
nmode=1
|
if(mode(1:4).eq.'JT65') then
|
||||||
if(mode(1:4).eq.'JT65') then
|
nmode=2
|
||||||
nmode=2
|
if(mode(5:5).eq.'A') mode65=1
|
||||||
if(mode(5:5).eq.'A') mode65=1
|
if(mode(5:5).eq.'B') mode65=2
|
||||||
if(mode(5:5).eq.'B') mode65=2
|
if(mode(5:5).eq.'C') mode65=4
|
||||||
if(mode(5:5).eq.'C') mode65=4
|
endif
|
||||||
endif
|
if(mode.eq.'Echo') nmode=3
|
||||||
if(mode.eq.'Echo') nmode=3
|
if(mode.eq.'JT6M') nmode=4
|
||||||
if(mode.eq.'JT6M') nmode=4
|
ndevin=ndin
|
||||||
ndevin=ndin
|
ndevout=ndout
|
||||||
ndevout=ndout
|
TxOK=0
|
||||||
TxOK=0
|
Transmitting=0
|
||||||
Transmitting=0
|
nfsample=11025
|
||||||
nfsample=11025
|
nspb=1024
|
||||||
nspb=1024
|
nbufs=2048
|
||||||
nbufs=2048
|
nmax=nbufs*nspb
|
||||||
nmax=nbufs*nspb
|
nwave=60*nfsample
|
||||||
nwave=60*nfsample
|
ngo=1
|
||||||
ngo=1
|
brightness=0
|
||||||
brightness=0
|
contrast=0
|
||||||
contrast=0
|
nsec=1
|
||||||
nsec=1
|
df=11025.0/4096
|
||||||
df=11025.0/4096
|
f0=800.0
|
||||||
f0=800.0
|
do i=1,nwave
|
||||||
do i=1,nwave
|
iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample))
|
||||||
iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample))
|
enddo
|
||||||
enddo
|
|
||||||
|
#ifdef Win32
|
||||||
#ifdef Win32
|
! Priority classes (for processes):
|
||||||
! Priority classes (for processes):
|
! IDLE_PRIORITY_CLASS 64
|
||||||
! IDLE_PRIORITY_CLASS 64
|
! NORMAL_PRIORITY_CLASS 32
|
||||||
! NORMAL_PRIORITY_CLASS 32
|
! HIGH_PRIORITY_CLASS 128
|
||||||
! HIGH_PRIORITY_CLASS 128
|
|
||||||
|
! Priority definitions (for threads):
|
||||||
! Priority definitions (for threads):
|
! THREAD_PRIORITY_IDLE -15
|
||||||
! THREAD_PRIORITY_IDLE -15
|
! THREAD_PRIORITY_LOWEST -2
|
||||||
! THREAD_PRIORITY_LOWEST -2
|
! THREAD_PRIORITY_BELOW_NORMAL -1
|
||||||
! THREAD_PRIORITY_BELOW_NORMAL -1
|
! THREAD_PRIORITY_NORMAL 0
|
||||||
! THREAD_PRIORITY_NORMAL 0
|
! THREAD_PRIORITY_ABOVE_NORMAL 1
|
||||||
! THREAD_PRIORITY_ABOVE_NORMAL 1
|
! THREAD_PRIORITY_HIGHEST 2
|
||||||
! THREAD_PRIORITY_HIGHEST 2
|
! THREAD_PRIORITY_TIME_CRITICAL 15
|
||||||
! THREAD_PRIORITY_TIME_CRITICAL 15
|
|
||||||
|
m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS)
|
||||||
m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS)
|
|
||||||
|
! Start a thread for doing A/D and D/A with sound card.
|
||||||
! Start a thread for doing A/D and D/A with sound card.
|
Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1)
|
||||||
Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1)
|
m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL)
|
||||||
m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL)
|
m2=ResumeThread(Thread1)
|
||||||
m2=ResumeThread(Thread1)
|
|
||||||
|
! Start a thread for background decoding.
|
||||||
! Start a thread for background decoding.
|
Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2)
|
||||||
Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2)
|
m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL)
|
||||||
m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL)
|
m4=ResumeThread(Thread2)
|
||||||
m4=ResumeThread(Thread2)
|
#else
|
||||||
#else
|
! print*,'Audio INIT called.'
|
||||||
! print*,'Audio INIT called.'
|
ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, &
|
||||||
ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, &
|
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
|
||||||
11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, &
|
Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name)
|
||||||
Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name)
|
|
||||||
|
#endif
|
||||||
#endif
|
|
||||||
|
return
|
||||||
return
|
end subroutine audio_init
|
||||||
end subroutine audio_init
|
|
||||||
|
|||||||
123
avemsg65.f
123
avemsg65.f
@ -1,60 +1,63 @@
|
|||||||
subroutine avemsg65(mseg,mode65,ndepth,decoded,nused,
|
subroutine avemsg65(mseg,mode65,ndepth,decoded,nused,
|
||||||
+ nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual,
|
+ nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual,
|
||||||
+ ns,ncount)
|
+ ns,ncount)
|
||||||
|
|
||||||
C Decodes averaged JT65 data for the specified segment (mseg=1 or 2).
|
C Decodes averaged JT65 data for the specified segment (mseg=1 or 2).
|
||||||
|
|
||||||
parameter (MAXAVE=120) !Max avg count is 120
|
parameter (MAXAVE=120) !Max avg count is 120
|
||||||
character decoded*22,deepmsg*22
|
character decoded*22,deepmsg*22
|
||||||
character mycall*12,hiscall*12,hisgrid*6
|
character mycall*12,hiscall*12,hisgrid*6
|
||||||
real s3(64,63)
|
real s3(64,63)
|
||||||
common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE)
|
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 Count the available spectra for this Monitor segment (mseg=1 or 2),
|
||||||
C and the number of spectra flagged as good.
|
C and the number of spectra flagged as good.
|
||||||
|
|
||||||
nused=0
|
nused=0
|
||||||
ns=0
|
ns=0
|
||||||
nqual=0
|
nqual=0
|
||||||
deepmsg=' '
|
deepmsg=' '
|
||||||
do i=1,nsave
|
do i=1,nsave
|
||||||
if(iseg(i).eq.mseg) then
|
if(iseg(i).eq.mseg) then
|
||||||
ns=ns+1
|
ns=ns+1
|
||||||
if(nflag(i).eq.1) nused=nused+1
|
if(nflag(i).eq.1) nused=nused+1
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
if(nused.lt.1) go to 100
|
if(nused.lt.1) go to 100
|
||||||
|
|
||||||
C Compute the average of all flagged spectra for this segment.
|
C Compute the average of all flagged spectra for this segment.
|
||||||
do j=1,63
|
do j=1,63
|
||||||
call zero(s3(1,j),64)
|
call zero(s3(1,j),64)
|
||||||
do n=1,nsave
|
do n=1,nsave
|
||||||
if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then
|
if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then
|
||||||
call add(s3(1,j),ppsave(1,j,n),s3(1,j),64)
|
call add(s3(1,j),ppsave(1,j,n),s3(1,j),64)
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
nadd=nused*mode65
|
nadd=nused*mode65
|
||||||
call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message
|
call extract(s3,nadd,ncount,decoded) !Extract the message
|
||||||
if(ncount.lt.0) decoded=' '
|
if(ncount.lt.0) decoded=' '
|
||||||
|
|
||||||
nqual=0
|
nqual=0
|
||||||
C Possibly should pass nadd=nused, also:
|
C Possibly should pass nadd=nused, also:
|
||||||
if(ndepth.ge.3) then
|
if(ndepth.ge.3) then
|
||||||
flipx=1.0 !Normal flip not relevant for ave msg
|
flipx=1.0 !Normal flip not relevant for ave msg
|
||||||
call deep65(s3,mode65,neme,nsked,flipx,
|
call deep65(s3,mode65,neme,nsked,flipx,
|
||||||
+ mycall,hiscall,hisgrid,deepmsg,qual)
|
+ mycall,hiscall,hisgrid,deepmsg,qual)
|
||||||
nqual=qual
|
nqual=qual
|
||||||
if(nqual.lt.nq1) deepmsg=' '
|
if(nqual.lt.nq1) deepmsg=' '
|
||||||
if(nqual.ge.nq1 .and. nqual.lt.nq2) deepmsg(19:19)='?'
|
if(nqual.ge.nq1 .and. nqual.lt.nq2) deepmsg(19:19)='?'
|
||||||
endif
|
else
|
||||||
if(ncount.lt.0) decoded=deepmsg
|
deepmsg=' '
|
||||||
|
qual=0.
|
||||||
C Suppress "birdie messages":
|
endif
|
||||||
if(decoded(1:7).eq.'000AAA ') decoded=' '
|
if(ncount.lt.0) decoded=deepmsg
|
||||||
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
|
|
||||||
|
C Suppress "birdie messages":
|
||||||
100 if(nused.lt.1) decoded=' '
|
if(decoded(1:7).eq.'000AAA ') decoded=' '
|
||||||
return
|
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
|
||||||
end
|
|
||||||
|
100 if(nused.lt.1) decoded=' '
|
||||||
|
return
|
||||||
|
end
|
||||||
|
|||||||
104
avesp2.f
104
avesp2.f
@ -1,52 +1,52 @@
|
|||||||
subroutine avesp2(dat,jza,nadd,f0,mode,NFreeze,MouseDF,
|
subroutine avesp2(dat,jza,nadd,mode,NFreeze,MouseDF,
|
||||||
+ DFTolerance,fzap)
|
+ DFTolerance,fzap)
|
||||||
|
|
||||||
real dat(jza)
|
real dat(jza)
|
||||||
integer DFTolerance
|
integer DFTolerance
|
||||||
real psa(1024) !Ave ps, flattened and rolled off
|
real psa(1024) !Ave ps, flattened and rolled off
|
||||||
real ref(557) !Ref spectrum, lines excised
|
real ref(557) !Ref spectrum, lines excised
|
||||||
real birdie(557) !Birdie spectrum (ave-ref)
|
real birdie(557) !Birdie spectrum (ave-ref)
|
||||||
real variance(557)
|
real variance(557)
|
||||||
real s2(557,323)
|
real s2(557,323)
|
||||||
real fzap(200)
|
real fzap(200)
|
||||||
|
|
||||||
iz=557 !Compute the 2d spectrum
|
iz=557 !Compute the 2d spectrum
|
||||||
df=11025.0/2048.0
|
df=11025.0/2048.0
|
||||||
nfft=nadd*1024
|
nfft=nadd*1024
|
||||||
jz=jza/nfft
|
jz=jza/nfft
|
||||||
do j=1,jz
|
do j=1,jz
|
||||||
k=(j-1)*nfft + 1
|
k=(j-1)*nfft + 1
|
||||||
call ps(dat(k),nfft,psa)
|
call ps(dat(k),nfft,psa)
|
||||||
call move(psa,s2(1,j),iz)
|
call move(psa,s2(1,j),iz)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
C Flatten s2 and get psa, ref, and birdie
|
C Flatten s2 and get psa, ref, and birdie
|
||||||
call flatten(s2,557,jz,psa,ref,birdie,variance)
|
call flatten(s2,557,jz,psa,ref,birdie,variance)
|
||||||
|
|
||||||
call zero(fzap,200)
|
call zero(fzap,200)
|
||||||
ia=300/df
|
ia=300/df
|
||||||
ib=2700/df
|
ib=2700/df
|
||||||
n=0
|
n=0
|
||||||
fmouse=0.
|
fmouse=0.
|
||||||
if(mode.eq.2) fmouse=1270.46+MouseDF
|
if(mode.eq.2) fmouse=1270.46+MouseDF
|
||||||
if(mode.eq.4) fmouse=1076.66+MouseDF
|
if(mode.eq.4) fmouse=1076.66+MouseDF
|
||||||
|
|
||||||
do i=ia,ib
|
do i=ia,ib
|
||||||
if(birdie(i)-ref(i).gt.3.0) then
|
if(birdie(i)-ref(i).gt.3.0) then
|
||||||
f=i*df
|
f=i*df
|
||||||
|
|
||||||
C Don't zap unless Freeze is OFF or birdie is outside the "Tol" range.
|
C Don't zap unless Freeze is OFF or birdie is outside the "Tol" range.
|
||||||
if(NFreeze.eq.0 .or.
|
if(NFreeze.eq.0 .or.
|
||||||
+ abs(f-fmouse).gt.float(DFTolerance)) then
|
+ abs(f-fmouse).gt.float(DFTolerance)) then
|
||||||
if(n.lt.200 .and. variance(i-1).lt.2.5 .and.
|
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
|
+ variance(i).lt.2.5.and.variance(i+1).lt.2.5) then
|
||||||
n=n+1
|
n=n+1
|
||||||
fzap(n)=f
|
fzap(n)=f
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
return
|
return
|
||||||
end
|
end
|
||||||
|
|||||||
@ -9,7 +9,7 @@ subroutine decode1(iarg)
|
|||||||
use dflib
|
use dflib
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
character sending0*28,fcum*80,mode0*6,cshort*11
|
character sending0*28,mode0*6,cshort*11
|
||||||
integer sendingsh0
|
integer sendingsh0
|
||||||
|
|
||||||
include 'gcom1.f90'
|
include 'gcom1.f90'
|
||||||
|
|||||||
@ -5,7 +5,6 @@ subroutine decode2
|
|||||||
! Get data and parameters from gcom, then call the decoders
|
! Get data and parameters from gcom, then call the decoders
|
||||||
|
|
||||||
character fnamex*24
|
character fnamex*24
|
||||||
integer*2 d2d(30*11025)
|
|
||||||
|
|
||||||
include 'gcom1.f90'
|
include 'gcom1.f90'
|
||||||
include 'gcom2.f90'
|
include 'gcom2.f90'
|
||||||
|
|||||||
21
decode3.F90
21
decode3.F90
@ -5,12 +5,9 @@ subroutine decode3(d2,jz,istart,filename)
|
|||||||
use dfport
|
use dfport
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
integer*2 d2(jz),d2d(60*11025)
|
integer*2 d2(jz),d2d(65*11025)
|
||||||
real*8 sq
|
|
||||||
character*24 filename
|
character*24 filename
|
||||||
character FileID*40
|
character FileID*40
|
||||||
character mycall0*12,hiscall0*12,hisgrid0*6
|
|
||||||
logical savefile
|
|
||||||
include 'gcom1.f90'
|
include 'gcom1.f90'
|
||||||
include 'gcom2.f90'
|
include 'gcom2.f90'
|
||||||
|
|
||||||
@ -51,10 +48,20 @@ subroutine decode3(d2,jz,istart,filename)
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
open(23,file=appdir(:lenappdir)//'/CALL3.TXT',status='unknown')
|
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, &
|
call wsjt1(d2d,jz,istart,samfacin,FileID,ndepth,MinSigdB, &
|
||||||
NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve, &
|
NQRN,DFTolerance,MouseButton,NClearAve, &
|
||||||
nMode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65, &
|
nMode,NFreeze,NAFC,NZap,mode65, &
|
||||||
MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2, &
|
MyCall,HisCall,HisGrid,neme,nsked,ntx2,s2, &
|
||||||
ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg, &
|
ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg, &
|
||||||
MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
|
MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
|
||||||
close(23)
|
close(23)
|
||||||
|
|||||||
106
decode65.f
106
decode65.f
@ -1,53 +1,53 @@
|
|||||||
subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
|
subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
|
||||||
+ nsnr,mycall,hiscall,hisgrid,mode65,nafc,decoded,ncount,
|
+ mycall,hiscall,hisgrid,mode65,nafc,decoded,ncount,
|
||||||
+ deepmsg,qual)
|
+ deepmsg,qual)
|
||||||
|
|
||||||
C Decodes JT65 data, assuming that DT and DF have already been determined.
|
C Decodes JT65 data, assuming that DT and DF have already been determined.
|
||||||
|
|
||||||
real dat(npts) !Raw data
|
real dat(npts) !Raw data
|
||||||
real s2(77,126)
|
real s2(77,126)
|
||||||
real s3(64,63)
|
real s3(64,63)
|
||||||
real ftrack(126)
|
real ftrack(126)
|
||||||
character decoded*22,deepmsg*22
|
character decoded*22,deepmsg*22
|
||||||
character mycall*12,hiscall*12,hisgrid*6
|
character mycall*12,hiscall*12,hisgrid*6
|
||||||
include 'avecom.h'
|
include 'avecom.h'
|
||||||
include 'prcom.h'
|
include 'prcom.h'
|
||||||
save
|
save
|
||||||
|
|
||||||
dt=2.0/11025.0 !Sample interval (2x downsampled data)
|
dt=2.0/11025.0 !Sample interval (2x downsampled data)
|
||||||
istart=nint(dtx/dt) !Start index for synced FFTs
|
istart=nint(dtx/dt) !Start index for synced FFTs
|
||||||
nsym=126
|
nsym=126
|
||||||
|
|
||||||
C Compute spectra of the channel symbols
|
C Compute spectra of the channel symbols
|
||||||
f0=1270.46 + dfx
|
f0=1270.46 + dfx
|
||||||
call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,nafc,mode65,s2)
|
call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,nafc,mode65,s2)
|
||||||
|
|
||||||
do j=1,63
|
do j=1,63
|
||||||
k=mdat(j) !Points to data symbol
|
k=mdat(j) !Points to data symbol
|
||||||
if(flip.lt.0.0) k=mdat2(j)
|
if(flip.lt.0.0) k=mdat2(j)
|
||||||
do i=1,64
|
do i=1,64
|
||||||
s3(i,j)=s2(i+7,k)
|
s3(i,j)=s2(i+7,k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
nadd=mode65
|
nadd=mode65
|
||||||
|
|
||||||
call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message
|
call extract(s3,nadd,ncount,decoded) !Extract the message
|
||||||
qual=0.
|
qual=0.
|
||||||
if(ndepth.ge.1) call deep65(s3,mode65,neme,
|
if(ndepth.ge.1) call deep65(s3,mode65,neme,
|
||||||
+ nsked,flip,mycall,hiscall,hisgrid,deepmsg,qual)
|
+ nsked,flip,mycall,hiscall,hisgrid,deepmsg,qual)
|
||||||
|
|
||||||
if(ncount.lt.0) decoded=' '
|
if(ncount.lt.0) decoded=' '
|
||||||
|
|
||||||
C Suppress "birdie messages":
|
C Suppress "birdie messages":
|
||||||
if(decoded(1:7).eq.'000AAA ') decoded=' '
|
if(decoded(1:7).eq.'000AAA ') decoded=' '
|
||||||
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
|
if(decoded(1:7).eq.'0L6MWK ') decoded=' '
|
||||||
|
|
||||||
C Save symbol spectra for possible decoding of average.
|
C Save symbol spectra for possible decoding of average.
|
||||||
do j=1,63
|
do j=1,63
|
||||||
k=mdat(j)
|
k=mdat(j)
|
||||||
if(flip.lt.0.0) k=mdat2(j)
|
if(flip.lt.0.0) k=mdat2(j)
|
||||||
call move(s2(8,k),ppsave(1,j,nsave),64)
|
call move(s2(8,k),ppsave(1,j,nsave),64)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
return
|
return
|
||||||
end
|
end
|
||||||
|
|||||||
313
deep65.F
313
deep65.F
@ -1,158 +1,155 @@
|
|||||||
subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,
|
subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall,
|
||||||
+ hisgrid,decoded,qual)
|
+ hisgrid,decoded,qual)
|
||||||
|
|
||||||
parameter (MAXCALLS=7000,MAXRPT=63)
|
parameter (MAXCALLS=7000,MAXRPT=63)
|
||||||
real s3(64,63)
|
real s3(64,63)
|
||||||
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
|
character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3
|
||||||
character*12 mycall,hiscall
|
character*12 mycall,hiscall
|
||||||
character*22 decoded
|
character*22 decoded
|
||||||
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
|
character*22 testmsg(2*MAXCALLS + 2 + MAXRPT)
|
||||||
character*15 callgrid(MAXCALLS)
|
character*15 callgrid(MAXCALLS)
|
||||||
character*180 line
|
character*180 line
|
||||||
character*4 rpt(MAXRPT)
|
character*4 rpt(MAXRPT)
|
||||||
integer ncode(63,2*MAXCALLS + 2 + MAXRPT)
|
integer ncode(63,2*MAXCALLS + 2 + MAXRPT)
|
||||||
real pp(2*MAXCALLS + 2 + MAXRPT)
|
real pp(2*MAXCALLS + 2 + MAXRPT)
|
||||||
common/tmp9/ mrs(63),mrs2(63)
|
common/tmp9/ mrs(63),mrs2(63)
|
||||||
|
#ifdef Win32
|
||||||
data neme0/-99/
|
C This prevents some optimizations that break this subroutine.
|
||||||
data rpt/'-01','-02','-03','-04','-05',
|
volatile p1,p2,bias
|
||||||
+ '-06','-07','-08','-09','-10',
|
#endif
|
||||||
+ '-11','-12','-13','-14','-15',
|
|
||||||
+ '-16','-17','-18','-19','-20',
|
data neme0/-99/
|
||||||
+ '-21','-22','-23','-24','-25',
|
data rpt/'-01','-02','-03','-04','-05',
|
||||||
+ '-26','-27','-28','-29','-30',
|
+ '-06','-07','-08','-09','-10',
|
||||||
+ 'R-01','R-02','R-03','R-04','R-05',
|
+ '-11','-12','-13','-14','-15',
|
||||||
+ 'R-06','R-07','R-08','R-09','R-10',
|
+ '-16','-17','-18','-19','-20',
|
||||||
+ 'R-11','R-12','R-13','R-14','R-15',
|
+ '-21','-22','-23','-24','-25',
|
||||||
+ 'R-16','R-17','R-18','R-19','R-20',
|
+ '-26','-27','-28','-29','-30',
|
||||||
+ 'R-21','R-22','R-23','R-24','R-25',
|
+ 'R-01','R-02','R-03','R-04','R-05',
|
||||||
+ 'R-26','R-27','R-28','R-29','R-30',
|
+ 'R-06','R-07','R-08','R-09','R-10',
|
||||||
+ 'RO','RRR','73'/
|
+ 'R-11','R-12','R-13','R-14','R-15',
|
||||||
|
+ 'R-16','R-17','R-18','R-19','R-20',
|
||||||
rewind 23
|
+ 'R-21','R-22','R-23','R-24','R-25',
|
||||||
k=0
|
+ 'R-26','R-27','R-28','R-29','R-30',
|
||||||
icall=0
|
+ 'RO','RRR','73'/
|
||||||
do n=1,MAXCALLS
|
|
||||||
if(n.eq.1) then
|
rewind 23
|
||||||
callsign=hiscall
|
k=0
|
||||||
do i=4,12
|
icall=0
|
||||||
if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' '
|
do n=1,MAXCALLS
|
||||||
enddo
|
if(n.eq.1) then
|
||||||
grid=hisgrid(1:4)
|
callsign=hiscall
|
||||||
if(ichar(grid(3:3)).eq.0) grid(3:3)=' '
|
do i=4,12
|
||||||
if(ichar(grid(4:4)).eq.0) grid(4:4)=' '
|
if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' '
|
||||||
else
|
enddo
|
||||||
read(23,1002,end=20) line
|
grid=hisgrid(1:4)
|
||||||
1002 format (A80)
|
if(ichar(grid(3:3)).eq.0) grid(3:3)=' '
|
||||||
if(line(1:4).eq.'ZZZZ') go to 20
|
if(ichar(grid(4:4)).eq.0) grid(4:4)=' '
|
||||||
if(line(1:2).eq.'//') go to 10
|
else
|
||||||
i1=index(line,',')
|
read(23,1002,end=20) line
|
||||||
if(i1.lt.4) go to 10
|
1002 format (A80)
|
||||||
i2=index(line(i1+1:),',')
|
if(line(1:4).eq.'ZZZZ') go to 20
|
||||||
if(i2.lt.5) go to 10
|
if(line(1:2).eq.'//') go to 10
|
||||||
i2=i2+i1
|
i1=index(line,',')
|
||||||
i3=index(line(i2+1:),',')
|
if(i1.lt.4) go to 10
|
||||||
if(i3.lt.1) i3=index(line(i2+1:),' ')
|
i2=index(line(i1+1:),',')
|
||||||
i3=i2+i3
|
if(i2.lt.5) go to 10
|
||||||
callsign=line(1:i1-1)
|
i2=i2+i1
|
||||||
grid=line(i1+1:i2-1)
|
i3=index(line(i2+1:),',')
|
||||||
ceme=line(i2+1:i3-1)
|
if(i3.lt.1) i3=index(line(i2+1:),' ')
|
||||||
if(neme.eq.1 .and. ceme.ne.'EME') go to 10
|
i3=i2+i3
|
||||||
endif
|
callsign=line(1:i1-1)
|
||||||
|
grid=line(i1+1:i2-1)
|
||||||
icall=icall+1
|
ceme=line(i2+1:i3-1)
|
||||||
j1=index(mycall,' ') - 1
|
if(neme.eq.1 .and. ceme.ne.'EME') go to 10
|
||||||
if(j1.le.-1) j1=12
|
endif
|
||||||
if(j1.lt.3) j1=6
|
|
||||||
j2=index(callsign,' ') - 1
|
icall=icall+1
|
||||||
if(j2.le.-1) j2=12
|
j1=index(mycall,' ') - 1
|
||||||
if(j2.lt.3) j2=6
|
if(j1.le.-1) j1=12
|
||||||
j3=index(mycall,'/')
|
if(j1.lt.3) j1=6
|
||||||
j4=index(callsign,'/')
|
j2=index(callsign,' ') - 1
|
||||||
callgrid(icall)=callsign(1:j2)
|
if(j2.le.-1) j2=12
|
||||||
|
if(j2.lt.3) j2=6
|
||||||
mz=1
|
j3=index(mycall,'/')
|
||||||
if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and.
|
j4=index(callsign,'/')
|
||||||
+ flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1
|
callgrid(icall)=callsign(1:j2)
|
||||||
C Test for messages with MyCall + HisCall + report
|
|
||||||
do m=1,mz
|
mz=1
|
||||||
if(m.gt.1) grid=rpt(m-1)
|
if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and.
|
||||||
if(j3.lt.1 .and.j4.lt.1)
|
+ flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1
|
||||||
+ callgrid(icall)=callsign(1:j2)//' '//grid
|
C Test for messages with MyCall + HisCall + report
|
||||||
message=mycall(1:j1)//' '//callgrid(icall)
|
do m=1,mz
|
||||||
k=k+1
|
if(m.gt.1) grid=rpt(m-1)
|
||||||
testmsg(k)=message
|
if(j3.lt.1 .and.j4.lt.1)
|
||||||
call encode65(message,ncode(1,k))
|
+ callgrid(icall)=callsign(1:j2)//' '//grid
|
||||||
C Insert CQ message unless sync=OOO (flip=-1).
|
message=mycall(1:j1)//' '//callgrid(icall)
|
||||||
if(m.eq.1 .and. flip.gt.0.0) then
|
k=k+1
|
||||||
message='CQ '//callgrid(icall)
|
testmsg(k)=message
|
||||||
k=k+1
|
call encode65(message,ncode(1,k))
|
||||||
testmsg(k)=message
|
C Insert CQ message unless sync=OOO (flip=-1).
|
||||||
call encode65(message,ncode(1,k))
|
if(m.eq.1 .and. flip.gt.0.0) then
|
||||||
endif
|
message='CQ '//callgrid(icall)
|
||||||
enddo
|
k=k+1
|
||||||
if(nsked.eq.1) go to 20
|
testmsg(k)=message
|
||||||
10 enddo
|
call encode65(message,ncode(1,k))
|
||||||
20 ntot=k
|
endif
|
||||||
neme0=neme
|
enddo
|
||||||
|
if(nsked.eq.1) go to 20
|
||||||
ref0=0.
|
10 continue
|
||||||
do j=1,63
|
enddo
|
||||||
ref0=ref0 + s3(mrs(j),j)
|
20 ntot=k
|
||||||
enddo
|
neme0=neme
|
||||||
|
|
||||||
p1=-1.e30
|
ref0=0.
|
||||||
p2=-1.e30
|
do j=1,63
|
||||||
do k=1,ntot
|
ref0=ref0 + s3(mrs(j),j)
|
||||||
sum=0.
|
enddo
|
||||||
ref=ref0
|
|
||||||
do j=1,63
|
p1=-1.e30
|
||||||
i=ncode(j,k)+1
|
p2=-1.e30
|
||||||
sum=sum + s3(i,j)
|
do k=1,ntot
|
||||||
if(i.eq.mrs(j)) then
|
sum=0.
|
||||||
ref=ref - s3(i,j) + s3(mrs2(j),j)
|
ref=ref0
|
||||||
endif
|
do j=1,63
|
||||||
enddo
|
i=ncode(j,k)+1
|
||||||
p=sum/ref
|
sum=sum + s3(i,j)
|
||||||
pp(k)=p
|
if(i.eq.mrs(j)) then
|
||||||
if(p.gt.p1) then
|
ref=ref - s3(i,j) + s3(mrs2(j),j)
|
||||||
p1=p
|
endif
|
||||||
ip1=k
|
enddo
|
||||||
endif
|
p=sum/ref
|
||||||
enddo
|
pp(k)=p
|
||||||
|
if(p.gt.p1) then
|
||||||
p2=-1.e30
|
p1=p
|
||||||
do i=1,ntot
|
ip1=k
|
||||||
if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i)
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if(mode65.eq.1) bias=max(1.12*p2,0.335)
|
p2=-1.e30
|
||||||
if(mode65.eq.2) bias=max(1.08*p2,0.405)
|
do i=1,ntot
|
||||||
if(mode65.ge.4) bias=max(1.04*p2,0.505)
|
if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
C This is really weird, but do not remove the following statements!
|
if(mode65.eq.1) bias=max(1.12*p2,0.335)
|
||||||
! write(77,*) mode65,bias,p1,p2
|
if(mode65.eq.2) bias=max(1.08*p2,0.405)
|
||||||
! rewind 77
|
if(mode65.ge.4) bias=max(1.04*p2,0.505)
|
||||||
! rewind 23
|
qual=100.0*(p1-bias)
|
||||||
call sleepqqq(1)
|
decoded=' '
|
||||||
|
c=' '
|
||||||
qual=100.0*(p1-bias)
|
|
||||||
decoded=' '
|
if(qual.gt.1.0) then
|
||||||
c=' '
|
if(qual.lt.6.0) c='?'
|
||||||
|
decoded=testmsg(ip1)
|
||||||
if(qual.gt.1.0) then
|
else
|
||||||
if(qual.lt.6.0) c='?'
|
qual=0.
|
||||||
decoded=testmsg(ip1)
|
endif
|
||||||
else
|
decoded(22:22)=c
|
||||||
qual=0.
|
C Make sure everything is upper case.
|
||||||
endif
|
do i=1,22
|
||||||
decoded(22:22)=c
|
if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z')
|
||||||
C Make sure everything is upper case.
|
+ decoded(i:i)=char(ichar(decoded(i:i))-32)
|
||||||
do i=1,22
|
enddo
|
||||||
if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z')
|
|
||||||
+ decoded(i:i)=char(ichar(decoded(i:i))-32)
|
return
|
||||||
enddo
|
end
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|||||||
150
extract.f
150
extract.f
@ -1,77 +1,73 @@
|
|||||||
subroutine extract(s3,nadd,ndepth,ncount,decoded)
|
subroutine extract(s3,nadd,ncount,decoded)
|
||||||
|
|
||||||
real s3(64,63)
|
real s3(64,63)
|
||||||
character decoded*22
|
character decoded*22
|
||||||
integer*1 dat1(12)
|
integer era(51),dat4(12),indx(63)
|
||||||
integer dat(63),era(51),dat4(12),indx(63)
|
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
|
||||||
integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63)
|
logical first
|
||||||
logical first
|
data first/.true./,nsec1/0/
|
||||||
data first/.true./,nsec1/0/
|
save
|
||||||
save
|
|
||||||
|
call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
|
||||||
call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow)
|
|
||||||
|
if(ntest.lt.50 .or. nlow.gt.20) then
|
||||||
if(ntest.lt.50 .or. nlow.gt.20) then
|
ncount=-999 !Flag bad data
|
||||||
ncount=-999 !Flag bad data
|
go to 900
|
||||||
go to 900
|
endif
|
||||||
endif
|
|
||||||
|
call graycode(mrsym,63,-1)
|
||||||
call graycode(mrsym,63,-1)
|
call interleave63(mrsym,-1)
|
||||||
call interleave63(mrsym,-1)
|
call interleave63(mrprob,-1)
|
||||||
call interleave63(mrprob,-1)
|
|
||||||
|
ndec=1
|
||||||
ndec=1
|
nemax=30
|
||||||
nemax=30
|
maxe=8
|
||||||
maxe=8
|
xlambda=15.0
|
||||||
! if(ndepth.ge.2) ndec=1
|
|
||||||
! if(ndepth.eq.2) xlambda=13.0
|
if(ndec.eq.1) then
|
||||||
! if(ndepth.eq.3) xlambda=15.0
|
call graycode(mr2sym,63,-1)
|
||||||
xlambda=15.0
|
call interleave63(mr2sym,-1)
|
||||||
|
call interleave63(mr2prob,-1)
|
||||||
if(ndec.eq.1) then
|
|
||||||
call graycode(mr2sym,63,-1)
|
nsec1=nsec1+1
|
||||||
call interleave63(mr2sym,-1)
|
write(22,rec=1) nsec1,xlambda,maxe,200,
|
||||||
call interleave63(mr2prob,-1)
|
+ mrsym,mrprob,mr2sym,mr2prob
|
||||||
|
call flushqqq(22)
|
||||||
nsec1=nsec1+1
|
call runqqq('kvasd.exe','-q',iret)
|
||||||
write(22,rec=1) nsec1,xlambda,maxe,200,
|
if(iret.ne.0) then
|
||||||
+ mrsym,mrprob,mr2sym,mr2prob
|
if(first) write(*,1000)
|
||||||
call flushqqq(22)
|
1000 format('Error in KV decoder, or no KV decoder present.'/
|
||||||
call runqqq('kvasd.exe','-q',iret)
|
+ 'Using BM algorithm.')
|
||||||
if(iret.ne.0) then
|
ndec=0
|
||||||
if(first) write(*,1000)
|
first=.false.
|
||||||
1000 format('Error in KV decoder, or no KV decoder present.'/
|
go to 20
|
||||||
+ 'Using BM algorithm.')
|
endif
|
||||||
ndec=0
|
read(22,rec=2) nsec2,ncount,dat4
|
||||||
first=.false.
|
decoded=' '
|
||||||
go to 20
|
if(ncount.ge.0) then
|
||||||
endif
|
call unpackmsg(dat4,decoded) !Unpack the user message
|
||||||
read(22,rec=2) nsec2,ncount,dat4
|
endif
|
||||||
decoded=' '
|
endif
|
||||||
if(ncount.ge.0) then
|
20 if(ndec.eq.0) then
|
||||||
call unpackmsg(dat4,decoded) !Unpack the user message
|
call indexx(63,mrprob,indx)
|
||||||
endif
|
do i=1,nemax
|
||||||
endif
|
j=indx(i)
|
||||||
20 if(ndec.eq.0) then
|
if(mrprob(j).gt.120) then
|
||||||
call indexx(63,mrprob,indx)
|
ne2=i-1
|
||||||
do i=1,nemax
|
go to 2
|
||||||
j=indx(i)
|
endif
|
||||||
if(mrprob(j).gt.120) then
|
era(i)=j-1
|
||||||
ne2=i-1
|
enddo
|
||||||
go to 2
|
ne2=nemax
|
||||||
endif
|
2 decoded=' '
|
||||||
era(i)=j-1
|
do nerase=0,ne2,2
|
||||||
enddo
|
call rs_decode(mrsym,era,nerase,dat4,ncount)
|
||||||
ne2=nemax
|
if(ncount.ge.0) then
|
||||||
2 decoded=' '
|
call unpackmsg(dat4,decoded)
|
||||||
do nerase=0,ne2,2
|
go to 900
|
||||||
call rs_decode(mrsym,era,nerase,dat4,ncount)
|
endif
|
||||||
if(ncount.ge.0) then
|
enddo
|
||||||
call unpackmsg(dat4,decoded)
|
endif
|
||||||
go to 900
|
|
||||||
endif
|
900 return
|
||||||
enddo
|
end
|
||||||
endif
|
|
||||||
|
|
||||||
900 return
|
|
||||||
end
|
|
||||||
|
|||||||
64
fivehz.F90
64
fivehz.F90
@ -14,8 +14,10 @@ subroutine fivehz
|
|||||||
use dfport
|
use dfport
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
parameter (NTRING=64)
|
||||||
|
real*8 tt1(0:NTRING-1)
|
||||||
real*8 tstart,tstop,t60
|
real*8 tstart,tstop,t60
|
||||||
logical first,txtime,debug
|
logical first,txtime,debug,filled
|
||||||
integer ptt
|
integer ptt
|
||||||
integer TxOKz
|
integer TxOKz
|
||||||
real*8 fs,fsample,tt,tt0,u
|
real*8 fs,fsample,tt,tt0,u
|
||||||
@ -40,22 +42,36 @@ subroutine fivehz
|
|||||||
ibuf00=-99
|
ibuf00=-99
|
||||||
ncall=-1
|
ncall=-1
|
||||||
tt0=tt
|
tt0=tt
|
||||||
u=0.1d0
|
u=0.05d0
|
||||||
fsample=11025.d0
|
fsample=11025.d0
|
||||||
maxms=0
|
maxms=0
|
||||||
mfsample=110250
|
mfsample=110250
|
||||||
|
filled=.false.
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if(txdelay.lt.0.2d0) txdelay=0.2d0
|
if(txdelay.lt.0.2d0) txdelay=0.2d0
|
||||||
|
|
||||||
! Measure average sampling frequency over a recent interval
|
! Measure average sampling frequency over a recent interval
|
||||||
|
|
||||||
ncall=ncall+1
|
ncall=ncall+1
|
||||||
if(ncall.eq.9) tt0=tt
|
if(ncall.eq.9) then
|
||||||
if(ncall.ge.10 .and. mod(ncall,2).eq.1) then
|
tt0=tt
|
||||||
fs=(ncall-9)*2048.d0/(tt-tt0)
|
ntt0=0
|
||||||
fsample=u*fs + (1.d0-u)*fsample
|
ntt1=0
|
||||||
mfsample=nint(10.d0*fsample)
|
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
|
endif
|
||||||
|
|
||||||
if(trperiod.le.0) trperiod=30
|
if(trperiod.le.0) trperiod=30
|
||||||
@ -180,7 +196,9 @@ subroutine fivehztx
|
|||||||
use dfport
|
use dfport
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
logical first
|
parameter (NTRING=64)
|
||||||
|
real*8 tt1(0:NTRING-1)
|
||||||
|
logical first,filled
|
||||||
real*8 fs,fsample,tt,tt0,u
|
real*8 fs,fsample,tt,tt0,u
|
||||||
include 'gcom1.f90'
|
include 'gcom1.f90'
|
||||||
data first/.true./
|
data first/.true./
|
||||||
@ -195,18 +213,34 @@ subroutine fivehztx
|
|||||||
ncall=-1
|
ncall=-1
|
||||||
fsample=11025.d0
|
fsample=11025.d0
|
||||||
nsec0=-999
|
nsec0=-999
|
||||||
u=0.1d0
|
u=0.05d0
|
||||||
mfsample2=110250
|
mfsample2=110250
|
||||||
tt0=tt
|
tt0=tt
|
||||||
|
filled=.false.
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
! Measure average sampling frequency over a recent interval
|
||||||
ncall=ncall+1
|
ncall=ncall+1
|
||||||
if(ncall.eq.9) tt0=tt
|
if(ncall.eq.9) then
|
||||||
if(ncall.ge.10 .and. mod(ncall,2).eq.1) then
|
tt0=tt
|
||||||
fs=(ncall-9)*2048.d0/(tt-tt0)
|
ntt0=0
|
||||||
fsample=u*fs + (1.d0-u)*fsample
|
ntt1=0
|
||||||
mfsample2=nint(10.d0*fsample)
|
tt1(ntt1)=tt
|
||||||
endif
|
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
|
return
|
||||||
end subroutine fivehztx
|
end subroutine fivehztx
|
||||||
|
|
||||||
|
|||||||
@ -20,6 +20,7 @@ integer nrestart !True if transmission should restart GUI,SoundIn
|
|||||||
integer ntr !Are we in 2nd sequence? SoundIn
|
integer ntr !Are we in 2nd sequence? SoundIn
|
||||||
integer nmsg !Length of Tx message SoundIn
|
integer nmsg !Length of Tx message SoundIn
|
||||||
integer nsave !Which files to save? GUI
|
integer nsave !Which files to save? GUI
|
||||||
|
integer nadd5 !Prepend 5 sec of 0's before decoding? GUI
|
||||||
integer dftolerance !DF tolerance (Hz) GUI
|
integer dftolerance !DF tolerance (Hz) GUI
|
||||||
logical LDecoded !Was a message decoded? Decoder
|
logical LDecoded !Was a message decoded? Decoder
|
||||||
logical rxdone !Has the Rx sequence finished? SoundIn,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), &
|
common/gcom2/ps0(431),psavg(450),s2(64,3100),ccf(-5:540), &
|
||||||
green(500),ngreen,dgain,iter,ndecoding,ndecoding0,mousebutton, &
|
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, &
|
dftolerance,LDecoded,rxdone,monitoring,nzap,nsavecum,minsigdb, &
|
||||||
nclearave,nfreeze,nafc,nmode,mode65,nclip,ndebug,nblank,nport, &
|
nclearave,nfreeze,nafc,nmode,mode65,nclip,ndebug,nblank,nport, &
|
||||||
mousedf,neme,nsked,naggressive,ntx2,nslim2,nagain,nsavelast, &
|
mousedf,neme,nsked,naggressive,ntx2,nslim2,nagain,nsavelast, &
|
||||||
|
|||||||
160
gencw.f
160
gencw.f
@ -1,80 +1,80 @@
|
|||||||
subroutine gencw(msg,wpm,freqcw,samfac,TRPeriod,iwave,nwave)
|
subroutine gencw(msg,wpm,freqcw,samfac,TRPeriod,iwave,nwave)
|
||||||
|
|
||||||
parameter (NMAX=150*11025)
|
parameter (NMAX=150*11025)
|
||||||
character msg*22,word12*22,word3*22
|
character msg*22,word12*22,word3*22
|
||||||
integer*2 iwave(NMAX)
|
integer*2 iwave(NMAX)
|
||||||
integer TRPeriod
|
integer TRPeriod
|
||||||
|
|
||||||
integer*1 idat(5000),idat1(460),idat2(200),i1
|
integer*1 idat(5000),idat1(460),idat2(200)
|
||||||
real*8 dt,t,twopi,pha,dpha,tdit,samfac
|
real*8 dt,t,twopi,pha,dpha,tdit,samfac
|
||||||
data twopi/6.283185307d0/
|
data twopi/6.283185307d0/
|
||||||
|
|
||||||
nwords=0
|
nwords=0
|
||||||
do i=2,22
|
do i=2,22
|
||||||
if(msg(i-1:i).eq.' ') go to 10
|
if(msg(i-1:i).eq.' ') go to 10
|
||||||
if(msg(i:i).eq.' ') then
|
if(msg(i:i).eq.' ') then
|
||||||
nwords=nwords+1
|
nwords=nwords+1
|
||||||
j=j0
|
j=j0
|
||||||
j0=i+1
|
j0=i+1
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
10 ntype=1 !Call1+Call2, CQ+Call
|
10 ntype=1 !Call1+Call2, CQ+Call
|
||||||
word12=msg
|
word12=msg
|
||||||
if(nwords.eq.3) then
|
if(nwords.eq.3) then
|
||||||
word3=msg(j:j0-1)
|
word3=msg(j:j0-1)
|
||||||
word12(j-1:)=' '
|
word12(j-1:)=' '
|
||||||
ntype=3 !BC+RO, BC+RRR, BC+73
|
ntype=3 !BC+RO, BC+RRR, BC+73
|
||||||
if(word3.eq.'OOO') ntype=2 !BC+OOO
|
if(word3.eq.'OOO') ntype=2 !BC+OOO
|
||||||
endif
|
endif
|
||||||
|
|
||||||
tdit=1.2d0/wpm !Key-down dit time, seconds
|
tdit=1.2d0/wpm !Key-down dit time, seconds
|
||||||
call morse(word12,idat1,nmax1) !Encode part 1 of msg
|
call morse(word12,idat1,nmax1) !Encode part 1 of msg
|
||||||
t1=tdit*nmax1 !Time for part1, once
|
t1=tdit*nmax1 !Time for part1, once
|
||||||
nrpt1=TRPeriod/t1 !Repetitions of part 1
|
nrpt1=TRPeriod/t1 !Repetitions of part 1
|
||||||
if(ntype.eq.2) nrpt1=0.75*TRPeriod/t1
|
if(ntype.eq.2) nrpt1=0.75*TRPeriod/t1
|
||||||
if(ntype.eq.3) nrpt1=1
|
if(ntype.eq.3) nrpt1=1
|
||||||
t1=nrpt1*t1 !Total time for part 1
|
t1=nrpt1*t1 !Total time for part 1
|
||||||
nrpt2=0
|
nrpt2=0
|
||||||
t2=0.
|
t2=0.
|
||||||
if(ntype.ge.2) then
|
if(ntype.ge.2) then
|
||||||
call morse(word3,idat2,nmax2) !Encode part 2
|
call morse(word3,idat2,nmax2) !Encode part 2
|
||||||
t2=tdit*nmax2 !Time for part 2, once
|
t2=tdit*nmax2 !Time for part 2, once
|
||||||
nrpt2=(TRPeriod-t1)/t2 !Repetitions of part 2
|
nrpt2=(TRPeriod-t1)/t2 !Repetitions of part 2
|
||||||
t2=nrpt2*t2 !Total time for part 2
|
t2=nrpt2*t2 !Total time for part 2
|
||||||
endif
|
endif
|
||||||
|
|
||||||
j=0
|
j=0
|
||||||
do n=1,nrpt1
|
do n=1,nrpt1
|
||||||
do i=1,nmax1
|
do i=1,nmax1
|
||||||
j=j+1
|
j=j+1
|
||||||
idat(j)=idat1(i)
|
idat(j)=idat1(i)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do n=1,nrpt2
|
do n=1,nrpt2
|
||||||
do i=1,nmax2
|
do i=1,nmax2
|
||||||
j=j+1
|
j=j+1
|
||||||
idat(j)=idat2(i)
|
idat(j)=idat2(i)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
dt=1.d0/(11025.d0*samfac)
|
dt=1.d0/(11025.d0*samfac)
|
||||||
nwave=j*tdit/dt
|
nwave=j*tdit/dt
|
||||||
pha=0.
|
pha=0.
|
||||||
dpha=twopi*freqcw*dt
|
dpha=twopi*freqcw*dt
|
||||||
t=0.
|
t=0.
|
||||||
s=0.
|
s=0.
|
||||||
u=wpm/(11025*0.03)
|
u=wpm/(11025*0.03)
|
||||||
do i=1,nwave
|
do i=1,nwave
|
||||||
t=t+dt
|
t=t+dt
|
||||||
pha=pha+dpha
|
pha=pha+dpha
|
||||||
j=t/tdit + 1
|
j=t/tdit + 1
|
||||||
! iwave(i)=0
|
! iwave(i)=0
|
||||||
! if(idat(j).ne.0) iwave(i)=nint(32767.d0*sin(pha))
|
! if(idat(j).ne.0) iwave(i)=nint(32767.d0*sin(pha))
|
||||||
s=s + u*(idat(j)-s)
|
s=s + u*(idat(j)-s)
|
||||||
iwave(i)=nint(s*32767.d0*sin(pha))
|
iwave(i)=nint(s*32767.d0*sin(pha))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
return
|
return
|
||||||
end
|
end
|
||||||
|
|
||||||
include 'gencwid.f'
|
include 'gencwid.f'
|
||||||
|
|||||||
@ -10,7 +10,7 @@
|
|||||||
if(k.ge.1 .and. k.le.NZ) then
|
if(k.ge.1 .and. k.le.NZ) then
|
||||||
iz=index(pfx(k),' ') - 1
|
iz=index(pfx(k),' ') - 1
|
||||||
callsign=pfx(k)(1:iz)//'/'//callsign
|
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
|
iz=index(callsign,' ') - 1
|
||||||
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
||||||
else if(k.eq.449) then
|
else if(k.eq.449) then
|
||||||
|
|||||||
19
jtaudio.c
19
jtaudio.c
@ -1,5 +1,10 @@
|
|||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <portaudio.h>
|
#include <portaudio.h>
|
||||||
|
#include <string.h>
|
||||||
|
|
||||||
|
void fivehz_();
|
||||||
|
void fivehztx_();
|
||||||
|
void addnoise_(short int *n);
|
||||||
|
|
||||||
// Definition of structure pointing to the audio data
|
// Definition of structure pointing to the audio data
|
||||||
typedef struct
|
typedef struct
|
||||||
@ -66,7 +71,6 @@ static int SoundIn( void *inputBuffer, void *outputBuffer,
|
|||||||
{
|
{
|
||||||
paTestData *data = (paTestData*)userData;
|
paTestData *data = (paTestData*)userData;
|
||||||
short *in = (short*)inputBuffer;
|
short *in = (short*)inputBuffer;
|
||||||
short *wptr = (short*)outputBuffer;
|
|
||||||
unsigned int i;
|
unsigned int i;
|
||||||
static int n0;
|
static int n0;
|
||||||
static int ia=0;
|
static int ia=0;
|
||||||
@ -99,8 +103,8 @@ static int SoundIn( void *inputBuffer, void *outputBuffer,
|
|||||||
// if((inputBuffer==NULL) & (ncall>2) & (stime>stime0)) {
|
// if((inputBuffer==NULL) & (ncall>2) & (stime>stime0)) {
|
||||||
if((statusFlags!=0) & (ncall>2) & (stime>stime0)) {
|
if((statusFlags!=0) & (ncall>2) & (stime>stime0)) {
|
||||||
if(*data->ndebug)
|
if(*data->ndebug)
|
||||||
printf("Status flags %d at Tsec = %7.1f s, DT = %7.1f\n",stime,
|
printf("Status flags %d at Tsec = %7.1f s, DT = %7.1f\n",
|
||||||
stime-stime0);
|
statusFlags,stime,stime-stime0);
|
||||||
stime0=stime;
|
stime0=stime;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -134,7 +138,6 @@ static int SoundOut( void *inputBuffer, void *outputBuffer,
|
|||||||
void *userData )
|
void *userData )
|
||||||
{
|
{
|
||||||
paTestData *data = (paTestData*)userData;
|
paTestData *data = (paTestData*)userData;
|
||||||
short *in = (short*)inputBuffer;
|
|
||||||
short *wptr = (short*)outputBuffer;
|
short *wptr = (short*)outputBuffer;
|
||||||
unsigned int i,n;
|
unsigned int i,n;
|
||||||
static short int n2;
|
static short int n2;
|
||||||
@ -202,9 +205,9 @@ int jtaudio_(int *ndevin, int *ndevout, short y1[], short y2[],
|
|||||||
PaStream *outstream;
|
PaStream *outstream;
|
||||||
PaStreamParameters inputParameters;
|
PaStreamParameters inputParameters;
|
||||||
PaStreamParameters outputParameters;
|
PaStreamParameters outputParameters;
|
||||||
PaStreamInfo *streamInfo;
|
// PaStreamInfo *streamInfo;
|
||||||
|
|
||||||
int i,nfs,ndin,ndout;
|
int nfs,ndin,ndout;
|
||||||
PaError err1,err2,err2a,err3,err3a;
|
PaError err1,err2,err2a,err3,err3a;
|
||||||
double dnfs;
|
double dnfs;
|
||||||
|
|
||||||
@ -318,11 +321,11 @@ error:
|
|||||||
int padevsub_(int *numdev, int *ndefin, int *ndefout,
|
int padevsub_(int *numdev, int *ndefin, int *ndefout,
|
||||||
int nchin[], int nchout[])
|
int nchin[], int nchout[])
|
||||||
{
|
{
|
||||||
int i,j,n;
|
int i;
|
||||||
int numDevices;
|
int numDevices;
|
||||||
const PaDeviceInfo *pdi;
|
const PaDeviceInfo *pdi;
|
||||||
PaError err;
|
PaError err;
|
||||||
PaHostApiInfo *hostapi;
|
// PaHostApiInfo *hostapi;
|
||||||
|
|
||||||
Pa_Initialize();
|
Pa_Initialize();
|
||||||
|
|
||||||
|
|||||||
256
longx.f
256
longx.f
@ -1,128 +1,128 @@
|
|||||||
subroutine longx(dat,npts0,ps,DFTolerance,noffset,
|
subroutine longx(dat,npts0,ps,DFTolerance,noffset,
|
||||||
+ msg,msglen,bauderr,MouseButton)
|
+ msg,msglen,bauderr)
|
||||||
|
|
||||||
C Look for 441-baud modulation, synchronize to it, and decode message.
|
C Look for 441-baud modulation, synchronize to it, and decode message.
|
||||||
C Longest allowed data analysis is 1 second.
|
C Longest allowed data analysis is 1 second.
|
||||||
|
|
||||||
parameter (NMAX=11025)
|
parameter (NMAX=11025)
|
||||||
parameter (NDMAX=NMAX/25)
|
parameter (NDMAX=NMAX/25)
|
||||||
real dat(npts0)
|
real dat(npts0)
|
||||||
real ps(128),psmo(20)
|
real ps(128),psmo(20)
|
||||||
integer DFTolerance
|
integer DFTolerance
|
||||||
real y1(NMAX)
|
real y1(NMAX)
|
||||||
real y2(NMAX)
|
real y2(NMAX)
|
||||||
real y3(NMAX)
|
real y3(NMAX)
|
||||||
real y4(NMAX)
|
real y4(NMAX)
|
||||||
real wgt(-2:2)
|
real wgt(-2:2)
|
||||||
integer dit(NDMAX)
|
integer dit(NDMAX)
|
||||||
integer n4(0:2)
|
integer n4(0:2)
|
||||||
character msg*40
|
character msg*40
|
||||||
character c*48
|
character c*48
|
||||||
common/acom/a1,a2,a3,a4
|
common/acom/a1,a2,a3,a4
|
||||||
data c/' 123456789.,?/# $ABCD FGHIJKLMNOPQRSTUVWXY 0EZ '/
|
data c/' 123456789.,?/# $ABCD FGHIJKLMNOPQRSTUVWXY 0EZ '/
|
||||||
data wgt/1.0,4.0,6.0,4.0,1.0/
|
data wgt/1.0,4.0,6.0,4.0,1.0/
|
||||||
|
|
||||||
NSPD=25 !Change if FSK110 is implemented
|
NSPD=25 !Change if FSK110 is implemented
|
||||||
LTone=2
|
LTone=2
|
||||||
NBaud=11025/NSPD
|
NBaud=11025/NSPD
|
||||||
npts=min(NMAX,npts0)
|
npts=min(NMAX,npts0)
|
||||||
df=11025.0/256.0
|
df=11025.0/256.0
|
||||||
smax=0.
|
smax=0.
|
||||||
|
|
||||||
C Find the frequency offset of this ping.
|
C Find the frequency offset of this ping.
|
||||||
C NB: this might be improved by including a bandpass correction to ps.
|
C NB: this might be improved by including a bandpass correction to ps.
|
||||||
|
|
||||||
ia=nint((LTone*NBaud-DFTolerance)/df)
|
ia=nint((LTone*NBaud-DFTolerance)/df)
|
||||||
ib=nint((LTone*NBaud+DFTolerance)/df)
|
ib=nint((LTone*NBaud+DFTolerance)/df)
|
||||||
|
|
||||||
do i=ia,ib !Search for correct DF
|
do i=ia,ib !Search for correct DF
|
||||||
sum=0.
|
sum=0.
|
||||||
do j=1,4 !Sum over the 4 tones
|
do j=1,4 !Sum over the 4 tones
|
||||||
m=nint((i*df+(j-1)*NBaud)/df)
|
m=nint((i*df+(j-1)*NBaud)/df)
|
||||||
do k=-2,2 !Weighted averages over 5 bins
|
do k=-2,2 !Weighted averages over 5 bins
|
||||||
sum=sum+wgt(k)*ps(m+k)
|
sum=sum+wgt(k)*ps(m+k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
k=i-ia+1
|
k=i-ia+1
|
||||||
psmo(k)=sum
|
psmo(k)=sum
|
||||||
kpk=0
|
kpk=0
|
||||||
if(sum.gt.smax) then
|
if(sum.gt.smax) then
|
||||||
smax=sum
|
smax=sum
|
||||||
noffset=nint(i*df-LTone*NBaud)
|
noffset=nint(i*df-LTone*NBaud)
|
||||||
kpk=k
|
kpk=k
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
|
||||||
if(kpk.gt.1 .and. kpk.lt.20) then
|
if(kpk.gt.1 .and. kpk.lt.20) then
|
||||||
call peakup(psmo(kpk-1),psmo(kpk),psmo(kpk+1),dx)
|
call peakup(psmo(kpk-1),psmo(kpk),psmo(kpk+1),dx)
|
||||||
noffset=nint(noffset+dx*df)
|
noffset=nint(noffset+dx*df)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
C Do square-law detection in each of four filters.
|
C Do square-law detection in each of four filters.
|
||||||
f1=LTone*NBaud+noffset
|
f1=LTone*NBaud+noffset
|
||||||
f2=(LTone+1)*NBaud+noffset
|
f2=(LTone+1)*NBaud+noffset
|
||||||
f3=(LTone+2)*NBaud+noffset
|
f3=(LTone+2)*NBaud+noffset
|
||||||
f4=(LTone+3)*NBaud+noffset
|
f4=(LTone+3)*NBaud+noffset
|
||||||
call detect(dat,npts,f1,y1)
|
call detect(dat,npts,f1,y1)
|
||||||
call detect(dat,npts,f2,y2)
|
call detect(dat,npts,f2,y2)
|
||||||
call detect(dat,npts,f3,y3)
|
call detect(dat,npts,f3,y3)
|
||||||
call detect(dat,npts,f4,y4)
|
call detect(dat,npts,f4,y4)
|
||||||
|
|
||||||
C Bandpass correction:
|
C Bandpass correction:
|
||||||
npts=npts-(NSPD-1)
|
npts=npts-(NSPD-1)
|
||||||
do i=1,npts
|
do i=1,npts
|
||||||
y1(i)=y1(i)*a1
|
y1(i)=y1(i)*a1
|
||||||
y2(i)=y2(i)*a2
|
y2(i)=y2(i)*a2
|
||||||
y3(i)=y3(i)*a3
|
y3(i)=y3(i)*a3
|
||||||
y4(i)=y4(i)*a4
|
y4(i)=y4(i)*a4
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call sync(y1,y2,y3,y4,npts,jpk,baud,bauderr)
|
call sync(y1,y2,y3,y4,npts,jpk,baud,bauderr)
|
||||||
|
|
||||||
C Decimate y arrays by NSPD
|
C Decimate y arrays by NSPD
|
||||||
ndits=npts/NSPD - 1
|
ndits=npts/NSPD - 1
|
||||||
do i=1,ndits
|
do i=1,ndits
|
||||||
y1(i)=y1(jpk+(i-1)*NSPD)
|
y1(i)=y1(jpk+(i-1)*NSPD)
|
||||||
y2(i)=y2(jpk+(i-1)*NSPD)
|
y2(i)=y2(jpk+(i-1)*NSPD)
|
||||||
y3(i)=y3(jpk+(i-1)*NSPD)
|
y3(i)=y3(jpk+(i-1)*NSPD)
|
||||||
y4(i)=y4(jpk+(i-1)*NSPD)
|
y4(i)=y4(jpk+(i-1)*NSPD)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
C Now find the mod3 phase that has no tone 3's
|
C Now find the mod3 phase that has no tone 3's
|
||||||
n4(0)=0
|
n4(0)=0
|
||||||
n4(1)=0
|
n4(1)=0
|
||||||
n4(2)=0
|
n4(2)=0
|
||||||
do i=1,ndits
|
do i=1,ndits
|
||||||
ymax=max(y1(i),y2(i),y3(i),y4(i))
|
ymax=max(y1(i),y2(i),y3(i),y4(i))
|
||||||
if(y1(i).eq.ymax) dit(i)=0
|
if(y1(i).eq.ymax) dit(i)=0
|
||||||
if(y2(i).eq.ymax) dit(i)=1
|
if(y2(i).eq.ymax) dit(i)=1
|
||||||
if(y3(i).eq.ymax) dit(i)=2
|
if(y3(i).eq.ymax) dit(i)=2
|
||||||
if(y4(i).eq.ymax) then
|
if(y4(i).eq.ymax) then
|
||||||
dit(i)=3
|
dit(i)=3
|
||||||
k=mod(i,3)
|
k=mod(i,3)
|
||||||
n4(k)=n4(k)+1
|
n4(k)=n4(k)+1
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
n4min=min(n4(0),n4(1),n4(2))
|
n4min=min(n4(0),n4(1),n4(2))
|
||||||
if(n4min.eq.n4(0)) jsync=3
|
if(n4min.eq.n4(0)) jsync=3
|
||||||
if(n4min.eq.n4(1)) jsync=1
|
if(n4min.eq.n4(1)) jsync=1
|
||||||
if(n4min.eq.n4(2)) jsync=2
|
if(n4min.eq.n4(2)) jsync=2
|
||||||
C Might want to notify if n4min>0 or if one of the others is equal
|
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 to n4min. In both cases, could then decode 2 or 3 times, using
|
||||||
C other starting phases.
|
C other starting phases.
|
||||||
|
|
||||||
C Finally, decode the message.
|
C Finally, decode the message.
|
||||||
msg=' '
|
msg=' '
|
||||||
msglen=ndits/3
|
msglen=ndits/3
|
||||||
msglen=min(msglen,40)
|
msglen=min(msglen,40)
|
||||||
do i=1,msglen
|
do i=1,msglen
|
||||||
j=(i-1)*3+jsync
|
j=(i-1)*3+jsync
|
||||||
nc=16*dit(j) + 4*dit(j+1) +dit(j+2)
|
nc=16*dit(j) + 4*dit(j+1) +dit(j+2)
|
||||||
msg(i:i)=' '
|
msg(i:i)=' '
|
||||||
if(nc.le.47) msg(i:i)=c(nc+1:nc+1)
|
if(nc.le.47) msg(i:i)=c(nc+1:nc+1)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
return
|
return
|
||||||
end
|
end
|
||||||
|
|||||||
296
mtdecode.f
296
mtdecode.f
@ -1,149 +1,147 @@
|
|||||||
subroutine mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth,
|
subroutine mtdecode(dat,jz,nz,MinSigdB,MinWidth,
|
||||||
+ NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum,
|
+ NQRN,DFTolerance,istart,pick,cfile6,ps0)
|
||||||
+ cfile6,ps0)
|
|
||||||
|
C Decode Multi-Tone FSK441 mesages.
|
||||||
C Decode Multi-Tone FSK441 mesages.
|
|
||||||
|
real dat(jz) !Raw audio data
|
||||||
real dat(jz) !Raw audio data
|
integer NQRN
|
||||||
real s2(nchan,nz) !2d spectrum of data
|
integer DFTolerance
|
||||||
integer NQRN
|
logical pick
|
||||||
integer DFTolerance
|
character*6 cfile6,cf*1
|
||||||
logical pick
|
|
||||||
character*6 cfile6,cf*1
|
real sigdb(3100) !Detected signal in dB, sampled at 20 ms
|
||||||
|
real work(3100)
|
||||||
real sigdb(3100) !Detected signal in dB, sampled at 20 ms
|
integer indx(3100)
|
||||||
real work(3100)
|
real pingdat(3,100)
|
||||||
integer indx(3100)
|
real ps(128)
|
||||||
real pingdat(3,100)
|
real ps0(128)
|
||||||
real ps(128)
|
character msg*40,msg3*3
|
||||||
real ps0(128)
|
character*90 line
|
||||||
character msg*40,msg3*3
|
common/ccom/nline,tping(100),line(100)
|
||||||
character*90 line
|
|
||||||
common/ccom/nline,tping(100),line(100)
|
slim=MinSigdB
|
||||||
|
wmin=0.001*MinWidth * (19.95/20.0)
|
||||||
slim=MinSigdB
|
nf1=-DFTolerance
|
||||||
wmin=0.001*MinWidth * (19.95/20.0)
|
nf2=DFTolerance
|
||||||
nf1=-DFTolerance
|
msg3=' '
|
||||||
nf2=DFTolerance
|
nq=64
|
||||||
msg3=' '
|
dt=1.0/11025.0
|
||||||
nq=64
|
df=11025.0/256.0
|
||||||
dt=1.0/11025.0
|
|
||||||
df=11025.0/256.0
|
C Find signal power at suitable intervals to search for pings.
|
||||||
|
istep=221
|
||||||
C Find signal power at suitable intervals to search for pings.
|
dtbuf=istep/11025.
|
||||||
istep=221
|
do n=1,nz
|
||||||
dtbuf=istep/11025.
|
s=0.
|
||||||
do n=1,nz
|
ib=n*istep
|
||||||
s=0.
|
ia=ib-istep+1
|
||||||
ib=n*istep
|
do i=ia,ib
|
||||||
ia=ib-istep+1
|
s=s+dat(i)**2
|
||||||
do i=ia,ib
|
enddo
|
||||||
s=s+dat(i)**2
|
sigdb(n)=s/istep
|
||||||
enddo
|
enddo
|
||||||
sigdb(n)=s/istep
|
|
||||||
enddo
|
!#####################################################################
|
||||||
|
if(.not.pick) then
|
||||||
!#####################################################################
|
! Remove initial transient from sigdb
|
||||||
if(.not.pick) then
|
call indexx(nz,sigdb,indx)
|
||||||
! Remove initial transient from sigdb
|
imax=0
|
||||||
call indexx(nz,sigdb,indx)
|
do i=1,50
|
||||||
imax=0
|
if(indx(i).gt.50) go to 10
|
||||||
do i=1,50
|
imax=max(imax,indx(i))
|
||||||
if(indx(i).gt.50) go to 10
|
enddo
|
||||||
imax=max(imax,indx(i))
|
10 do i=1,50
|
||||||
enddo
|
if(indx(nz+1-i).gt.50) go to 20
|
||||||
10 do i=1,50
|
imax=max(imax,indx(nz+1-i))
|
||||||
if(indx(nz+1-i).gt.50) go to 20
|
enddo
|
||||||
imax=max(imax,indx(nz+1-i))
|
20 imax=imax+6 !Safety margin
|
||||||
enddo
|
base1=sigdb(indx(nz/2))
|
||||||
20 imax=imax+6 !Safety margin
|
do i=1,imax
|
||||||
base1=sigdb(indx(nz/2))
|
sigdb(i)=base1
|
||||||
do i=1,imax
|
enddo
|
||||||
sigdb(i)=base1
|
endif
|
||||||
enddo
|
!##################################################################
|
||||||
endif
|
|
||||||
!##################################################################
|
call smooth(sigdb,nz)
|
||||||
|
|
||||||
call smooth(sigdb,nz)
|
C Remove baseline and one dB for good measure.
|
||||||
|
call pctile (sigdb,work,nz,50,base1)
|
||||||
C Remove baseline and one dB for good measure.
|
do i=1,nz
|
||||||
call pctile (sigdb,work,nz,50,base1)
|
sigdb(i)=dB(sigdb(i)/base1) - 1.0
|
||||||
do i=1,nz
|
enddo
|
||||||
sigdb(i)=dB(sigdb(i)/base1) - 1.0
|
|
||||||
enddo
|
call ping(sigdb,nz,dtbuf,slim,wmin,pingdat,nping)
|
||||||
|
|
||||||
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.
|
||||||
C If this is a "mouse pick" and no ping was found, force a pseudo-ping
|
if(pick.and.nping.eq.0) then
|
||||||
C at center of data.
|
if(nping.le.99) nping=nping+1
|
||||||
if(pick.and.nping.eq.0) then
|
pingdat(1,nping)=0.5*jz*dt
|
||||||
if(nping.le.99) nping=nping+1
|
pingdat(2,nping)=0.16
|
||||||
pingdat(1,nping)=0.5*jz*dt
|
pingdat(3,nping)=1.0
|
||||||
pingdat(2,nping)=0.16
|
endif
|
||||||
pingdat(3,nping)=1.0
|
|
||||||
endif
|
bigpeak=0.
|
||||||
|
do iping=1,nping
|
||||||
bigpeak=0.
|
C Find starting place and length of data to be analyzed:
|
||||||
do iping=1,nping
|
tstart=pingdat(1,iping)
|
||||||
C Find starting place and length of data to be analyzed:
|
width=pingdat(2,iping)
|
||||||
tstart=pingdat(1,iping)
|
peak=pingdat(3,iping)
|
||||||
width=pingdat(2,iping)
|
mswidth=10*nint(100.0*width)
|
||||||
peak=pingdat(3,iping)
|
jj=(tstart-0.02)/dt
|
||||||
mswidth=10*nint(100.0*width)
|
if(jj.lt.1) jj=1
|
||||||
jj=(tstart-0.02)/dt
|
jjz=nint((width+0.02)/dt)+1
|
||||||
if(jj.lt.1) jj=1
|
jjz=min(jjz,jz+1-jj)
|
||||||
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 Compute average spectrum of this ping.
|
|
||||||
call spec441(dat(jj),jjz,ps,f0)
|
C Decode the message.
|
||||||
|
msg=' '
|
||||||
C Decode the message.
|
call longx(dat(jj),jjz,ps,DFTolerance,noffset,msg,
|
||||||
msg=' '
|
+ msglen,bauderr)
|
||||||
call longx(dat(jj),jjz,ps,DFTolerance,noffset,msg,
|
qrnlimit=4.4*1.5**(5.0-NQRN)
|
||||||
+ msglen,bauderr,MouseButton)
|
if(NQRN.eq.0) qrnlimit=99.
|
||||||
qrnlimit=4.4*1.5**(5.0-NQRN)
|
if(msglen.eq.0) go to 100
|
||||||
if(NQRN.eq.0) qrnlimit=99.
|
|
||||||
if(msglen.eq.0) go to 100
|
C Assemble a signal report:
|
||||||
|
nwidth=0
|
||||||
C Assemble a signal report:
|
if(width.ge.0.04) nwidth=1 !These might depend on NSPD
|
||||||
nwidth=0
|
if(width.ge.0.12) nwidth=2
|
||||||
if(width.ge.0.04) nwidth=1 !These might depend on NSPD
|
if(width.gt.1.00) nwidth=3
|
||||||
if(width.ge.0.12) nwidth=2
|
nstrength=6
|
||||||
if(width.gt.1.00) nwidth=3
|
if(peak.ge.11.0) nstrength=7
|
||||||
nstrength=6
|
if(peak.ge.17.0) nstrength=8
|
||||||
if(peak.ge.11.0) nstrength=7
|
if(peak.ge.23.0) nstrength=9
|
||||||
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)
|
||||||
! if(peak.gt.5.0 .and.mswidth.ge.100) then
|
! noffset=noffset2
|
||||||
! call specsq(dat(jj),jjz,DFTolerance,0,noffset2)
|
! endif
|
||||||
! 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.)
|
||||||
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
|
||||||
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
|
||||||
C If it's the best ping yet, save the spectrum:
|
bigpeak=peak
|
||||||
if(peak.gt.bigpeak) then
|
do i=1,128
|
||||||
bigpeak=peak
|
ps0(i)=ps(i)
|
||||||
do i=1,128
|
enddo
|
||||||
ps0(i)=ps(i)
|
endif
|
||||||
enddo
|
|
||||||
endif
|
tstart=tstart + dt*(istart-1)
|
||||||
|
cf=' '
|
||||||
tstart=tstart + dt*(istart-1)
|
if(nline.le.99) nline=nline+1
|
||||||
cf=' '
|
tping(nline)=tstart
|
||||||
if(nline.le.99) nline=nline+1
|
snr=10.0*log10(10.0**(0.1*peak)-1.0)
|
||||||
tping(nline)=tstart
|
write(line(nline),1050) cfile6,tstart,mswidth,int(peak),
|
||||||
snr=10.0*log10(10.0**(0.1*peak)-1.0)
|
+ nwidth,nstrength,noffset,msg3,msg,cf
|
||||||
write(line(nline),1050) cfile6,tstart,mswidth,int(peak),
|
1050 format(a6,f5.1,i5,i3,1x,2i1,i5,1x,a3,1x,a40,1x,a1)
|
||||||
+ nwidth,nstrength,noffset,msg3,msg,cf
|
100 enddo
|
||||||
1050 format(a6,f5.1,i5,i3,1x,2i1,i5,1x,a3,1x,a40,1x,a1)
|
|
||||||
100 enddo
|
return
|
||||||
|
end
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|||||||
4
pfx.f
4
pfx.f
@ -1,9 +1,9 @@
|
|||||||
parameter (NZ=338) !Total number of prefixes
|
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*1 sfx(NZ2)
|
||||||
character*5 pfx(NZ)
|
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/
|
data pfx/
|
||||||
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
|
+ '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ',
|
||||||
+ '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ',
|
+ '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ',
|
||||||
|
|||||||
6
spec.f90
6
spec.f90
@ -11,13 +11,7 @@ subroutine spec(brightness,contrast,logmap,ngain,nspeed,a)
|
|||||||
! Output:
|
! Output:
|
||||||
integer*2 a(225000) !Pixel values for 750 x 300 array
|
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
|
real a0(225000) !Save the last 300 spectra
|
||||||
integer*2 idat(11025) !Sound data, read from file
|
|
||||||
integer nstep(5)
|
integer nstep(5)
|
||||||
integer b0,c0
|
integer b0,c0
|
||||||
real x(4096) !Data for FFT
|
real x(4096) !Data for FFT
|
||||||
|
|||||||
351
sync65.f
351
sync65.f
@ -1,176 +1,175 @@
|
|||||||
subroutine sync65(dat,jz,DFTolerance,NFreeze,NAFC,MouseDF,
|
subroutine sync65(dat,jz,DFTolerance,NFreeze,MouseDF,
|
||||||
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
|
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
|
||||||
|
|
||||||
C Synchronizes JT65 data, finding the best-fit DT and DF.
|
C Synchronizes JT65 data, finding the best-fit DT and DF.
|
||||||
C NB: at this stage, submodes ABC are processed in the same way.
|
C NB: at this stage, submodes ABC are processed in the same way.
|
||||||
|
|
||||||
parameter (NP2=60*11025) !Size of data array
|
parameter (NP2=60*11025) !Size of data array
|
||||||
parameter (NFFTMAX=2048) !Max length of FFTs
|
parameter (NFFTMAX=2048) !Max length of FFTs
|
||||||
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
|
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
|
||||||
parameter (NSMAX=320) !Max number of half-symbol steps
|
parameter (NSMAX=320) !Max number of half-symbol steps
|
||||||
integer DFTolerance !Range of DF search
|
integer DFTolerance !Range of DF search
|
||||||
real dat(jz)
|
real dat(jz)
|
||||||
real psavg(NHMAX) !Average spectrum of whole record
|
real psavg(NHMAX) !Average spectrum of whole record
|
||||||
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
|
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
|
||||||
real ccfblue(-5:540) !CCF with pseudorandom sequence
|
real ccfblue(-5:540) !CCF with pseudorandom sequence
|
||||||
real ccfred(-224:224) !Peak of ccfblue, as function of freq
|
real ccfred(-224:224) !Peak of ccfblue, as function of freq
|
||||||
real tmp(450)
|
real tmp(450)
|
||||||
integer itry(100)
|
save
|
||||||
save
|
|
||||||
|
C Do FFTs of symbol length, stepped by half symbols. Note that we have
|
||||||
C Do FFTs of symbol length, stepped by half symbols. Note that we have
|
C already downsampled the data by factor of 2.
|
||||||
C already downsampled the data by factor of 2.
|
nsym=126
|
||||||
nsym=126
|
nfft=2048
|
||||||
nfft=2048
|
nsteps=2*jz/nfft - 1
|
||||||
nsteps=2*jz/nfft - 1
|
nh=nfft/2
|
||||||
nh=nfft/2
|
|
||||||
|
df=0.5*11025.0/nfft
|
||||||
df=0.5*11025.0/nfft
|
C Compute power spectrum for each step and get average
|
||||||
C Compute power spectrum for each step and get average
|
call zero(psavg,nh)
|
||||||
call zero(psavg,nh)
|
do j=1,nsteps
|
||||||
do j=1,nsteps
|
k=(j-1)*nh + 1
|
||||||
k=(j-1)*nh + 1
|
call limit(dat(k),nfft)
|
||||||
call limit(dat(k),nfft)
|
call ps(dat(k),nfft,s2(1,j))
|
||||||
call ps(dat(k),nfft,s2(1,j))
|
if(mode65.eq.4) call smooth(s2(1,j),nh)
|
||||||
if(mode65.eq.4) call smooth(s2(1,j),nh)
|
call add(psavg,s2(1,j),psavg,nh)
|
||||||
call add(psavg,s2(1,j),psavg,nh)
|
enddo
|
||||||
enddo
|
|
||||||
|
call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra
|
||||||
call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra
|
|
||||||
|
C Find the best frequency channel for CCF
|
||||||
C Find the best frequency channel for CCF
|
famin= 670.46
|
||||||
famin= 670.46
|
fbmax=1870.46
|
||||||
fbmax=1870.46
|
! famin=200
|
||||||
! famin=200
|
! fbmax=3800
|
||||||
! fbmax=3800
|
fa=famin
|
||||||
fa=famin
|
fb=fbmax
|
||||||
fb=fbmax
|
if(NFreeze.eq.1) then
|
||||||
if(NFreeze.eq.1) then
|
fa=max(famin,1270.46+MouseDF-DFTolerance)
|
||||||
fa=max(famin,1270.46+MouseDF-DFTolerance)
|
fb=min(fbmax,1270.46+MouseDF+DFTolerance)
|
||||||
fb=min(fbmax,1270.46+MouseDF+DFTolerance)
|
endif
|
||||||
endif
|
ia=fa/df
|
||||||
ia=fa/df
|
ib=fb/df
|
||||||
ib=fb/df
|
|
||||||
|
i0=nint(1270.46/df)
|
||||||
i0=nint(1270.46/df)
|
ired0=ia-i0
|
||||||
ired0=ia-i0
|
ired1=ib-i0
|
||||||
ired1=ib-i0
|
|
||||||
|
lag1=-5
|
||||||
lag1=-5
|
lag2=59
|
||||||
lag2=59
|
syncbest=-1.e30
|
||||||
syncbest=-1.e30
|
syncbest2=-1.e30
|
||||||
syncbest2=-1.e30
|
|
||||||
|
call zero(ccfred,449)
|
||||||
call zero(ccfred,449)
|
do i=ia,ib
|
||||||
do i=ia,ib
|
call xcor(s2,i,nsteps,nsym,lag1,lag2,
|
||||||
call xcor(s2,i,nsteps,nsym,lag1,lag2,
|
+ ccfblue,ccf0,lagpk0,flip,0.0)
|
||||||
+ ccfblue,ccf0,lagpk0,flip,0.0)
|
j=i-i0
|
||||||
j=i-i0
|
if(j.ge.-224 .and. j.le.224) ccfred(j)=ccf0
|
||||||
if(j.ge.-224 .and. j.le.224) ccfred(j)=ccf0
|
|
||||||
|
C Find rms of the CCF, without the main peak
|
||||||
C Find rms of the CCF, without the main peak
|
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
|
||||||
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
|
sync=abs(ccfblue(lagpk0))
|
||||||
sync=abs(ccfblue(lagpk0))
|
ppmax=psavg(i)-1.0
|
||||||
ppmax=psavg(i)-1.0
|
|
||||||
|
C Find the best sync value
|
||||||
C Find the best sync value
|
if(sync.gt.syncbest2) then
|
||||||
if(sync.gt.syncbest2) then
|
ipk2=i
|
||||||
ipk2=i
|
lagpk2=lagpk0
|
||||||
lagpk2=lagpk0
|
syncbest2=sync
|
||||||
syncbest2=sync
|
flippk2=flip
|
||||||
flippk2=flip
|
endif
|
||||||
endif
|
|
||||||
|
C We are most interested if snrx will be more than -30 dB.
|
||||||
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(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0
|
if(sync.gt.syncbest) then
|
||||||
if(sync.gt.syncbest) then
|
ipk=i
|
||||||
ipk=i
|
lagpk=lagpk0
|
||||||
lagpk=lagpk0
|
syncbest=sync
|
||||||
syncbest=sync
|
flippk=flip
|
||||||
flippk=flip
|
endif
|
||||||
endif
|
endif
|
||||||
endif
|
enddo
|
||||||
enddo
|
|
||||||
|
C If we found nothing with snrx > -30 dB, take the best sync that *was* found.
|
||||||
C If we found nothing with snrx > -30 dB, take the best sync that *was* found.
|
if(syncbest.lt.-10.) then
|
||||||
if(syncbest.lt.-10.) then
|
ipk=ipk2
|
||||||
ipk=ipk2
|
lagpk=lagpk2
|
||||||
lagpk=lagpk2
|
syncbest=syncbest2
|
||||||
syncbest=syncbest2
|
flippk=flippk2
|
||||||
flippk=flippk2
|
endif
|
||||||
endif
|
|
||||||
|
C Peak up in frequency to fraction of channel
|
||||||
C Peak up in frequency to fraction of channel
|
base=0.25*(psavg(ipk-3)+psavg(ipk-2)+psavg(ipk+2)+psavg(ipk+3))
|
||||||
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)
|
||||||
! call peakup(psavg(ipk-1),psavg(ipk),psavg(ipk+1),dx)
|
! if(dx.lt.-1.0) dx=-1.0
|
||||||
! if(dx.lt.-1.0) dx=-1.0
|
! if(dx.gt.1.0) dx=1.0
|
||||||
! if(dx.gt.1.0) dx=1.0
|
dx=0.
|
||||||
dx=0.
|
dfx=(ipk+dx-i0)*df
|
||||||
dfx=(ipk+dx-i0)*df
|
|
||||||
|
C Peak up in time, at best whole-channel frequency
|
||||||
C Peak up in time, at best whole-channel frequency
|
call xcor(s2,ipk,nsteps,nsym,lag1,lag2,
|
||||||
call xcor(s2,ipk,nsteps,nsym,lag1,lag2,
|
+ ccfblue,ccfmax,lagpk,flip,0.0)
|
||||||
+ ccfblue,ccfmax,lagpk,flip,0.0)
|
xlag=lagpk
|
||||||
xlag=lagpk
|
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
|
||||||
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
|
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
|
||||||
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
|
xlag=lagpk+dx2
|
||||||
xlag=lagpk+dx2
|
endif
|
||||||
endif
|
|
||||||
|
C Find rms of the CCF, without the main peak
|
||||||
C Find rms of the CCF, without the main peak
|
call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0)
|
||||||
call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0)
|
sq=0.
|
||||||
sq=0.
|
nsq=0
|
||||||
nsq=0
|
do lag=lag1,lag2
|
||||||
do lag=lag1,lag2
|
if(abs(lag-xlag).gt.2.0) then
|
||||||
if(abs(lag-xlag).gt.2.0) then
|
sq=sq+ccfblue(lag)**2
|
||||||
sq=sq+ccfblue(lag)**2
|
nsq=nsq+1
|
||||||
nsq=nsq+1
|
endif
|
||||||
endif
|
enddo
|
||||||
enddo
|
rms=sqrt(sq/nsq)
|
||||||
rms=sqrt(sq/nsq)
|
snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical
|
||||||
snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical
|
|
||||||
|
dt=2.0/11025.0
|
||||||
dt=2.0/11025.0
|
istart=xlag*nh
|
||||||
istart=xlag*nh
|
dtx=istart*dt
|
||||||
dtx=istart*dt
|
snrx=-99.0
|
||||||
snrx=-99.0
|
! ppmax=psavg(ipk)/base-1.0
|
||||||
! ppmax=psavg(ipk)/base-1.0
|
ppmax=psavg(ipk)-1.0
|
||||||
ppmax=psavg(ipk)-1.0
|
C Plus 3 dB because sync tone is on half the time. (Don't understand
|
||||||
C Plus 3 dB because sync tone is on half the time. (Don't understand
|
C why an additional +2 dB is needed ...)
|
||||||
C why an additional +2 dB is needed ...)
|
if(ppmax.gt.0.0001) snrx=db(ppmax*df/2500.0) + 5.0 !###
|
||||||
if(ppmax.gt.0.0001) snrx=db(ppmax*df/2500.0) + 5.0 !###
|
if(mode65.eq.4) snrx=snrx + 2.0
|
||||||
if(mode65.eq.4) snrx=snrx + 2.0
|
if(snrx.lt.-33.0) snrx=-33.0
|
||||||
if(snrx.lt.-33.0) snrx=-33.0
|
|
||||||
|
C Compute width of sync tone to outermost -3 dB points
|
||||||
C Compute width of sync tone to outermost -3 dB points
|
call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base)
|
||||||
call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base)
|
|
||||||
|
jpk=ipk-i0
|
||||||
jpk=ipk-i0
|
stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB
|
||||||
stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB
|
do i=-10,0
|
||||||
do i=-10,0
|
if(jpk+i.ge.-223) then
|
||||||
if(jpk+i.ge.-223) then
|
if(ccfred(jpk+i).gt.stest) go to 30
|
||||||
if(ccfred(jpk+i).gt.stest) go to 30
|
endif
|
||||||
endif
|
enddo
|
||||||
enddo
|
i=0
|
||||||
i=0
|
30 x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1))
|
||||||
30 x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1))
|
|
||||||
|
do i=10,0,-1
|
||||||
do i=10,0,-1
|
if(jpk+i.le.223) then
|
||||||
if(jpk+i.le.223) then
|
if(ccfred(jpk+i).gt.stest) go to 32
|
||||||
if(ccfred(jpk+i).gt.stest) go to 32
|
endif
|
||||||
endif
|
enddo
|
||||||
enddo
|
i=0
|
||||||
i=0
|
32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1))
|
||||||
32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1))
|
width=x2-x1
|
||||||
width=x2-x1
|
if(width.gt.1.2) width=sqrt(width**2 - 1.44)
|
||||||
if(width.gt.1.2) width=sqrt(width**2 - 1.44)
|
width=df*width
|
||||||
width=df*width
|
width=max(0.0,min(99.0,width))
|
||||||
width=max(0.0,min(99.0,width))
|
|
||||||
|
ic=600/df
|
||||||
ic=600/df
|
nn=1800/df
|
||||||
nn=1800/df
|
nred=448
|
||||||
nred=448
|
|
||||||
|
return
|
||||||
return
|
end
|
||||||
end
|
|
||||||
|
|
||||||
|
|||||||
35
wsjt.py
35
wsjt.py
@ -884,22 +884,16 @@ def decdsec(event):
|
|||||||
ldsec.configure(text='Dsec '+str(0.1*idsec),bg=bg)
|
ldsec.configure(text='Dsec '+str(0.1*idsec),bg=bg)
|
||||||
Audio.gcom1.ndsec=idsec
|
Audio.gcom1.ndsec=idsec
|
||||||
|
|
||||||
###------------------------------------------------------ incrdsec
|
#------------------------------------------------------ toggle_shift
|
||||||
##def incrdsec(event):
|
def toggle_shift(event):
|
||||||
## global irdsec
|
Audio.gcom2.nadd5=1-Audio.gcom2.nadd5
|
||||||
## irdsec=irdsec+5
|
if Audio.gcom2.nadd5:
|
||||||
## bg='red'
|
bg='red'
|
||||||
## if irdsec==0: bg='white'
|
lshift.configure(text='Shift 5.0',bg=bg)
|
||||||
## lrdsec.configure(text='RDsec '+str(0.1*irdsec),bg=bg)
|
else:
|
||||||
##
|
bg='white'
|
||||||
###------------------------------------------------------ decrdsec
|
lshift.configure(text='Shift 0.0',bg=bg)
|
||||||
##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)
|
|
||||||
##
|
|
||||||
#------------------------------------------------------ inctrperiod
|
#------------------------------------------------------ inctrperiod
|
||||||
def inctrperiod(event):
|
def inctrperiod(event):
|
||||||
global ncwtrperiod
|
global ncwtrperiod
|
||||||
@ -1874,14 +1868,11 @@ Button(f5b,text='Defaults',command=defaults,padx=1,pady=1).grid(column=0,
|
|||||||
row=3,sticky='EW')
|
row=3,sticky='EW')
|
||||||
ldsec=Label(f5b, bg='white', fg='black', text='Dsec 0.0', width=8, relief=RIDGE)
|
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')
|
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)
|
lshift=Label(f5b, bg='white', fg='black', text='Shift 0.0', width=8, relief=RIDGE)
|
||||||
#lrdsec.grid(column=1,row=4,ipadx=3,padx=2,pady=5,sticky='EW')
|
lshift.grid(column=1,row=4,ipadx=3,padx=2,pady=5,sticky='EW')
|
||||||
Widget.bind(ldsec,'<Button-1>',incdsec)
|
Widget.bind(ldsec,'<Button-1>',incdsec)
|
||||||
Widget.bind(ldsec,'<Button-3>',decdsec)
|
Widget.bind(ldsec,'<Button-3>',decdsec)
|
||||||
#Widget.bind(lrdsec,'<Button-1>',incrdsec)
|
Widget.bind(lshift,'<Button-1>',toggle_shift)
|
||||||
#Widget.bind(lrdsec,'<Button-3>',decrdsec)
|
|
||||||
#Widget.bind(lrdsec,'<Button-1>',stub)
|
|
||||||
#Widget.bind(lrdsec,'<Button-3>',stub)
|
|
||||||
|
|
||||||
f5b.pack(side=LEFT,expand=0,fill=BOTH)
|
f5b.pack(side=LEFT,expand=0,fill=BOTH)
|
||||||
|
|
||||||
|
|||||||
660
wsjt1.F
660
wsjt1.F
@ -1,335 +1,325 @@
|
|||||||
subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB,
|
subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB,
|
||||||
+ NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve,
|
+ NQRN,DFTolerance,MouseButton,NClearAve,
|
||||||
+ Mode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65,
|
+ Mode,NFreeze,NAFC,NZap,mode65,
|
||||||
+ MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2,
|
+ MyCall,HisCall,HisGrid,neme,nsked,ntx2,s2,
|
||||||
+ ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg,
|
+ ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg,
|
||||||
+ MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
|
+ MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
|
||||||
|
|
||||||
parameter (NP2=1024*1024)
|
parameter (NP2=1024*1024)
|
||||||
|
|
||||||
integer*2 d(jz0) !Buffer for raw one-byte data
|
integer*2 d(jz0) !Buffer for raw one-byte data
|
||||||
integer istart !Starting location in original d() array
|
integer istart !Starting location in original d() array
|
||||||
character FileID*40 !Name of file being processed
|
character FileID*40 !Name of file being processed
|
||||||
integer MinSigdB !Minimum ping strength, dB
|
integer MinSigdB !Minimum ping strength, dB
|
||||||
integer NQRN !QRN rejection parameter
|
integer NQRN !QRN rejection parameter
|
||||||
integer DFTolerance !Defines DF search range
|
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
|
||||||
integer NSyncOK !Set to 1 if JT65 file synchronized OK
|
character*12 mycall
|
||||||
character AppDir*80 !Installation directory for WSJT
|
character*12 hiscall
|
||||||
character*12 utcdate
|
character*6 hisgrid
|
||||||
character*12 mycall
|
real ps0(431) !Spectrum of best ping
|
||||||
character*12 hiscall
|
integer npkept !Number of pings kept and decoded
|
||||||
character*6 hisgrid
|
integer lumsg !Logical unit for decoded.txt
|
||||||
real ps0(431) !Spectrum of best ping
|
real basevb !Baseline signal level, dB
|
||||||
integer npkept !Number of pings kept and decoded
|
integer nslim2 !Minimum strength for single-tone pings, dB
|
||||||
integer lumsg !Logical unit for decoded.txt
|
real psavg(450) !Average spectrum of the whole file
|
||||||
real basevb !Baseline signal level, dB
|
integer Nseg !First or second Tx sequence?
|
||||||
integer nslim2 !Minimum strength for single-tone pings, dB
|
integer MouseDF !Freeze position for DF
|
||||||
real psavg(450) !Average spectrum of the whole file
|
logical pick !True if this is a mouse-picked ping
|
||||||
integer Nseg !First or second Tx sequence?
|
logical stbest !True if the best decode was Single-Tone
|
||||||
integer MouseDF !Freeze position for DF
|
logical STfound !True if at least one ST decode
|
||||||
logical pick !True if this is a mouse-picked ping
|
logical LDecoded !True if anything was decoded
|
||||||
logical stbest !True if the best decode was Single-Tone
|
real s2(64,3100) !2D spectral array
|
||||||
logical STfound !True if at least one ST decode
|
real ccf(-5:540) !X-cor function in JT65 mode (blue line)
|
||||||
logical LDecoded !True if anything was decoded
|
real red(512)
|
||||||
real s2(64,3100) !2D spectral array
|
real ss1(-224:224) !Magenta curve (for JT65 shorthands)
|
||||||
real ccf(-5:540) !X-cor function in JT65 mode (blue line)
|
real ss2(-224:224) !Orange curve (for JT65 shorthands)
|
||||||
real red(512)
|
real yellow(216)
|
||||||
real ss1(-224:224) !Magenta curve (for JT65 shorthands)
|
real yellow0(216)
|
||||||
real ss2(-224:224) !Orange curve (for JT65 shorthands)
|
real fzap(200)
|
||||||
real yellow(216)
|
|
||||||
real yellow0(216)
|
integer resample
|
||||||
real fzap(200)
|
real*8 samfacin,samratio
|
||||||
|
real dat2(NP2)
|
||||||
integer resample
|
|
||||||
real*8 samfacin,samratio
|
integer*1 dtmp
|
||||||
real dat2(NP2)
|
character msg3*3
|
||||||
|
character cfile6*6
|
||||||
integer*1 dtmp
|
logical lcum
|
||||||
character msg3*3
|
integer indx(100)
|
||||||
character cfile6*6
|
character*90 line
|
||||||
character fname*99,fcum*99
|
|
||||||
logical lcum
|
common/avecom/dat(NP2),labdat,jza,modea
|
||||||
integer indx(100)
|
common/ccom/nline,tping(100),line(100)
|
||||||
character*90 line
|
common/limcom/ nslim2a
|
||||||
character*24 today
|
common/clipcom/ nclip
|
||||||
|
equivalence (dtmp,ntmp)
|
||||||
common/avecom/dat(NP2),labdat,jza,modea
|
save
|
||||||
common/avecom2/f0a
|
|
||||||
common/ccom/nline,tping(100),line(100)
|
lcum=.true.
|
||||||
common/limcom/ nslim2a
|
jz=jz0
|
||||||
common/clipcom/ nclip
|
modea=Mode
|
||||||
equivalence (dtmp,ntmp)
|
nclip=NQRN-5
|
||||||
save
|
nslim2a=nclip
|
||||||
|
MinWidth=40 !Minimum width of pings, ms
|
||||||
lcum=.true.
|
call zero(psavg,450)
|
||||||
jz=jz0
|
rewind 11
|
||||||
modea=Mode
|
rewind 12
|
||||||
nclip=NQRN-5
|
|
||||||
nslim2a=nclip
|
do i=1,40
|
||||||
MinWidth=40 !Minimum width of pings, ms
|
if(FileID(i:i).eq.'.') go to 3
|
||||||
call zero(psavg,450)
|
enddo
|
||||||
rewind 11
|
i=4
|
||||||
rewind 12
|
3 ia=max(1,i-6)
|
||||||
|
cfile6=FileID(ia:i-1)
|
||||||
do i=1,40
|
|
||||||
if(FileID(i:i).eq.'.') go to 3
|
nline=0
|
||||||
enddo
|
ndiag=0
|
||||||
i=4
|
! If file "/wsjt.reg" exists, set ndiag=1
|
||||||
3 ia=max(1,i-6)
|
open(16,file='/wsjt.reg',status='old',err=4)
|
||||||
cfile6=FileID(ia:i-1)
|
ndiag=1
|
||||||
|
close(16)
|
||||||
nline=0
|
|
||||||
ndiag=0
|
4 if(jz.gt.655360) jz=655360
|
||||||
! If file "/wsjt.reg" exists, set ndiag=1
|
if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this!
|
||||||
open(16,file='/wsjt.reg',status='old',err=4)
|
|
||||||
ndiag=1
|
sum=0.
|
||||||
close(16)
|
do j=1,jz !Convert raw data from i*2 to real, remove DC
|
||||||
|
dat(j)=0.1*d(j)
|
||||||
4 if(jz.gt.655360) jz=655360
|
sum=sum + dat(j)
|
||||||
if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this!
|
enddo
|
||||||
|
ave=sum/jz
|
||||||
sum=0.
|
samratio=1.d0/samfacin
|
||||||
do j=1,jz !Convert raw data from i*2 to real, remove DC
|
if(samratio.eq.1.d0) then
|
||||||
dat(j)=0.1*d(j)
|
do j=1,jz
|
||||||
sum=sum + dat(j)
|
dat(j)=dat(j)-ave
|
||||||
enddo
|
enddo
|
||||||
ave=sum/jz
|
else
|
||||||
samratio=1.d0/samfacin
|
do j=1,jz
|
||||||
if(samratio.eq.1.d0) then
|
dat2(j)=dat(j)-ave
|
||||||
do j=1,jz
|
enddo
|
||||||
dat(j)=dat(j)-ave
|
|
||||||
enddo
|
#if (USE_PORTAUDIO==1) || defined(Win32)
|
||||||
else
|
ierr=resample(dat2,dat,samratio,jz)
|
||||||
do j=1,jz
|
if(ierr.ne.0) print*,'Resample error.',samratio
|
||||||
dat2(j)=dat(j)-ave
|
#endif
|
||||||
enddo
|
|
||||||
|
endif
|
||||||
#if (USE_PORTAUDIO==1) || defined(Win32)
|
|
||||||
ierr=resample(dat2,dat,samratio,jz)
|
if(ndiag.ne.0 .and. nclip.lt.0) then
|
||||||
if(ierr.ne.0) print*,'Resample error.',samratio
|
C Intentionally degrade SNR by -nclip dB.
|
||||||
#endif
|
sq=0.
|
||||||
|
do i=1,jz
|
||||||
endif
|
sq=sq + dat(i)**2
|
||||||
|
enddo
|
||||||
if(ndiag.ne.0 .and. nclip.lt.0) then
|
p0=sq/jz
|
||||||
C Intentionally degrade SNR by -nclip dB.
|
p1=p0*10.0**(-0.1*nclip)
|
||||||
sq=0.
|
dnoise=sqrt(4*(p1-p0))
|
||||||
do i=1,jz
|
idum=-1
|
||||||
sq=sq + dat(i)**2
|
do i=1,jz
|
||||||
enddo
|
dat(i)=dat(i) + dnoise*gran(idum)
|
||||||
p0=sq/jz
|
enddo
|
||||||
p1=p0*10.0**(-0.1*nclip)
|
endif
|
||||||
dnoise=sqrt(4*(p1-p0))
|
|
||||||
idum=-1
|
if(mode.ne.2 .and. nzap.ne.0) then
|
||||||
do i=1,jz
|
nfrz=NFreeze
|
||||||
dat(i)=dat(i) + dnoise*gran(idum)
|
if(mode.eq.1) nfrz=0
|
||||||
enddo
|
if(jz.gt.100000) call avesp2(dat,jz,2,mode,nfrz,MouseDF,
|
||||||
endif
|
+ DFTolerance,fzap)
|
||||||
|
nadd=1
|
||||||
if(mode.ne.2 .and. nzap.ne.0) then
|
call bzap(dat,jz,nadd,mode,fzap)
|
||||||
nfrz=NFreeze
|
endif
|
||||||
if(mode.eq.1) nfrz=0
|
|
||||||
if(jz.gt.100000) call avesp2(dat,jz,2,f0a,mode,nfrz,MouseDF,
|
sq=0.
|
||||||
+ DFTolerance,fzap)
|
do j=1,jz !Compute power level for whole array
|
||||||
nadd=1
|
sq=sq + dat(j)**2
|
||||||
call bzap(dat,jz,nadd,mode,fzap)
|
enddo
|
||||||
endif
|
avesq=sq/jz
|
||||||
|
basevb=dB(avesq) - 44 !Base power level to send back to GUI
|
||||||
sq=0.
|
if(avesq.eq.0) go to 900
|
||||||
do j=1,jz !Compute power level for whole array
|
|
||||||
sq=sq + dat(j)**2
|
nz=600
|
||||||
enddo
|
nstep=jz/nz
|
||||||
avesq=sq/jz
|
sq=0.
|
||||||
basevb=dB(avesq) - 44 !Base power level to send back to GUI
|
k=0
|
||||||
if(avesq.eq.0) go to 900
|
do j=1,nz
|
||||||
|
sum=0.
|
||||||
nz=600
|
do n=1,nstep
|
||||||
nstep=jz/nz
|
k=k+1
|
||||||
sq=0.
|
sum=sum+dat(k)**2
|
||||||
k=0
|
enddo
|
||||||
do j=1,nz
|
sum=sum/nstep
|
||||||
sum=0.
|
sq=sq + (sum-avesq)**2
|
||||||
do n=1,nstep
|
enddo
|
||||||
k=k+1
|
rmspower=sqrt(sq/nz)
|
||||||
sum=sum+dat(k)**2
|
|
||||||
enddo
|
pick=.false.
|
||||||
sum=sum/nstep
|
if(istart.gt.1) pick=.true. !This is a mouse-picked decoding
|
||||||
sq=sq + (sum-avesq)**2
|
if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900
|
||||||
enddo
|
nchan=64 !Save 64 spectral channels
|
||||||
rmspower=sqrt(sq/nz)
|
nstep=221 !Set step size to ~20 ms
|
||||||
|
nz=jz/nstep - 1 !# of spectra to compute
|
||||||
pick=.false.
|
if(.not.pick) then
|
||||||
if(istart.gt.1) pick=.true. !This is a mouse-picked decoding
|
MouseButton=0
|
||||||
if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900
|
jza=jz
|
||||||
nchan=64 !Save 64 spectral channels
|
labdat=labdat+1
|
||||||
nstep=221 !Set step size to ~20 ms
|
endif
|
||||||
nz=jz/nstep - 1 !# of spectra to compute
|
tbest=0.
|
||||||
if(.not.pick) then
|
NsyncOK=0
|
||||||
MouseButton=0
|
|
||||||
jza=jz
|
! If we're in JT65 mode, call the decode65 routines.
|
||||||
labdat=labdat+1
|
if(mode.eq.2) then
|
||||||
endif
|
! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data
|
||||||
tbest=0.
|
! Check for a JT65 shorthand message
|
||||||
NsyncOK=0
|
nstest=0
|
||||||
|
if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF,
|
||||||
! If we're in JT65 mode, call the decode65 routines.
|
+ DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh,
|
||||||
if(mode.eq.2) then
|
+ idriftsh,snrsh,ss1,ss2,nwsh)
|
||||||
! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data
|
! Lowpass filter and decimate by 2
|
||||||
! Check for a JT65 shorthand message
|
call lpf1(dat,jz,jz2)
|
||||||
nstest=0
|
jz=jz2
|
||||||
if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF,
|
nadd=1
|
||||||
+ DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh,
|
fzap(1)=0.
|
||||||
+ idriftsh,snrsh,ss1,ss2,nwsh)
|
if(nzap.eq.1) call avesp2(dat,jz,nadd,mode,NFreeze,MouseDF,
|
||||||
! Lowpass filter and decimate by 2
|
+ DFTolerance,fzap)
|
||||||
call lpf1(dat,jz,jz2)
|
if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap)
|
||||||
jz=jz2
|
|
||||||
nadd=1
|
i=index(MyCall,char(0))
|
||||||
fzap(1)=0.
|
if(i.le.0) i=index(MyCall,' ')
|
||||||
if(nzap.eq.1) call avesp2(dat,jz,nadd,f0a,mode,NFreeze,MouseDF,
|
mycall=MyCall(1:i-1)//' '
|
||||||
+ DFTolerance,fzap)
|
i=index(HisCall,char(0))
|
||||||
if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap)
|
if(i.le.0) i=index(HisCall,' ')
|
||||||
|
hiscall=HisCall(1:i-1)//' '
|
||||||
i=index(MyCall,char(0))
|
|
||||||
if(i.le.0) i=index(MyCall,' ')
|
! Offset data by about 1 s.
|
||||||
mycall=MyCall(1:i-1)//' '
|
if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6,
|
||||||
i=index(HisCall,char(0))
|
+ NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg,
|
||||||
if(i.le.0) i=index(HisCall,' ')
|
+ MouseDF,NAgain,ndepth,neme,nsked,
|
||||||
hiscall=HisCall(1:i-1)//' '
|
+ mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf,
|
||||||
|
+ nstest,dfsh,snrsh,
|
||||||
! Offset data by about 1 s.
|
+ NSyncOK,ccf,psavg,ndiag,nwsh)
|
||||||
if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6,
|
goto 900
|
||||||
+ NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg,
|
endif
|
||||||
+ MouseDF,NAgain,ndepth,neme,nsked,
|
|
||||||
+ mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf,
|
! If we're in JT6M mode, call the 6M decoding routines.
|
||||||
+ nstest,dfsh,iderrsh,idriftsh,snrsh,
|
if(mode.eq.4) then
|
||||||
+ NSyncOK,ccf,psavg,ndiag,nwsh)
|
do i=1,jz !### Why is it level-sensitive?
|
||||||
goto 900
|
dat(i)=dat(i)/25.0
|
||||||
endif
|
enddo
|
||||||
|
! For waterfall plot
|
||||||
! If we're in JT6M mode, call the 6M decoding routines.
|
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
|
||||||
if(mode.eq.4) then
|
if(sigma.lt.0.0) basevb=-99.0
|
||||||
do i=1,jz !### Why is it level-sensitive?
|
if(jz/11025.0.lt.3.9 .or. sigma.lt.0.0) go to 900
|
||||||
dat(i)=dat(i)/25.0
|
|
||||||
enddo
|
f0=1076.66
|
||||||
! For waterfall plot
|
if(NFreeze.eq.1) f0=1076.66 + MouseDF
|
||||||
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
|
f00=f0
|
||||||
if(sigma.lt.0.0) basevb=-99.0
|
call syncf0(dat,jz,NFreeze,DFTolerance,jstart,f0,smax)
|
||||||
if(jz/11025.0.lt.3.9 .or. sigma.lt.0.0) go to 900
|
call synct(dat,jz,jstart,f0,smax)
|
||||||
|
call syncf1(dat,jz,jstart,f0,NFreeze,DFTolerance,smax,red)
|
||||||
f0=1076.66
|
|
||||||
if(NFreeze.eq.1) f0=1076.66 + MouseDF
|
do i=1,512
|
||||||
f00=f0
|
ccf(i-6)=dB(red(i))
|
||||||
call syncf0(dat,jz,NFreeze,DFTolerance,jstart,f0,smax)
|
enddo
|
||||||
call synct(dat,jz,jstart,f0,smax)
|
df=11025./256.
|
||||||
call syncf1(dat,jz,jstart,f0,NFreeze,DFTolerance,smax,red)
|
do i=1,64
|
||||||
|
sum=0.
|
||||||
f0a=f0
|
do k=8*i-7,8*i
|
||||||
do i=1,512
|
sum=sum+red(k)
|
||||||
ccf(i-6)=dB(red(i))
|
enddo
|
||||||
enddo
|
psavg(i)=5.0*sum
|
||||||
df=11025./256.
|
fac=1.0
|
||||||
do i=1,64
|
freq=i*df
|
||||||
sum=0.
|
if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0)
|
||||||
do k=8*i-7,8*i
|
psavg(i)=fac*psavg(i)
|
||||||
sum=sum+red(k)
|
psavg(i+64)=0.001
|
||||||
enddo
|
enddo
|
||||||
psavg(i)=5.0*sum
|
|
||||||
fac=1.0
|
jz=jz-jstart+1
|
||||||
freq=i*df
|
nslim=MinSigdB
|
||||||
if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0)
|
NFixLen=0
|
||||||
psavg(i)=fac*psavg(i)
|
|
||||||
psavg(i+64)=0.001
|
C Call the decoder if DF is in range or Freeze is off.
|
||||||
enddo
|
if(NFreeze.eq.0 .or.
|
||||||
|
+ abs(f0-f00).lt.float(DFTolerance)) then
|
||||||
jz=jz-jstart+1
|
call decode6m(dat(jstart),jz,cfile6,nslim,istart,
|
||||||
nslim=MinSigdB
|
+ NFixLen,lcum,f0,lumsg,npkept,yellow)
|
||||||
NFixLen=0
|
endif
|
||||||
|
|
||||||
C Call the decoder if DF is in range or Freeze is off.
|
if(pick) then
|
||||||
if(NFreeze.eq.0 .or.
|
do i=1,216
|
||||||
+ abs(f0-f00).lt.float(DFTolerance)) then
|
ps0(i)=yellow0(i)
|
||||||
call decode6m(dat(jstart),jz,cfile6,nslim,istart,
|
enddo
|
||||||
+ NFixLen,lcum,f0,lumsg,npkept,yellow)
|
else
|
||||||
endif
|
ps0(216)=yellow(216)
|
||||||
|
yellow0(216)=yellow(216)
|
||||||
if(npkept.eq.0) f0a=0.
|
do i=1,215
|
||||||
|
ps0(i)=2*yellow(i)
|
||||||
if(pick) then
|
yellow0(i)=ps0(i)
|
||||||
do i=1,216
|
enddo
|
||||||
ps0(i)=yellow0(i)
|
endif
|
||||||
enddo
|
goto 800
|
||||||
else
|
endif
|
||||||
ps0(216)=yellow(216)
|
|
||||||
yellow0(216)=yellow(216)
|
! We're in FSK441 mode. Compute the 2D spectrum.
|
||||||
do i=1,215
|
df=11025.0/256.0 !FFT resolution ~43 Hz
|
||||||
ps0(i)=2*yellow(i)
|
dtbuf=nstep/11025.0
|
||||||
yellow0(i)=ps0(i)
|
stlim=nslim2 !Single-tone threshold
|
||||||
enddo
|
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
|
||||||
endif
|
if(sigma.lt.0.0) basevb=-99.0
|
||||||
goto 800
|
if(sigma.lt.0.0) go to 900
|
||||||
endif
|
nline0=nline
|
||||||
|
STfound=.false.
|
||||||
! We're in FSK441 mode. Compute the 2D spectrum.
|
npkept=0
|
||||||
df=11025.0/256.0 !FFT resolution ~43 Hz
|
|
||||||
dtbuf=nstep/11025.0
|
C Look for single-tone messages
|
||||||
stlim=nslim2 !Single-tone threshold
|
if((.not.pick) .or. MouseButton.eq.1) then
|
||||||
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
|
call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim,
|
||||||
if(sigma.lt.0.0) basevb=-99.0
|
+ DFTolerance,cfile6,pick,istart)
|
||||||
if(sigma.lt.0.0) go to 900
|
endif
|
||||||
nline0=nline
|
if(nline.gt.nline0) STfound=.true. !ST message(s) found
|
||||||
STfound=.false.
|
|
||||||
npkept=0
|
C Now the multi-tone decoding
|
||||||
|
call mtdecode(dat,jz,nz,MinSigdB,MinWidth,
|
||||||
C Look for single-tone messages
|
+ NQRN,DFTolerance,istart,pick,cfile6,ps0)
|
||||||
if((.not.pick) .or. MouseButton.eq.1) then
|
|
||||||
call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim,
|
npkept=nline !Number of pings that were kept
|
||||||
+ DFTolerance,cfile6,pick,istart)
|
smax=0.
|
||||||
endif
|
stbest=.false.
|
||||||
if(nline.gt.nline0) STfound=.true. !ST message(s) found
|
if(npkept.gt.0) then
|
||||||
|
call indexx(npkept,tping,indx) !Merge the ST and MT decodes
|
||||||
C Now the multi-tone decoding
|
do i=1,npkept
|
||||||
call mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth,
|
j=indx(i)
|
||||||
+ NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum,
|
if(pick .and. STFound .and.
|
||||||
+ cfile6,ps0)
|
+ line(j)(29:31).eq.' ') goto 10
|
||||||
|
write(lumsg,1050) line(j) !Write to decoded.txt
|
||||||
npkept=nline !Number of pings that were kept
|
1050 format(a79)
|
||||||
smax=0.
|
if(lcum) write(21,1050) line(j) !Write to ALL.TXT
|
||||||
stbest=.false.
|
read(line(j),1060) sig,msg3
|
||||||
if(npkept.gt.0) then
|
1060 format(16x,f3.0,9x,a3)
|
||||||
call indexx(npkept,tping,indx) !Merge the ST and MT decodes
|
if(sig.gt.smax) then
|
||||||
do i=1,npkept
|
smax=sig
|
||||||
j=indx(i)
|
tbest=tping(j)
|
||||||
if(pick .and. STFound .and.
|
stbest = (msg3.ne.' ')
|
||||||
+ line(j)(29:31).eq.' ') goto 10
|
endif
|
||||||
write(lumsg,1050) line(j) !Write to decoded.txt
|
10 enddo
|
||||||
1050 format(a79)
|
endif
|
||||||
if(lcum) write(21,1050) line(j) !Write to ALL.TXT
|
|
||||||
read(line(j),1060) sig,msg3
|
dt=1.0/11025.0 !Compute spectrum for pink curve
|
||||||
1060 format(16x,f3.0,9x,a3)
|
if(stbest) then
|
||||||
if(sig.gt.smax) then
|
jj=nint(tbest/dt)
|
||||||
smax=sig
|
call spec441(dat(jj),1102,ps0,f0)
|
||||||
tbest=tping(j)
|
endif
|
||||||
stbest = (msg3.ne.' ')
|
|
||||||
endif
|
800 continue
|
||||||
10 enddo
|
call s2shape(s2,nchan,nz,tbest)
|
||||||
endif
|
|
||||||
|
900 LDecoded = ((NSyncOK.gt.0) .or. npkept.gt.0)
|
||||||
dt=1.0/11025.0 !Compute spectrum for pink curve
|
end file 11
|
||||||
if(stbest) then
|
call flushqqq(11)
|
||||||
jj=nint(tbest/dt)
|
call flushqqq(12)
|
||||||
call spec441(dat(jj),1102,ps0,f0)
|
call flushqqq(21)
|
||||||
endif
|
|
||||||
|
return
|
||||||
800 continue
|
end
|
||||||
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
428
wsjt65.f
@ -1,216 +1,212 @@
|
|||||||
subroutine wsjt65(dat,npts,cfile6,NClearAve,MinSigdB,
|
subroutine wsjt65(dat,npts,cfile6,NClearAve,MinSigdB,
|
||||||
+ DFTolerance,NFreeze,NAFC,mode65,Nseg,MouseDF,NAgain,
|
+ DFTolerance,NFreeze,NAFC,mode65,Nseg,MouseDF,NAgain,
|
||||||
+ ndepth,neme,nsked,mycall,hiscall,hisgrid,
|
+ ndepth,neme,nsked,mycall,hiscall,hisgrid,
|
||||||
+ lumsg,lcum,nspecial,ndf,nstest,dfsh,iderrsh,idriftsh,
|
+ lumsg,lcum,nspecial,ndf,nstest,dfsh,
|
||||||
+ snrsh,NSyncOK,ccfblue,ccfred,ndiag,nwsh)
|
+ snrsh,NSyncOK,ccfblue,ccfred,ndiag,nwsh)
|
||||||
|
|
||||||
C Orchestrates the process of decoding JT65 messages, using data that
|
C Orchestrates the process of decoding JT65 messages, using data that
|
||||||
C have been 2x downsampled. The search for shorthand messages has
|
C have been 2x downsampled. The search for shorthand messages has
|
||||||
C already been done.
|
C already been done.
|
||||||
|
|
||||||
real dat(npts) !Raw data
|
real dat(npts) !Raw data
|
||||||
integer DFTolerance
|
integer DFTolerance
|
||||||
logical first
|
logical first
|
||||||
logical lcum
|
logical lcum
|
||||||
character decoded*22,cfile6*6,special*5,cooo*3
|
character decoded*22,cfile6*6,special*5,cooo*3
|
||||||
character*22 avemsg1,avemsg2,deepmsg,deepbest
|
character*22 avemsg1,avemsg2,deepmsg
|
||||||
character*67 line,ave1,ave2
|
character*67 line,ave1,ave2
|
||||||
character*1 csync,c1
|
character*1 csync,c1
|
||||||
character*12 mycall
|
character*12 mycall
|
||||||
character*12 hiscall
|
character*12 hiscall
|
||||||
character*6 hisgrid
|
character*6 hisgrid
|
||||||
real ccfblue(-5:540),ccfred(-224:224)
|
real ccfblue(-5:540),ccfred(-224:224)
|
||||||
real ftrack(126)
|
integer itf(2,9)
|
||||||
logical lmid
|
include 'avecom.h'
|
||||||
integer itf(2,9)
|
data first/.true./,ns10/0/,ns20/0/
|
||||||
include 'avecom.h'
|
data itf/0,0, 1,0, -1,0, 0,-1, 0,1, 1,-1, 1,1, -1,-1, -1,1/
|
||||||
common/avecom2/f0a
|
save
|
||||||
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/
|
if(first) then
|
||||||
save
|
call setup65 !Initialize pseudo-random arrays
|
||||||
|
nsave=0
|
||||||
if(first) then
|
first=.false.
|
||||||
call setup65 !Initialize pseudo-random arrays
|
ave1=' '
|
||||||
nsave=0
|
ave2=' '
|
||||||
first=.false.
|
endif
|
||||||
ave1=' '
|
|
||||||
ave2=' '
|
naggressive=0
|
||||||
endif
|
if(ndepth.ge.2) naggressive=1
|
||||||
|
nq1=3
|
||||||
naggressive=0
|
nq2=6
|
||||||
if(ndepth.ge.2) naggressive=1
|
if(naggressive.eq.1) nq1=1
|
||||||
nq1=3
|
|
||||||
nq2=6
|
if(NClearAve.ne.0) then
|
||||||
if(naggressive.eq.1) nq1=1
|
nsave=0 !Clear the averaging accumulators
|
||||||
|
ns10=0
|
||||||
if(NClearAve.ne.0) then
|
ns20=0
|
||||||
nsave=0 !Clear the averaging accumulators
|
ave1=' '
|
||||||
ns10=0
|
ave2=' '
|
||||||
ns20=0
|
endif
|
||||||
ave1=' '
|
if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then
|
||||||
ave2=' '
|
ns10=0 !For Include/Exclude ?
|
||||||
endif
|
ns20=0
|
||||||
if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then
|
endif
|
||||||
ns10=0 !For Include/Exclude ?
|
|
||||||
ns20=0
|
C Attempt to synchronize: look for sync tone, get DF and DT.
|
||||||
endif
|
call sync65(dat,npts,DFTolerance,NFreeze,MouseDF,
|
||||||
|
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
|
||||||
C Attempt to synchronize: look for sync tone, get DF and DT.
|
f0=1270.46 + dfx
|
||||||
call sync65(dat,npts,DFTolerance,NFreeze,NAFC,MouseDF,
|
csync=' '
|
||||||
+ mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
|
decoded=' '
|
||||||
f0=1270.46 + dfx
|
deepmsg=' '
|
||||||
csync=' '
|
special=' '
|
||||||
decoded=' '
|
cooo=' '
|
||||||
deepmsg=' '
|
itry=0
|
||||||
special=' '
|
ncount=-1 !Flag for RS decode of current record
|
||||||
cooo=' '
|
ncount1=-1 !Flag for RS Decode of ave1
|
||||||
itry=0
|
ncount2=-1 !Flag for RS Decode of ave2
|
||||||
ncount=-1 !Flag for RS decode of current record
|
NSyncOK=0
|
||||||
ncount1=-1 !Flag for RS Decode of ave1
|
nqual1=0
|
||||||
ncount2=-1 !Flag for RS Decode of ave2
|
nqual2=0
|
||||||
NSyncOK=0
|
|
||||||
nqual1=0
|
if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1))
|
||||||
nqual2=0
|
+ nsave=nsave+1
|
||||||
|
if(nsave.le.0) go to 900 !Prevent bounds error
|
||||||
if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1))
|
|
||||||
+ nsave=nsave+1
|
nflag(nsave)=0 !Clear the "good sync" flag
|
||||||
if(nsave.le.0) go to 900 !Prevent bounds error
|
iseg(nsave)=Nseg !Set the RX segment to 1 or 2
|
||||||
|
nsync=nint(snrsync-3.0)
|
||||||
nflag(nsave)=0 !Clear the "good sync" flag
|
nsnr=nint(snrx)
|
||||||
iseg(nsave)=Nseg !Set the RX segment to 1 or 2
|
if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0
|
||||||
nsync=nint(snrsync-3.0)
|
nsnrlim=-32
|
||||||
nsnr=nint(snrx)
|
|
||||||
if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0
|
C Good Sync takes precedence over a shorthand message:
|
||||||
nsnrlim=-32
|
if(nsync.ge.MinSigdB .and. nsnr.ge.nsnrlim .and.
|
||||||
|
+ nsync.gt.nstest) nstest=0
|
||||||
C Good Sync takes precedence over a shorthand message:
|
|
||||||
if(nsync.ge.MinSigdB .and. nsnr.ge.nsnrlim .and.
|
if(nstest.gt.0) then
|
||||||
+ nsync.gt.nstest) nstest=0
|
dfx=dfsh
|
||||||
|
nsync=nstest
|
||||||
if(nstest.gt.0) then
|
nsnr=snrsh
|
||||||
dfx=dfsh
|
dtx=1.
|
||||||
nsync=nstest
|
ccfblue(-5)=-999.0
|
||||||
nsnr=snrsh
|
if(nspecial.eq.1) special='ATT '
|
||||||
dtx=1.
|
if(nspecial.eq.2) special='RO '
|
||||||
ccfblue(-5)=-999.0
|
if(nspecial.eq.3) special='RRR '
|
||||||
if(nspecial.eq.1) special='ATT '
|
if(nspecial.eq.4) special='73 '
|
||||||
if(nspecial.eq.2) special='RO '
|
NSyncOK=1 !Mark this RX file as good (for "Save Decoded")
|
||||||
if(nspecial.eq.3) special='RRR '
|
if(NFreeze.eq.0 .or. DFTolerance.ge.200) special(5:5)='?'
|
||||||
if(nspecial.eq.4) special='73 '
|
width=nwsh
|
||||||
NSyncOK=1 !Mark this RX file as good (for "Save Decoded")
|
go to 200
|
||||||
if(NFreeze.eq.0 .or. DFTolerance.ge.200) special(5:5)='?'
|
endif
|
||||||
width=nwsh
|
|
||||||
go to 200
|
if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200
|
||||||
endif
|
|
||||||
|
C If we get here, we have achieved sync!
|
||||||
if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200
|
NSyncOK=1
|
||||||
|
nflag(nsave)=1 !Mark this RX file as good
|
||||||
C If we get here, we have achieved sync!
|
csync='*'
|
||||||
NSyncOK=1
|
if(flip.lt.0.0) then
|
||||||
nflag(nsave)=1 !Mark this RX file as good
|
csync='#'
|
||||||
csync='*'
|
cooo='O ?'
|
||||||
if(flip.lt.0.0) then
|
endif
|
||||||
csync='#'
|
|
||||||
cooo='O ?'
|
call decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
|
||||||
endif
|
+ mycall,hiscall,hisgrid,mode65,nafc,decoded,
|
||||||
|
+ ncount,deepmsg,qual)
|
||||||
call decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked,
|
if(ncount.eq.-999) qual=0 !Bad data
|
||||||
+ nsnr,mycall,hiscall,hisgrid,mode65,nafc,decoded,
|
200 kvqual=0
|
||||||
+ ncount,deepmsg,qual)
|
if(ncount.ge.0) kvqual=1
|
||||||
if(ncount.eq.-999) qual=0 !Bad data
|
nqual=qual
|
||||||
200 kvqual=0
|
if(ndiag.eq.0 .and. nqual.gt.10) nqual=10
|
||||||
if(ncount.ge.0) kvqual=1
|
if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg
|
||||||
nqual=qual
|
|
||||||
if(ndiag.eq.0 .and. nqual.gt.10) nqual=10
|
ndf=nint(dfx)
|
||||||
if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg
|
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)=' ?'
|
||||||
ndf=nint(dfx)
|
if(decoded.eq.' ') cooo=' '
|
||||||
if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO'
|
do i=1,22
|
||||||
if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?'
|
c1=decoded(i:i)
|
||||||
if(decoded.eq.' ') cooo=' '
|
if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32)
|
||||||
do i=1,22
|
enddo
|
||||||
c1=decoded(i:i)
|
write(line,1010) cfile6,nsync,nsnr,dtx-1.0,ndf,
|
||||||
if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32)
|
+ nint(width),csync,special,decoded(1:19),cooo,kvqual,nqual
|
||||||
enddo
|
1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4)
|
||||||
write(line,1010) cfile6,nsync,nsnr,dtx-1.0,ndf,
|
|
||||||
+ nint(width),csync,special,decoded(1:19),cooo,kvqual,nqual
|
C Blank all end-of-line stuff if no decode
|
||||||
1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4)
|
if(line(31:40).eq.' ') line=line(:30)
|
||||||
|
|
||||||
C Blank all end-of-line stuff if no decode
|
C Blank DT if shorthand message (### wrong logic? ###)
|
||||||
if(line(31:40).eq.' ') line=line(:30)
|
if(special.ne.' ') then
|
||||||
|
line(15:19)=' '
|
||||||
C Blank DT if shorthand message (### wrong logic? ###)
|
line=line(:35)
|
||||||
if(special.ne.' ') then
|
ccfblue(-5)=-9999.0
|
||||||
line(15:19)=' '
|
! if(ndiag.gt.0) write(line(51:57),1012) iderrsh,idriftsh
|
||||||
line=line(:35)
|
! 1012 format(i3,i4)
|
||||||
ccfblue(-5)=-9999.0
|
else
|
||||||
! if(ndiag.gt.0) write(line(51:57),1012) iderrsh,idriftsh
|
nspecial=0
|
||||||
! 1012 format(i3,i4)
|
endif
|
||||||
else
|
|
||||||
nspecial=0
|
if(lcum) write(21,1011) line
|
||||||
endif
|
1011 format(a67)
|
||||||
|
C Write decoded msg unless this is an "Exclude" request:
|
||||||
if(lcum) write(21,1011) line
|
if(MinSigdB.lt.99) write(lumsg,1011) line
|
||||||
1011 format(a67)
|
|
||||||
C Write decoded msg unless this is an "Exclude" request:
|
if(nsave.ge.1) call avemsg65(1,mode65,ndepth,avemsg1,nused1,
|
||||||
if(MinSigdB.lt.99) write(lumsg,1011) line
|
+ nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual1,
|
||||||
|
+ ns1,ncount1)
|
||||||
if(nsave.ge.1) call avemsg65(1,mode65,ndepth,avemsg1,nused1,
|
if(nsave.ge.1) call avemsg65(2,mode65,ndepth,avemsg2,nused2,
|
||||||
+ nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual1,
|
+ nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual2,
|
||||||
+ ns1,ncount1)
|
+ ns2,ncount2)
|
||||||
if(nsave.ge.1) call avemsg65(2,mode65,ndepth,avemsg2,nused2,
|
nqual1=qual1
|
||||||
+ nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual2,
|
nqual2=qual2
|
||||||
+ ns2,ncount2)
|
if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10
|
||||||
nqual1=qual1
|
if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10
|
||||||
nqual2=qual2
|
nc1=0
|
||||||
if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10
|
nc2=0
|
||||||
if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10
|
if(ncount1.ge.0) nc1=1
|
||||||
nc1=0
|
if(ncount2.ge.0) nc2=1
|
||||||
nc2=0
|
|
||||||
if(ncount1.ge.0) nc1=1
|
C Write the average line
|
||||||
if(ncount2.ge.0) nc2=1
|
! if(ns1.ge.1 .and. ns1.ne.ns10) then
|
||||||
|
if(ns1.ge.1) then
|
||||||
C Write the average line
|
if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1,
|
||||||
! if(ns1.ge.1 .and. ns1.ne.ns10) then
|
+ nc1,nqual1
|
||||||
if(ns1.ge.1) then
|
1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4)
|
||||||
if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1,
|
if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6,
|
||||||
+ nc1,nqual1
|
+ 1,nused1,ns1,avemsg1,nc1,nqual1
|
||||||
1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4)
|
1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4)
|
||||||
if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6,
|
if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1,
|
||||||
+ 1,nused1,ns1,avemsg1,nc1,nqual1
|
+ avemsg1,nc1,nqual1
|
||||||
1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4)
|
1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4)
|
||||||
if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1,
|
if(lcum .and. (avemsg1.ne.' '))
|
||||||
+ avemsg1,nc1,nqual1
|
+ write(21,1011) ave1
|
||||||
1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4)
|
ns10=ns1
|
||||||
if(lcum .and. (avemsg1.ne.' '))
|
endif
|
||||||
+ write(21,1011) ave1
|
|
||||||
ns10=ns1
|
C If Monitor segment #2 is available, write that line also
|
||||||
endif
|
! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? ***
|
||||||
|
if(ns2.ge.1) then
|
||||||
C If Monitor segment #2 is available, write that line also
|
if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2,
|
||||||
! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? ***
|
+ nc2,nqual2
|
||||||
if(ns2.ge.1) then
|
if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6,
|
||||||
if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2,
|
+ 2,nused2,ns2,avemsg2,nc2,nqual2
|
||||||
+ nc2,nqual2
|
if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2,
|
||||||
if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6,
|
+ nc2,nqual2
|
||||||
+ 2,nused2,ns2,avemsg2,nc2,nqual2
|
if(lcum .and. (avemsg2.ne.' '))
|
||||||
if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2,
|
+ write(21,1011) ave2
|
||||||
+ nc2,nqual2
|
ns20=ns2
|
||||||
if(lcum .and. (avemsg2.ne.' '))
|
endif
|
||||||
+ write(21,1011) ave2
|
|
||||||
ns20=ns2
|
if(ave1(31:40).eq.' ') ave1=ave1(:30)
|
||||||
endif
|
if(ave2(31:40).eq.' ') ave2=ave2(:30)
|
||||||
|
write(12,1011) ave1
|
||||||
if(ave1(31:40).eq.' ') ave1=ave1(:30)
|
write(12,1011) ave2
|
||||||
if(ave2(31:40).eq.' ') ave2=ave2(:30)
|
call flushqqq(12)
|
||||||
write(12,1011) ave1
|
|
||||||
write(12,1011) ave2
|
800 if(lumsg.ne.6) end file 11
|
||||||
call flushqqq(12)
|
|
||||||
|
900 continue
|
||||||
800 if(lumsg.ne.6) end file 11
|
|
||||||
f0a=f0
|
return
|
||||||
|
end
|
||||||
900 continue
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user