Starting to implement the JT4 modes.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@2966 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor 2013-01-22 19:19:00 +00:00
parent 2c2f461b76
commit 5b51d6be83
14 changed files with 880 additions and 7 deletions

View File

@ -20,7 +20,7 @@ CFLAGS = -I. -fbounds-check -mno-stack-arg-probe
%.o: %.F90
${FC} ${FFLAGS} -c $<
all: libjt9.a jt9sim.exe jt9.exe jt9code.exe jt9test.exe
all: libjt9.a jt9sim.exe jt9.exe jt9code.exe wsjt24d.exe
OBJS1 = pctile.o graycode.o sort.o ssort.o \
unpackmsg.o igray.o unpackcall.o unpackgrid.o \
@ -30,8 +30,9 @@ OBJS1 = pctile.o graycode.o sort.o ssort.o \
symspec.o timf2.o analytic.o db.o genjt9.o \
packbits.o unpackbits.o encode232.o interleave9.o \
entail.o fano232.o gran.o spec9.o sync9.o decode9.o \
peakdt9.o peakdf9.o fil3.o redsync.o decoder.o \
grid2n.o n2grid.o timer.o
fil3.o redsync.o decoder.o grid2n.o n2grid.o timer.o \
decode9a.o getlags.o afc9.o fchisq.o twkfreq.o downsam9.o \
peakdt9.o symspec2.o
libjt9.a: $(OBJS1)
ar cr libjt9.a $(OBJS1)
@ -53,8 +54,13 @@ jt9code.exe: $(OBJS4) libjt9.a
$(FC) -o jt9code.exe $(OBJS4) libjt9.a
OBJS5 = jt9test.o
jt9test.exe: $(OBJS5) libjt9.a
$(FC) -o jt9test.exe $(OBJS5) libjt9.a ../libfftw3f_win.a
jt9test.exe: $(OBJS5) libjt9.a
$(FC) -o jt9test.exe $(OBJS5) libjt9.a ../libfftw3f_win.a
OBJS6 = wsjt24d.o wsjt24.o sync24.o decode24.o ps24.o flat1.o \
xcor24.o slope.o peakup.o interleave24.o genmet24.o
wsjt24d.exe: $(OBJS6) libjt9.a
$(FC) -o wsjt24d.exe $(OBJS6) libjt9.a ../libfftw3f_win.a
INCPATH = -I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include/QtCore' \
-I'c:/QtSDK/Desktop/Qt/4.7.4/mingw/include' \

167
lib/decode24.f90 Normal file
View File

