diff --git a/lib/qra64a.f90 b/lib/qra64a.f90 index 4ec18d217..676ef2edf 100644 --- a/lib/qra64a.f90 +++ b/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