w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-04-05 02:48:37 -04:00
Code Issues Packages Projects Releases Wiki Activity

Rough measurement and compensation for drift now included for QRA64.

Browse Source 
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6905 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor 2016-07-11 20:38:31 +00:00
parent ae68047379
commit f740d7d999
1 changed files with 62 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
lib/qra64a.f90
View File

@ -7,19 +7,23 @@ subroutine qra64a(dd,nf1,nf2,nfqso,ntol,mycall_12,sync,nsnr,dtx,nfreq, &
logical ltext
integer icos7(0:6)
integer ipk(1)
integer jpk(1)
integer ij(2)
integer dat4(12)
real ss(NZ,194)
real s3(0:63,1:63)
real dd(60*12000)
real s(NZ)
real savg(NZ)
real blue(0:25)
real red0(NZ)
real red(NZ)
real ccf(NZ,0:25)
real ccf1(NZ,0:25)
real ccf2(NZ,0:25)
real ccf3(NZ,0:25)
real x(NFFT)
real syncd(-4:4,-5:5)
complex cx(0:NH)
equivalence (x,cx)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 pattern
common/qra64com/ss(NZ,194),s3(0:63,1:63),ccf(NZ,0:25)
save
decoded=' '
@ -53,85 +57,94 @@ subroutine qra64a(dd,nf1,nf2,nfqso,ntol,mycall_12,sync,nsnr,dtx,nfreq, &
savg=savg/base - 1.0
ss=ss/base
red0=0.
fac=1.0/sqrt(21.0)
ccf=0.
red=0.
sync=0.
fac=1.0/sqrt(21.0)
do if0=ia,ib
red0(if0)=0.
red(if0)=0.
do j=0,25
t=-3.0
t1=0.0
t2=0.0
t3=0.0
do n=0,6
i=if0 + 2*icos7(n)
t=t + ss(i,1+2*n+j) + ss(i,1+2*n+j+78) + ss(i,1+2*n+j+154)
t1=t1 + ss(i,1+2*n+j)
t2=t2 + ss(i,1+2*n+j+78)
t3=t3 + ss(i,1+2*n+j+154)
enddo
ccf(if0,j)=fac*t
if(ccf(if0,j).gt.red0(if0)) then
red0(if0)=ccf(if0,j)
if(red0(if0).gt.sync) then
sync=red0(if0)
f0=if0*df
dtx=j*istep/12000.0 - 1.0
i0=if0
j0=j
endif
endif
ccf1(if0,j)=fac*t1
ccf2(if0,j)=fac*t2
ccf3(if0,j)=fac*t3
ccf(if0,j)=fac*(t1+t2+t3)
enddo
enddo
! red(ia:ib)=0.
! rewind 73
! do i=ia+3,ib-3
! r1=red0(i)
! red0(i)=0.
! r0=max(red0(i-3),red0(i-2),red0(i+2),red0(i+3))
! red0(i)=r1
! red(i)=max(0.0,r1-r0)
! write(73,3001) i*df,red(i),red0(i),r0
!3001 format(4f12.3)
! enddo
! flush(73)
ij=maxloc(ccf)
i0=ij(1)
j0=ij(2)-1
red(ia:ib)=ccf(ia:ib,j0)
sync=ccf(i0,j0)
dtx=j0*istep/12000.0 - 1.0
nfreq=nint(i0*df)
red0=red0-4.0
write(17) ia,ib,red0(ia:ib)
syncbest=0.
syncd=0.
do k=-4,4
syncd(-4:4,k)=ccf1(i0-k-4:i0-k+4,j0) + ccf2(i0-4:i0+4,j0) + &
ccf3(i0+k-4:i0+k+4,j0)
enddo
ij=maxloc(syncd)
iadd=ij(1)-5
idrift=ij(2)-6
drift=idrift
syncbest=maxval(syncd)
! write(*,3002) i0,iadd,idrift,sync,syncbest
!3002 format(3i5,2f7.1)
i0=i0+iadd
write(17) ia,ib,red(ia:ib)
close(17)
if0=nint(f0/df)
nfreq=nint(f0)
blue(0:25)=ccf(if0,0:25)
jpk=maxloc(blue)
xpk=jpk(1) + 1.0
call slope(blue,26,xpk)
! rewind 71
! do i=ia,ib
! write(71,3001) i*df,red(i),ccf1(i,j0),ccf2(i,j0),ccf3(i,j0)
!3001 format(5f10.3)
! enddo
! flush(71)
! Insist on at least 10 correct hard decisions in the 21 Costas bins.
! Insist on at least 6 correct hard decisions in the 21 Costas bins.
!### Should include drift solution here ...
nhard=0
do n=0,6
ipk=maxloc(ss(i0:i0+63,1+j0+2*n)) - 1
ipk=maxloc(ss(i0:i0+2*63,1+j0+2*n)) - 1
i=abs(ipk(1)-2*icos7(n))
if(i.le.1) nhard=nhard+1
ipk=maxloc(ss(i0:i0+63,1+j0+2*n+78)) - 1
ipk=maxloc(ss(i0:i0+2*63,1+j0+2*n+78)) - 1
i=abs(ipk(1)-2*icos7(n))
if(i.le.1) nhard=nhard+1
ipk=maxloc(ss(i0:i0+63,1+j0+2*n+154)) - 1
ipk=maxloc(ss(i0:i0+2*63,1+j0+2*n+154)) - 1
i=abs(ipk(1)-2*icos7(n))
if(i.le.1) nhard=nhard+1
enddo
! print*,'a',nhard,nhard,nhard
if(nhard.lt.6) go to 900
do i=0,63
k=i0 + 2*i
jj=j0+13
jj=j0+13 !Skip over the first Costas array
do j=1,63
jj=jj+2
s3(i,j)=ss(k,jj)
kk=nint(drift*(jj-(82+j0))/70.0)
! if(i.eq.0) write(72,3101) j,jj,kk
!3101 format(3i6)
s3(i,j)=ss(k+kk,jj)
if(j.eq.32) jj=jj+14 !Skip over the middle Costas array
enddo
enddo
if(sync.gt.1.0) nsnr=nint(10.0*log10(sync) - 38.0)
! if(sync.lt.12.8) go to 900 !### Temporary ###
mycall=mycall_12(1:6) !### May need fixing ###
call packcall(mycall,nmycall,ltext)
@ -140,6 +153,7 @@ subroutine qra64a(dd,nf1,nf2,nfqso,ntol,mycall_12,sync,nsnr,dtx,nfreq, &
call unpackmsg(dat4,decoded) !Unpack the user message
call fmtmsg(decoded,iz)
nft=100 + irc
!### Should recompute S/N here, using all 84 symbols ...
endif
900 return