@ -0,0 +1,167 @@
subroutine decode24(dat,npts,dtx,dfx,flip,mode,mode4,decoded,ncount, &
nlim,deepmsg,qual,submode)
! Decodes JT65 data, assuming that DT and DF have already been determined.
parameter (MAXAVE=120)
real dat(npts) !Raw data
character decoded*22,deepmsg*22
character*72 c72
character submode*1
real*8 dt,df,phi,f0,dphi,twopi,phi1,dphi1
complex*16 cz,cz1,c0,c1
integer*1 symbol(207)
real*4 rsymbol(207)
integer*1 data1(13) !Decoded data (8-bit bytes)
integer data4a(9) !Decoded data (8-bit bytes)
integer data4(12) !Decoded data (6-bit bytes)
integer amp,delta
integer mettab(0:255,0:1) !Metric table
integer fano
integer nch(7)
integer npr2(207)
! common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE)
data mode0/-999/
data nsum/0/,rsymbol/207*0.0/
data npr2/ &
0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, &
0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, &
1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, &
0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, &
0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, &
0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, &
1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/
data nch/1,2,4,9,18,36,72/
save mettab,mode0,nsum,rsymbol
if(mode.ne.mode0) call genmet24(mode,mettab)
mode0=mode
twopi=8*atan(1.d0)
dt=2.d0/11025 !Sample interval (2x downsampled data)
df=11025.d0/2520.d0
nsym=206
amp=15
istart=nint(dtx/dt) !Start index for synced FFTs
if(istart.lt.0) istart=0
idfbest=0
nchips=0
ich=0
! Should amp be adjusted according to signal strength?
! Compute soft symbols using differential BPSK demodulation
c0=0. !### C0=amp ???
k=istart
fac=1.e-4
phi=0.d0
phi1=0.d0
ang0=0.
40 ich=ich+1
nchips=nch(ich)
nspchip=1260/nchips
k=istart
phi=0.d0
phi1=0.d0
fac2=1.e-8 * sqrt(float(mode4))
do j=1,nsym+1
if(flip.gt.0.0) then
f0=1270.46 + dfx + (npr2(j)-1.5)*mode4*df
f1=1270.46 + dfx + (2+npr2(j)-1.5)*mode4*df
else
f0=1270.46 + dfx + (1-npr2(j)-1.5)*mode4*df
f1=1270.46 + dfx + (3-npr2(j)-1.5)*mode4*df
endif
dphi=twopi*dt*f0
dphi1=twopi*dt*f1
sq0=0.
sq1=0.
do nc=1,nchips
phi=0.d0
phi1=0.d0
c0=0.
c1=0.
do i=1,nspchip
k=k+1
phi=phi+dphi
phi1=phi1+dphi1
cz=dcmplx(cos(phi),-sin(phi))
cz1=dcmplx(cos(phi1),-sin(phi1))
if(k.le.npts) then
c0=c0 + dat(k)*cz
c1=c1 + dat(k)*cz1
endif
enddo
sq0=sq0 + real(c0)**2 + aimag(c0)**2
sq1=sq1 + real(c1)**2 + aimag(c1)**2
enddo
sq0=fac2*sq0
sq1=fac2*sq1
rsym=amp*(sq1-sq0)
r=rsym+128.
if(r.gt.255.0) r=255.0
if(r.lt.0.0) r=0.0
i4=nint(r)
if(i4.gt.127) i4=i4-256
if(j.ge.1) then
symbol(j)=i4
rsymbol(j)=rsymbol(j) + rsym
endif
enddo
!### The following does simple message averaging:
nsum=nsum+1
do j=1,207
r=rsymbol(j)/nsum + 128.
if(r.gt.255.0) r=255.0
if(r.lt.0.0) r=0.0
i4=nint(r)
if(i4.gt.127) i4=i4-256
symbol(j)=i4
enddo
!###
nbits=72+31
delta=100
limit=100000
ncycles=0
ncount=-1
call interleave24(symbol(2),-1) !Remove the interleaving
call fano232(symbol(2),nbits,mettab,delta,limit,data1,ncycles,metric,ncount)
nlim=ncycles/nbits
if(ncount.ge.0) go to 100
if(mode.eq.7 .and. nchips.lt.mode4) go to 40
100 do i=1,9
i4=data1(i)
if(i4.lt.0) i4=i4+256
data4a(i)=i4
enddo
! call cs_lock('decode24')
write(c72,1100) (data4a(i),i=1,9)
1100 format(9b8.8)
read(c72,1102) data4
1102 format(12b6)
! call cs_unlock
decoded=' '
submode=' '
if(ncount.ge.0) then
call unpackmsg(data4,decoded)
submode=char(ichar('A')+ich-1)
endif
if(decoded(1:6).eq.'000AAA') then
decoded='***WRONG MODE?***'
ncount=-1
endif
qual=0.
deepmsg=' '
! Save symbol spectra for possible decoding of average.
return
end subroutine decode24

30
lib/flat1.f90 Normal file
View File

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

27
lib/genmet24.f90 Normal file
View File

@ -0,0 +1,27 @@
subroutine genmet24(mode,mettab)
! Return appropriate metric table for soft-decision convolutional decoder.
real bias !bias for integer table
integer scale !scale factor for integer table
! Metric table (RxSymbol,TxSymbol)
integer mettab(0:255,0:1)
bias=0.5
scale=10
if(mode.eq.7) then !Non-coherent 2FSK
open(19,file='dmet_10_-1_3.dat',status='old')
else
print*,'Unsupported mode:',mode,' in genmet.'
stop 'genmet'
endif
do i=0,255
read(19,*) junk,d0,d1
mettab(i,0)=nint(scale*(d0-bias))
mettab(i,1)=nint(scale*(d1-bias))
enddo
return
end subroutine genmet24

