Rough measurement and compensation for drift now included for QRA64.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6905 ab8295b8-cf94-4d9e-aec4-7959e3be5d79

lib/qra64a.f90

@@ -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