43
lib/interleave24.f90 Normal file
View File

@ -0,0 +1,43 @@
subroutine interleave24(id,ndir)
integer*1 id(0:205),itmp(0:205)
integer j0(0:205)
logical first
data first/.true./
save first,j0
if(first) then
k=-1
do i=0,255
m=i
n=iand(m,1)
n=2*n + iand(m/2,1)
n=2*n + iand(m/4,1)
n=2*n + iand(m/8,1)
n=2*n + iand(m/16,1)
n=2*n + iand(m/32,1)
n=2*n + iand(m/64,1)
n=2*n + iand(m/128,1)
if(n.le.205) then
k=k+1
j0(k)=n
endif
enddo
first=.false.
endif
if(ndir.eq.1) then
do i=0,205
itmp(j0(i))=id(i)
enddo
else
do i=0,205
itmp(i)=id(j0(i))
enddo
endif
do i=0,205
id(i)=itmp(i)
enddo
return
end subroutine interleave24

8
lib/peakup.f90 Normal file
View File

@ -0,0 +1,8 @@
subroutine peakup(ym,y0,yp,dx)
b=(yp-ym)/2.0
c=(yp+ym-2.0*y0)/2.0
dx=-b/(2.0*c)
return
end subroutine peakup

27
lib/ps24.f90 Normal file
View File

@ -0,0 +1,27 @@
subroutine ps24(dat,nfft,s)
parameter (NMAX=2520+2)
parameter (NHMAX=NMAX/2-1)
real dat(nfft)
real dat2(NMAX)
real s(NHMAX)
complex c(0:NMAX)
equivalence(dat2,c)
nh=nfft/2
do i=1,nh
dat2(i)=dat(i)/128.0 !### Why 128 ??
enddo
do i=nh+1,nfft
dat2(i)=0.
enddo
call four2a(c,nfft,1,-1,0)
fac=1.0/nfft
do i=1,nh
s(i)=fac*(real(c(i))**2 + aimag(c(i))**2)
enddo
return
end subroutine ps24

40
lib/slope.f90 Normal file
View File

@ -0,0 +1,40 @@
subroutine slope(y,npts,xpk)
! Remove best-fit slope from data in y(i). When fitting the straight line,
! ignore the peak around xpk +/- 2.
real y(npts)
real x(100)
do i=1,npts
x(i)=i
enddo
sumw=0.
sumx=0.
sumy=0.
sumx2=0.
sumxy=0.
sumy2=0.
do i=1,npts
if(abs(i-xpk).gt.2.0) then
sumw=sumw + 1.0
sumx=sumx + x(i)
sumy=sumy + y(i)
sumx2=sumx2 + x(i)**2
sumxy=sumxy + x(i)*y(i)
sumy2=sumy2 + y(i)**2
endif
enddo
delta=sumw*sumx2 - sumx**2
a=(sumx2*sumy - sumx*sumxy) / delta
b=(sumw*sumxy - sumx*sumy) / delta
do i=1,npts
y(i)=y(i)-(a + b*x(i))
enddo
return
end subroutine slope

195
lib/sync24.f90 Normal file
View File

@ -0,0 +1,195 @@
subroutine sync24(dat,jz,DFTolerance,NFreeze,MouseDF,mode,mode4, &
dtx,dfx,snrx,snrsync,ccfblue,ccfred1,flip,width)
! Synchronizes JT4 data, finding the best-fit DT and DF.
parameter (NFFTMAX=2520) !Max length of FFTs
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
parameter (NSMAX=525) !Max number of half-symbol steps
integer DFTolerance !Range of DF search
real dat(jz)
real psavg(NHMAX) !Average spectrum of whole record
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real ccfblue(-5:540) !CCF with pseudorandom sequence
real ccfred(-450:450) !Peak of ccfblue, as function of freq
real ccfred1(-224:224) !Peak of ccfblue, as function of freq
real tmp(1260)
save
! Do FFTs of twice symbol length, stepped by half symbols. Note that
! we have already downsampled the data by factor of 2.
nsym=207
nfft=2520
nh=nfft/2
nq=nfft/4
nsteps=jz/nq - 1
df=0.5*11025.0/nfft
psavg(1:nh)=0.
! Compute power spectrum for each step and get average
do j=1,nsteps
k=(j-1)*nq + 1
! call limit(dat(k),nfft)
call ps24(dat(k),nfft,s2(1,j))
! if(mode65.eq.4) call smooth(s2(1,j),nh)
psavg(1:nh)=psavg(1:nh) + s2(1:nh,j)
enddo
call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra
! Find the best frequency channel for CCF
! famin= 670.46
! fbmax=1870.46
famin=200.
fbmax=2700.
fa=famin
fb=fbmax
if(NFreeze.eq.1) then
fa=max(famin,1270.46+MouseDF-DFTolerance)
fb=min(fbmax,1270.46+MouseDF+DFTolerance)
else
fa=max(famin,1270.46+MouseDF-600)
fb=min(fbmax,1270.46+MouseDF+600)
endif
ia=fa/df
ib=fb/df
if(mode.eq.7) then
ia=ia - 3*mode4
ib=ib - 3*mode4
endif
i0=nint(1270.46/df)
lag1=-5
lag2=59
syncbest=-1.e30
syncbest2=-1.e30
ccfred=0.
do i=ia,ib
call xcor24(s2,i,nsteps,nsym,lag1,lag2,mode4,ccfblue,ccf0,lagpk0,flip)
j=i-i0
if(mode.eq.7) j=j + 3*mode4
if(j.ge.-372 .and. j.le.372) ccfred(j)=ccf0
! Find rms of the CCF, without the main peak
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
sync=abs(ccfblue(lagpk0))
ppmax=psavg(i)-1.0
! Find the best sync value
if(sync.gt.syncbest2) then
ipk2=i
lagpk2=lagpk0
syncbest2=sync
endif
! We are most interested if snrx will be more than -30 dB.
if(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0
if(sync.gt.syncbest) then
ipk=i
lagpk=lagpk0
syncbest=sync
endif
endif
enddo
! If we found nothing with snrx > -30 dB, take the best sync that *was* found.
if(syncbest.lt.-10.) then
ipk=ipk2
lagpk=lagpk2
syncbest=syncbest2
endif
! Peak up in frequency to fraction of channel
! call peakup(psavg(ipk-1),psavg(ipk),psavg(ipk+1),dx)
! if(dx.lt.-1.0) dx=-1.0
! if(dx.gt.1.0) dx=1.0
dx=0.
dfx=(ipk+dx-i0)*df
if(mode.eq.7) dfx=dfx + 3*mode4*df
! Peak up in time, at best whole-channel frequency
call xcor24(s2,ipk,nsteps,nsym,lag1,lag2,mode4,ccfblue,ccfmax,lagpk,flip)
xlag=lagpk
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
xlag=lagpk+dx2
endif
! Find rms of the CCF, without the main peak
call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0)
sq=0.
nsq=0
do lag=lag1,lag2
if(abs(lag-xlag).gt.2.0) then
sq=sq+ccfblue(lag)**2
nsq=nsq+1
endif
enddo
rms=sqrt(sq/nsq)
snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical
dt=2.0/11025.0
istart=xlag*nq
dtx=istart*dt
snrx=-99.0
! ppmax=psavg(ipk)-1.0
if(ipk.ge.1 .and. ipk.le.1260) ppmax=psavg(ipk)-1.0 !###
if(ppmax.gt.0.0001) then
snrx=db(ppmax*df/2500.0) + 7.5 !Empirical
if(mode.eq.7) snrx=snrx + 3.0 !Empirical
endif
if(snrx.lt.-33.0) snrx=-33.0
! Compute width of sync tone to outermost -3 dB points
! call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base)
! i1=max(-224,ia-i0)
! i2=min(224,ib-i0)
i1=max(-450,ia-i0)
i2=min(450,ib-i0)
!### call pctile(ccfred(i1),tmp,i2-i1+1,45,base)
call pctile(ccfred(i1),i2-i1+1,45,base)
jpk=ipk-i0
if(abs(jpk).gt.450) then
print*,'sync24 a:',jpk,ipk,i0
snrsync=0.
go to 999
else
stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB
endif
do i=-10,0
if(jpk+i.ge.-371) then
if(ccfred(jpk+i).gt.stest) go to 30
endif
enddo
i=0
30 continue
if(abs(jpk+i-1).gt.450 .or. abs(jpk+i).gt.450) then
print*,'sync24 b:',jpk,i
else
! x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1))
x1=i-0.5
endif
do i=10,0,-1
if(jpk+i.le.371) then
if(ccfred(jpk+i).gt.stest) go to 32
endif
enddo
i=0
! 32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1))
32 x2=i+0.5
width=x2-x1
if(width.gt.1.2) width=sqrt(width**2 - 1.44)
width=df*width
width=max(0.0,min(99.0,width))
do i=-224,224
ccfred1(i)=ccfred(i)
enddo
999 return
end subroutine sync24

200
lib/wsjt24.f90 Normal file
View File

@ -0,0 +1,200 @@
subroutine wsjt24(dat,npts,cfile6,NClearAve,MinSigdB, &
DFTolerance,NFreeze,mode,mode4,Nseg,MouseDF,NAgain, &
idf,lumsg,lcum,nspecial,ndf,NSyncOK,ccfblue,ccfred,ndiag)
! Orchestrates the process of decoding JT4 messages, using data that
! have been 2x downsampled.
! No message averaging and no deep search, at present.
parameter (MAXAVE=120)
real dat(npts) !Raw data
real*4 ccfblue(-5:540) !CCF in time
real*4 ccfred(-224:224) !CCF in frequency
integer DFTolerance
logical first
logical lcum
character decoded*22,cfile6*6,special*5,cooo*3
character*22 avemsg1,avemsg2,deepmsg
character*77 line,ave1,ave2
character*1 csync,c1
character*12 mycall
character*12 hiscall
character*6 hisgrid
character submode*1
real*4 ccfbluesum(-5:540),ccfredsum(-224:224)
! common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE) !For msg avg
integer nflag(MAXAVE),iseg(MAXAVE)
data first/.true./,ns10/0/,ns20/0/
save
if(first) then
nsave=0
first=.false.
ave1=' '
ave2=' '
ccfblue=0.
ccfred=0.
if(nspecial.eq.999) go to 900 !Silence compiler warning
endif
naggressive=0
if(ndepth.ge.2) naggressive=1
nq1=3
nq2=6
if(naggressive.eq.1) nq1=1
if(NClearAve.ne.0) then
nsave=0 !Clear the averaging accumulators
ns10=0
ns20=0
ave1=' '
ave2=' '
endif
if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then
ns10=0 !For Include/Exclude ?
ns20=0
endif
! Attempt to synchronize: look for sync pattern, get DF and DT.
call sync24(dat,npts,DFTolerance,NFreeze,MouseDF,mode, &
mode4,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width)
csync=' '
decoded=' '
deepmsg=' '
special=' '
cooo=' '
ncount=-1 !Flag for RS decode of current record
ncount1=-1 !Flag for RS Decode of ave1
ncount2=-1 !Flag for RS Decode of ave2
NSyncOK=0
nqual1=0
nqual2=0
if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1)) nsave=nsave+1
if(nsave.le.0) go to 900 !Prevent bounds error
nflag(nsave)=0 !Clear the "good sync" flag
iseg(nsave)=Nseg !Set the RX segment to 1 or 2
nsync=nint(snrsync-3.0)
nsnr=nint(snrx)
if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0
nsnrlim=-33
if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200
! If we get here, we have achieved sync!
NSyncOK=1
nflag(nsave)=1 !Mark this RX file as good
csync='*'
if(flip.lt.0.0) then
csync='#'
cooo='O ?'
endif
call decode24(dat,npts,dtx,dfx,flip,mode,mode4,decoded, &
ncount,nlim,deepmsg,qual,submode)
200 kvqual=0
if(ncount.ge.0) kvqual=1
nqual=qual
if(ndiag.eq.0 .and. nqual.gt.10) nqual=10
if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg
ndf=nint(dfx)
if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO'
if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?'
if(decoded.eq.' ') cooo=' '
do i=1,22
c1=decoded(i:i)
if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32)
enddo
jdf=ndf+idf
! call cs_lock('wsjt24')
write(line,1010) cfile6,nsync,nsnr,dtx-1.0,jdf,nint(width), &
csync,special,decoded(1:19),cooo,kvqual,nqual,submode,nlim
1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4,1x,a1,i8)
! Blank all end-of-line stuff if no decode
if(line(31:40).eq.' ') line=line(:30)
! if(lcum) write(21,1011) line
! Write decoded msg unless this is an "Exclude" request:
if(MinSigdB.lt.99) write(*,1011) line
1011 format(a77)
! if(nsave.ge.1) call avemsg65(1,mode65,ndepth, &
! avemsg1,nused1,nq1,nq2,neme,mycall,hiscall,hisgrid,qual1, &
! ns1,ncount1)
! if(nsave.ge.1) call avemsg65(2,mode65,ndepth, &
! avemsg2,nused2,nq1,nq2,neme,mycall,hiscall,hisgrid,qual2, &
! ns2,ncount2)
nqual1=qual1
nqual2=qual2
if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10
if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10
nc1=0
nc2=0
if(ncount1.ge.0) nc1=1
if(ncount2.ge.0) nc2=1
! Write the average line
! if(ns1.ge.1 .and. ns1.ne.ns10) then
! if(ns1.ge.1) then
! if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1,nc1,nqual1
!1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4)
! if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6, &
! 1,nused1,ns1,avemsg1,nc1,nqual1
!1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4)
! if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1, &
! avemsg1,nc1,nqual1
!1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4)
! if(lcum .and. (avemsg1.ne.' ')) &
! write(21,1011) ave1
! ns10=ns1
! endif
! If Monitor segment #2 is available, write that line also
! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? ***
! if(ns2.ge.1) then
! if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2,nc2,nqual2
! if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6, &
! 2,nused2,ns2,avemsg2,nc2,nqual2
! if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2,nc2,nqual2
! if(lcum .and. (avemsg2.ne.' ')) &
! write(21,1011) ave2
! ns20=ns2
! endif
if(ave1(31:40).eq.' ') ave1=ave1(:30)
if(ave2(31:40).eq.' ') ave2=ave2(:30)
! write(12,1011) ave1
! write(12,1011) ave2
! call flush(12)
if(lumsg.ne.6) end file 11
! call cs_unlock
900 continue
ccfbluesum=ccfbluesum + ccfblue
ccfredsum=ccfredsum + ccfred
! This was for testing message averaging:
! rewind 71
! rewind 72
! do i=-5,540
! write(71,3001) 0.2 + i*0.057143,ccfbluesum(i)
!3001 format(2f12.3)
! enddo
! do i=-224,224
! write(72,3001) i*2.1875,ccfredsum(i)
! enddo
! call flush(71)
! call flush(72)
return
end subroutine wsjt24

36
lib/wsjt24d.f90 Normal file
View File

@ -0,0 +1,36 @@
program wsjt24d
real*4 dat(60*11025/2)
character*6 cfile6
character*12 arg
real ccfblue(-5:540) !X-cor function in JT65 mode (blue line)
real ccfred(450) !Average spectrum of the whole file
nargs=iargc()
if(nargs.ne.2) then
print*,'Usage: wspr24d ifile1 ifile2'
go to 999
endif
call getarg(1,arg)
read(arg,*) ifile1
call getarg(2,arg)
read(arg,*) ifile2
open(50,file='vk7mo.dat',form='unformatted',status='old')
do ifile=1,ifile2
read(50,end=999) jz,cfile6,NClearAve,MinSigdB,DFTolerance,NFreeze, &
mode,mode4,Nseg,MouseDF2,NAgain,idf,lumsg,lcum,nspecial,ndf, &
NSyncOK,dat(1:jz)
if(ifile.lt.ifile1) cycle
! write(*,3000) ifile,cfile6,jz,mode,mode4,idf
!3000 format(i3,2x,a6,i10,3i5)
call wsjt24(dat,jz,cfile6,NClearAve,MinSigdB,DFTolerance, &
NFreeze,mode,mode4,Nseg,MouseDF2,NAgain,idf,lumsg,lcum,nspecial, &
ndf,NSyncOK,ccfblue,ccfred,ndiag)
if(ifile.ge.ifile2) exit
enddo
999 end program wsjt24d

94
lib/xcor24.f90 Normal file
View File

@ -0,0 +1,94 @@
subroutine xcor24(s2,ipk,nsteps,nsym,lag1,lag2,mode4,ccf,ccf0,lagpk,flip)
! Computes ccf of a row of s2 and the pseudo-random array pr2. Returns
! peak of the CCF and the lag at which peak occurs. For JT65, the
! CCF peak may be either positive or negative, with negative implying
! the "OOO" message.
parameter (NHMAX=1260) !Max length of power spectra
parameter (NSMAX=525) !Max number of half-symbol steps
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
real a(NSMAX)
real ccf(-5:540)
integer npr2(207)
real pr2(207)
logical first
data lagmin/0/ !Silence g77 warning
data first/.true./
data npr2/ &
0,0,0,0,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,0,0,0,0,0,0,1,1,0,0, &
0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1,0,1,1,1,1,1,0,1,0,0,0, &
1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,0,1,0,0,0,1,1,1,1,0,1,1,0,0,1, &
0,0,0,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0,1,0,1,0,1,1,0,1,0,1, &
0,1,1,1,0,0,1,0,1,1,0,1,1,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1, &
0,1,1,1,0,1,1,1,0,0,1,0,0,0,1,1,0,1,1,0,0,1,0,0,0,1,1,1,1,1, &
1,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,1,1,1,0,1,0,1/
save
if(first) then
do i=1,207
pr2(i)=2*npr2(i)-1
enddo
first=.false.
endif
do j=1,nsteps
n=2*mode4
if(mode4.eq.1) then
a(j)=max(s2(ipk+n,j),s2(ipk+3*n,j)) - max(s2(ipk ,j),s2(ipk+2*n,j))
else
kz=mode4/2
ss0=0.
ss1=0.
ss2=0.
ss3=0.
wsum=0.
do k=-kz+1,kz-1
w=float(kz-iabs(k))/mode4
wsum=wsum+w
if(ipk+k.lt.1 .or. ipk+3*n+k.gt.1260) then
print*,'xcor24:',ipk,n,k
else
ss0=ss0 + w*s2(ipk +k,j)
ss1=ss1 + w*s2(ipk+ n+k,j)
ss2=ss2 + w*s2(ipk+2*n+k,j)
ss3=ss3 + w*s2(ipk+3*n+k,j)
endif
enddo
a(j)=(max(ss1,ss3) - max(ss0,ss2))/sqrt(wsum)
endif
enddo
ccfmax=0.
ccfmin=0.
do lag=lag1,lag2
x=0.
do i=1,nsym
j=2*i-1+lag
if(j.ge.1 .and. j.le.nsteps) x=x+a(j)*pr2(i)
enddo
ccf(lag)=2*x !The 2 is for plotting scale
if(ccf(lag).gt.ccfmax) then
ccfmax=ccf(lag)
lagpk=lag
endif
if(ccf(lag).lt.ccfmin) then
ccfmin=ccf(lag)
lagmin=lag
endif
enddo
ccf0=ccfmax
flip=1.0
if(-ccfmin.gt.ccfmax) then
do lag=lag1,lag2
ccf(lag)=-ccf(lag)
enddo
lagpk=lagmin
ccf0=-ccfmin
flip=-1.0
endif
return
end subroutine xcor24

View File

@ -1,4 +1,4 @@
//--------------------------------------------------------------- MainWindow
//---------------------------------------------------------------- MainWindow
#include "mainwindow.h"
#include "ui_mainwindow.h"
#include "devsetup.h"

View File

@ -1,6 +1,6 @@
[Setup]
AppName=wsjtx
AppVerName=wsjtx Version 0.5 r2788
AppVerName=wsjtx Version 0.5 r2791
AppCopyright=Copyright (C) 2001-2012 by Joe Taylor, K1JT
DefaultDirName=c:\wsjtx
DefaultGroupName=wsjtx